diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 5112a0b64b..bb6270c177 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -2,9 +2,9 @@ module MOM_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. -!### use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts -!### use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end -!### use MOM_controlled_forcing, only : ctrl_forcing_CS +!#CTRL# use MOM_controlled_forcing, only : apply_ctrl_forcing, register_ctrl_forcing_restarts +!#CTRL# use MOM_controlled_forcing, only : controlled_forcing_init, controlled_forcing_end +!#CTRL# use MOM_controlled_forcing, only : ctrl_forcing_CS use MOM_coms, only : reproducing_sum use MOM_constants, only : hlv, hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts to damp surface !! deflections (especially surface gravity waves). The default is false. + real :: G_Earth !< Gravitational acceleration [m s-2] real :: Kv_sea_ice !< Viscosity in sea-ice that resists sheared vertical motions [m2 s-1] - real :: density_sea_ice !< Typical density of sea-ice (kg/m^3). The value is only used to convert + real :: density_sea_ice !< Typical density of sea-ice [kg m-3]. The value is only used to convert !! the ice pressure into appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which sea-ice viscosity !! becomes effective [kg m-2], typically of order 1000 kg m-2. @@ -126,6 +127,9 @@ module MOM_surface_forcing real :: max_delta_srestore !< Maximum delta salinity used for restoring real :: max_delta_trestore !< Maximum delta sst used for restoring real, pointer, dimension(:,:) :: basin_mask => NULL() !< Mask for surface salinity restoring by basin + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover + !! the answers from the end of 2018. Otherwise, use a simpler + !! expression to calculate gustiness. type(diag_ctrl), pointer :: diag => NULL() !< Structure to regulate diagnostic output timing character(len=200) :: inputdir !< Directory where NetCDF input files are @@ -148,7 +152,7 @@ module MOM_surface_forcing type(forcing_diags), public :: handles !< Diagnostics handles -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(user_revise_forcing_CS), pointer :: urf_CS => NULL() !< A control structure for user forcing revisions end type surface_forcing_CS @@ -293,7 +297,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (CS%restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -418,7 +422,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) @@ -491,15 +495,15 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, sfc enddo ; enddo endif -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_restore, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -586,9 +590,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ real, dimension(SZI_(G),SZJ_(G)) :: & rigidity_at_h, & ! Ice rigidity at tracer points [m3 s-1] net_mass_src, & ! A temporary of net mass sources [kg m-2 s-1]. - ustar_tmp ! A temporary array of ustar values [m s-1]. + ustar_tmp ! A temporary array of ustar values [Z T-1 ~> m s-1]. - real :: I_GEarth ! 1.0 / G%G_Earth [s2 m-1] + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) [m5 s-1 kg-1] real :: mass_ice ! mass of sea ice at a face [kg m-2] real :: mass_eff ! effective mass of sea ice for rigidity [kg m-2] @@ -752,7 +756,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS, dt_ if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -806,10 +810,10 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZI_(G),SZJB_(G)), & optional, intent(inout) :: tauy !< The meridional wind stresses on a C-grid [Pa]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(inout) :: ustar !< The surface friction velocity [Z s-1 ~> m s-1]. + optional, intent(inout) :: ustar !< The surface friction velocity [Z T-1 ~> m s-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: gustless_ustar !< The surface friction velocity without - !! any contributions from gustiness [Z s-1 ~> m s-1]. + !! any contributions from gustiness [Z T-1 ~> m s-1]. integer, optional, intent(in) :: tau_halo !< The halo size of wind stresses to set, 0 by default. ! Local variables @@ -821,7 +825,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, real, dimension(SZIB_(G),SZJB_(G)) :: tauy_in_B ! Meridional wind stresses [Pa] at q points real :: gustiness ! unresolved gustiness that contributes to ustar [Pa] - real :: Irho0 ! Inverse of the mean density rescaled to [Z2 m kg-1 ~> m3 kg-1] + real :: Irho0 ! Inverse of the mean density rescaled to [Z2 s2 m T-2 kg-1 ~> m3 kg-1] real :: taux2, tauy2 ! squared wind stresses [Pa2] real :: tau_mag ! magnitude of the wind stress [Pa] @@ -835,7 +839,7 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, Isqh = G%IscB-halo ; Ieqh = G%IecB+halo ; Jsqh = G%JscB-halo ; Jeqh = G%JecB+halo i0 = is - index_bounds(1) ; j0 = js - index_bounds(3) - Irho0 = US%m_to_Z**2 / CS%Rho0 + Irho0 = (US%m_to_Z*US%T_to_s)**2 / CS%Rho0 do_ustar = present(ustar) ; do_gustless = present(gustless_ustar) @@ -938,7 +942,6 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (associated(IOB%stress_mag)) then if (do_ustar) then ; do j=js,je ; do i=is,ie gustiness = CS%gust_const - !### SIMPLIFY THE TREATMENT OF GUSTINESS! if (CS%read_gust_2d) then if ((wind_stagger == CGRID_NE) .or. & ((wind_stagger == AGRID) .and. (G%mask2dT(i,j) > 0)) .or. & @@ -949,11 +952,15 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, endif ustar(i,j) = sqrt(gustiness*Irho0 + Irho0*IOB%stress_mag(i-i0,j-j0)) enddo ; enddo ; endif - if (do_gustless) then ; do j=js,je ; do i=is,ie - gustless_ustar(i,j) = US%m_to_Z * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) -!### Change to: -! gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) - enddo ; enddo ; endif + if (CS%answers_2018) then + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(IOB%stress_mag(i-i0,j-j0) / CS%Rho0) + enddo ; enddo ; endif + else + if (do_gustless) then ; do j=js,je ; do i=is,ie + gustless_ustar(i,j) = sqrt(Irho0 * IOB%stress_mag(i-i0,j-j0)) + enddo ; enddo ; endif + endif elseif (wind_stagger == BGRID_NE) then do j=js,je ; do i=is,ie tau_mag = 0.0 ; gustiness = CS%gust_const @@ -967,9 +974,11 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo elseif (wind_stagger == AGRID) then do j=js,je ; do i=is,ie @@ -977,28 +986,32 @@ subroutine extract_IOB_stresses(IOB, index_bounds, Time, G, US, CS, taux, tauy, gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo else ! C-grid wind stresses. do j=js,je ; do i=is,ie taux2 = 0.0 ; tauy2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0) & - taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + & - G%mask2dCu(I,j)*taux_in_C(I,j)**2) / (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) + taux2 = (G%mask2dCu(I-1,j)*taux_in_C(I-1,j)**2 + G%mask2dCu(I,j)*taux_in_C(I,j)**2) / & + (G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) if ((G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) > 0) & - tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + & - G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) + tauy2 = (G%mask2dCv(i,J-1)*tauy_in_C(i,J-1)**2 + G%mask2dCv(i,J)*tauy_in_C(i,J)**2) / & + (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) tau_mag = sqrt(taux2 + tauy2) gustiness = CS%gust_const if (CS%read_gust_2d) gustiness = CS%gust(i,j) if (do_ustar) ustar(i,j) = sqrt(gustiness*Irho0 + Irho0 * tau_mag) - if (do_gustless) gustless_ustar(i,j) = US%m_to_Z * sqrt(tau_mag / CS%Rho0) -!### Change to: -! if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + if (CS%answers_2018) then + if (do_gustless) gustless_ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(tau_mag / CS%Rho0) + else + if (do_gustless) gustless_ustar(i,j) = sqrt(Irho0 * tau_mag) + endif enddo ; enddo endif ! endif for wind friction velocity fields endif @@ -1144,10 +1157,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) real :: utide ! The RMS tidal velocity [m s-1]. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags + logical :: default_2018_answers type(time_type) :: Time_frc character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=48) :: flnam @@ -1363,21 +1377,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif call time_interp_external_init -! Optionally read a x-y gustiness field in place of a global -! constant. - + ! Optionally read a x-y gustiness field in place of a global constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) @@ -1393,6 +1405,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) gust_file = trim(CS%inputdir) // trim(gust_file) call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SURFACE_FORCING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use a simpler expression to calculate gustiness.", & + default=default_2018_answers) ! See whether sufficiently thick sea ice should be treated as rigid. call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & @@ -1400,6 +1419,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & @@ -1447,8 +1469,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1463,7 +1485,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS) endif endif -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1481,7 +1503,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index 77099b2595..3509016c1f 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -356,11 +356,11 @@ subroutine wind_forcing_zero(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)/CS%Rho0) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const/CS%Rho0) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const/CS%Rho0) enddo ; enddo ; endif endif @@ -479,7 +479,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) ! set the friction velocity do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -540,12 +540,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -565,13 +565,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) call pass_vector(forces%taux, forces%tauy, G%Domain, To_All) if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index 2d899ce1bb..aa5a302e95 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -106,7 +106,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! This subroutine sets the surface wind stresses, forces%taux and forces%tauy [Pa]. ! In addition, this subroutine can be used to set the surface friction velocity, -! forces%ustar [Z s-1 ~> m s-1], which is needed with a bulk mixed layer. +! forces%ustar [Z T-1 ~> m s-1], which is needed with a bulk mixed layer. integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -139,7 +139,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! Set the surface friction velocity [Z s-1 ~> m s-1]. ustar is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 47e676a3d3..252477b2b5 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -70,13 +70,13 @@ module MOM_surface_forcing real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). ! smg: remove when have A=B code reconciled logical :: bulkmixedlayer !< If true, model based on bulk mixed layer code - real :: Rho0 !< Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 !< total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) + real :: Rho0 !< Boussinesq reference density [kg m-3] + real :: area_surf = -1.0 !< Total ocean surface area [m2] + real :: latent_heat_fusion !< Latent heat of fusion [J kg-1] + real :: latent_heat_vapor !< Latent heat of vaporization [J kg-1] real :: max_p_surf !< maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, - !! in Pa. This is needed because the FMS coupling + !! [Pa]. This is needed because the FMS coupling !! structure does not limit the water that can be !! frozen out of the ocean and the ice-ocean heat !! fluxes are treated explicitly. @@ -84,7 +84,7 @@ module MOM_surface_forcing !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar (Pa) + real :: gust_const !< constant unresolved background gustiness for ustar [Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & @@ -102,8 +102,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice !< typical density of sea-ice (kg/m^3). The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -305,7 +306,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -422,7 +423,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & ! .or. (associated(IOB%mass_berg) .and. (.not. associated(fluxes%mass_berg)))) & ! call allocate_forcing_type(G, fluxes, iceberg=.true.) !if (associated(IOB%ustar_berg)) & - ! fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + ! fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) !if (associated(IOB%area_berg)) & ! fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) !if (associated(IOB%mass_berg)) & @@ -576,7 +577,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 ! inverse of the mean density in (m^3/kg) real :: taux2, tauy2 ! squared wind stresses (Pa^2) real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth ! 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice ! mass of sea ice at a face (kg/m^2) real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) @@ -705,7 +706,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo; enddo elseif (wind_stagger == AGRID) then @@ -730,7 +731,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo; enddo @@ -751,9 +752,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo; enddo @@ -762,7 +763,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! sea ice related dynamic fields if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%G_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1222,13 +1223,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif @@ -1260,6 +1261,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 69dda6b6d3..5990aec2e0 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -92,7 +92,7 @@ module MOM_surface_forcing gust => NULL(), & !< spatially varying unresolved background !! gustiness that contributes to ustar [Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m s-1] real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) real :: utide !< constant tidal velocity to use if read_tideamp !! is false [m s-1] @@ -101,8 +101,9 @@ module MOM_surface_forcing logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] - real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + real :: G_Earth !< Gravitational acceleration [m s-2] + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m2 s-1] + real :: density_sea_ice !< typical density of sea-ice [kg m-3]. The value is !! only used to convert the ice pressure into !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which @@ -309,7 +310,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) - fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) + fluxes%ustar_tidal(i,j) = US%m_to_Z*US%T_to_s*CS%ustar_tidal(i,j) enddo ; enddo if (restore_temp) call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) @@ -429,32 +430,32 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! liquid runoff flux if (associated(IOB%rofl_flux)) then - fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) else if (associated(IOB%runoff)) then - fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + endif ! ice runoff flux if (associated(IOB%rofi_flux)) then - fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) - else if (associated(IOB%calving)) then - fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) - end if + fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + elseif (associated(IOB%calving)) then + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + endif if (associated(IOB%ustar_berg)) & - fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%ustar_berg(i,j) = US%m_to_Z*US%T_to_s * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%area_berg)) & - fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%mass_berg)) & - fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%runoff_hflx)) & - fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_lrunoff(i,j) = IOB%runoff_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%calving_hflx)) & - fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) if (associated(IOB%lw_flux)) & fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) @@ -618,7 +619,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) real :: Irho0 !< inverse of the mean density in (m^3/kg) real :: taux2, tauy2 !< squared wind stresses (Pa^2) real :: tau_mag !< magnitude of the wind stress [Pa] - real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: I_GEarth !< 1.0 / G_Earth [s2 m-1] real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) real :: mass_ice !< mass of sea ice at a face (kg/m^2) real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) @@ -770,7 +771,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ((G%mask2dBu(I,J) + G%mask2dBu(I-1,J-1)) + (G%mask2dBu(I,J-1) + G%mask2dBu(I-1,J))) ) if (CS%read_gust_2d) gustiness = CS%gust(i,j) endif - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0*tau_mag) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0*tau_mag) enddo ; enddo elseif (wind_stagger == AGRID) then @@ -796,7 +797,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) do j=js,je ; do i=is,ie gustiness = CS%gust_const if (CS%read_gust_2d .and. (G%mask2dT(i,j) > 0)) gustiness = CS%gust(i,j) - forces%ustar(i,j) = US%m_to_Z * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(gustiness*Irho0 + Irho0 * G%mask2dT(i,j) * & sqrt(taux_at_h(i,j)**2 + tauy_at_h(i,j)**2)) enddo ; enddo @@ -817,9 +818,9 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) G%mask2dCv(i,J)*forces%tauy(i,J)**2) / (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) if (CS%read_gust_2d) then - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust(i,j)*Irho0 + Irho0*sqrt(taux2 + tauy2)) else - forces%ustar(i,j) = US%m_to_Z * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(CS%gust_const*Irho0 + Irho0*sqrt(taux2 + tauy2)) endif enddo ; enddo @@ -840,7 +841,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) - I_GEarth = 1.0 / G%G_Earth + I_GEarth = 1.0 / CS%g_Earth Kv_rho_ice = (CS%kv_sea_ice / CS%density_sea_ice) do I=is-1,ie ; do j=js,je mass_ice = min(forces%p_surf_full(i,j), forces%p_surf_full(i+1,j)) * I_GEarth @@ -1221,13 +1222,13 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo else do j=jsd,jed; do i=isd,ied utide=CS%utide CS%TKE_tidal(i,j) = CS%Rho0*CS%cd_tides*(utide*utide*utide) - CS%ustar_tidal(i,j)=sqrt(CS%cd_tides)*utide + CS%ustar_tidal(i,j) = sqrt(CS%cd_tides)*utide enddo ; enddo endif @@ -1258,6 +1259,9 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 22a216cb80..6fba8efdee 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -210,7 +210,7 @@ program MOM_main namelist /ocean_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds,& ocean_nthreads, ncores_per_node, use_hyper_thread - !####################################################################### + !===================================================================== call write_cputime_start_clock(write_CPU_CSp) diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 6fe06daea8..e31e78e7ec 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -105,7 +105,10 @@ module MOM_surface_forcing real :: gyres_taux_sin_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [Pa], if WIND_CONFIG=='gyres'. real :: gyres_taux_n_pis !< The number of sine lobes in the basin if if WIND_CONFIG=='gyres' - + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover + !! the answers from the end of 2018. Otherwise, use a form of the gyre + !! wind stresses that are rotationally invariant and more likely to be + !! the same between compilers. real :: T_north !< target temperatures at north used in buoyancy_forcing_linear real :: T_south !< target temperatures at south used in buoyancy_forcing_linear @@ -124,7 +127,7 @@ module MOM_surface_forcing !! are staggered in WIND_FILE. Valid values are A or C for now. type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< A pointer to the structure !! that is used to orchestrate the calling of tracer packages -!### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() +!#CTRL# type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< A pointer to the restart control structure type(diag_ctrl), pointer :: diag !< structure used to regulate timing of diagnostic output @@ -388,11 +391,11 @@ subroutine wind_forcing_const(sfc_state, forces, tau_x0, tau_y0, day, G, US, CS) if (CS%read_gust_2d) then if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust(i,j) ) / CS%Rho0 ) enddo ; enddo ; endif else if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( ( mag_tau + CS%gust_const ) / CS%Rho0 ) enddo ; enddo ; endif endif @@ -477,7 +480,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call ! Local variables - real :: PI, y + real :: PI, y, I_rho integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq call callTree_enter("wind_forcing_gyres, MOM_surface_forcing.F90") @@ -488,7 +491,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) PI = 4.0*atan(1.0) do j=js-1,je+1 ; do I=is-1,Ieq - y = (G%geoLatCu(I,j)-CS%South_lat)/CS%len_lat + y = (G%geoLatCu(I,j)-CS%South_lat) / CS%len_lat forces%taux(I,j) = CS%gyres_taux_const + & ( CS%gyres_taux_sin_amp*sin(CS%gyres_taux_n_pis*PI*y) & + CS%gyres_taux_cos_amp*cos(CS%gyres_taux_n_pis*PI*y) ) @@ -498,12 +501,21 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = 0.0 enddo ; enddo - ! set the friction velocity !### Add parenthesis so that this is rotationally invariant. - do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & - forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & - forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) - enddo ; enddo + ! set the friction velocity + if (CS%answers_2018) then + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*(forces%tauy(i,j-1)*forces%tauy(i,j-1) + & + forces%tauy(i,j)*forces%tauy(i,j) + forces%taux(i-1,j)*forces%taux(i-1,j) + & + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) + enddo ; enddo + else + I_rho = 1.0 / CS%Rho0 + do j=js,je ; do i=is,ie + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( (CS%gust_const + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) + enddo ; enddo + endif call callTree_leave("wind_forcing_gyres") end subroutine wind_forcing_gyres @@ -584,12 +596,12 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -629,13 +641,13 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (.not.read_Ustar) then if (CS%read_gust_2d) then do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2))) + CS%gust(i,j)) / CS%Rho0 ) enddo ; enddo else do j=js, je ; do i=is, ie - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(0.5*((forces%tauy(i,j-1)**2 + & forces%tauy(i,j)**2) + (forces%taux(i-1,j)**2 + & forces%taux(i,j)**2)))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo @@ -648,7 +660,7 @@ subroutine wind_forcing_from_file(sfc_state, forces, day, G, US, CS) if (read_Ustar) then call MOM_read_data(filename, CS%Ustar_var, forces%ustar(:,:), & - G%Domain, timelevel=time_lev, scale=US%Z_to_m) + G%Domain, timelevel=time_lev, scale=US%m_to_Z*US%T_to_s) endif CS%wind_last_lev = time_lev @@ -703,19 +715,19 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) read_Ustar = (len_trim(CS%ustar_var) > 0) ! Need better control higher up ???? if (read_Ustar) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*forces%ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; temp_ustar(i,j) = US%Z_to_m*US%s_to_T*forces%ustar(i,j) ; enddo ; enddo call data_override('OCN', 'ustar', temp_ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) - do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*temp_ustar(i,j) ; enddo ; enddo + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; forces%ustar(i,j) = US%m_to_Z*US%T_to_s*temp_ustar(i,j) ; enddo ; enddo else if (CS%read_gust_2d) then call data_override('OCN', 'gust', CS%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j)) + CS%gust(i,j)) / CS%Rho0) enddo ; enddo else do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = US%m_to_Z * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + & temp_y(i,j)*temp_y(i,j))/CS%Rho0 + (CS%gust_const/CS%Rho0)) enddo ; enddo endif @@ -912,7 +924,7 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) CS%runoff_last_lev = time_lev ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then select case (CS%SST_nlev) case (12) ; time_lev = time_lev_monthly case (365) ; time_lev = time_lev_daily @@ -993,15 +1005,15 @@ subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, CS) endif ! end RESTOREBUOY -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_files") end subroutine buoyancy_forcing_from_files @@ -1094,7 +1106,7 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) ! Read the SST and SSS fields for damping. - if (CS%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then + if (CS%restorebuoy) then !#CTRL# .or. associated(CS%ctrl_forcing_CSp)) then call data_override('OCN', 'SST_restore', CS%T_restore(:,:), day, & is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in) @@ -1159,15 +1171,15 @@ subroutine buoyancy_forcing_from_data_override(sfc_state, fluxes, day, dt, G, CS enddo ; enddo -!### if (associated(CS%ctrl_forcing_CSp)) then -!### do j=js,je ; do i=is,ie -!### SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) -!### SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) -!### SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) -!### enddo ; enddo -!### call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & -!### fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) -!### endif +!#CTRL# if (associated(CS%ctrl_forcing_CSp)) then +!#CTRL# do j=js,je ; do i=is,ie +!#CTRL# SST_anom(i,j) = sfc_state%SST(i,j) - CS%T_Restore(i,j) +!#CTRL# SSS_anom(i,j) = sfc_state%SSS(i,j) - CS%S_Restore(i,j) +!#CTRL# SSS_mean(i,j) = 0.5*(sfc_state%SSS(i,j) + CS%S_Restore(i,j)) +!#CTRL# enddo ; enddo +!#CTRL# call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, & +!#CTRL# fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp) +!#CTRL# endif call callTree_leave("buoyancy_forcing_from_data_override") end subroutine buoyancy_forcing_from_data_override @@ -1367,12 +1379,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C type(surface_forcing_CS), pointer :: CS !< pointer to control struct returned by !! a previous surface_forcing_init call type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< Forcing for tracers? + ! Local variables type(directories) :: dirs logical :: new_sim type(time_type) :: Time_frc -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + logical :: default_2018_answers character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1601,6 +1615,16 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C "the zonal wind stress profile: "//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "WIND_GYRES_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the answers "//& + "from the end of 2018. Otherwise, use expressions for the gyre friction velocities "//& + "that are rotationally invariant and more likely to be the same between compilers.", & + default=default_2018_answers) + else + CS%answers_2018 = .false. endif if ((trim(CS%wind_config) == "2gyre") .or. & (trim(CS%wind_config) == "1gyre") .or. & @@ -1719,8 +1743,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C ! Set up any restart fields associated with the forcing. call restart_init(param_file, CS%restart_CSp, "MOM_forcing.res") -!### call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & -!### CS%restart_CSp) +!#CTRL# call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, & +!#CTRL# CS%restart_CSp) call restart_init_end(CS%restart_CSp) if (associated(CS%restart_CSp)) then @@ -1753,7 +1777,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C if (trim(CS%wind_config) == "file") & CS%wind_nlev = num_timelevels(CS%wind_file, CS%stress_x_var, min_dims=3) -!### call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp) call user_revise_forcing_init(param_file, CS%urf_CS) @@ -1773,7 +1797,7 @@ subroutine surface_forcing_end(CS, fluxes) if (present(fluxes)) call deallocate_forcing_type(fluxes) -!### call controlled_forcing_end(CS%ctrl_forcing_CSp) +!#CTRL# call controlled_forcing_end(CS%ctrl_forcing_CSp) if (associated(CS)) deallocate(CS) CS => NULL() diff --git a/config_src/solo_driver/Neverland_surface_forcing.F90 b/config_src/solo_driver/Neverland_surface_forcing.F90 index 71e91a539c..1fefc005f0 100644 --- a/config_src/solo_driver/Neverland_surface_forcing.F90 +++ b/config_src/solo_driver/Neverland_surface_forcing.F90 @@ -104,7 +104,7 @@ subroutine Neverland_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. ! if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! ! This expression can be changed if desired, but need not be. -! forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & +! forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & ! sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & ! 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) ! enddo ; enddo ; endif diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index 5ff39ae8c4..0275072599 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -88,7 +88,7 @@ subroutine USER_wind_forcing(sfc_state, forces, day, G, US, CS) ! is always positive. if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gust_const/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo ; endif diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 301969ed50..dd521b8eef 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -55,7 +55,6 @@ module MOM use MOM_coord_initialization, only : MOM_initialize_coord use MOM_diabatic_driver, only : diabatic, diabatic_driver_init, diabatic_CS use MOM_diabatic_driver, only : adiabatic, adiabatic_driver_init, diabatic_driver_end -use MOM_diabatic_driver, only : legacy_diabatic use MOM_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init use MOM_diagnostics, only : register_transport_diags, post_transport_diagnostics use MOM_diagnostics, only : register_surface_diags, write_static_fields @@ -204,8 +203,6 @@ module MOM !! related to the Mesoscale Eddy Kinetic Energy logical :: adiabatic !< If true, there are no diapycnal mass fluxes, and no calls !! to routines to calculate or apply diapycnal fluxes. - logical :: use_legacy_diabatic_driver!< If true (default), use the a legacy version of the diabatic - !! subroutine. This is temporary and is needed to avoid change in answers. logical :: diabatic_first !< If true, apply diabatic and thermodynamic processes before time !! stepping the dynamics. logical :: use_ALE_algorithm !< If true, use the ALE algorithm rather than layered @@ -1188,14 +1185,8 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - if (CS%use_legacy_diabatic_driver) then - ! the following subroutine is legacy and will be deleted in the near future. - call legacy_diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - else - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) - endif + call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & + dtdia, Time_end_thermo, G, GV, US, CS%diabatic_CSp, Waves=Waves) fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1674,10 +1665,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "true. This assumes that KD = KDML = 0.0 and that "//& "there is no buoyancy forcing, but makes the model "//& "faster by eliminating subroutine calls.", default=.false.) - call get_param(param_file, "MOM", "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic_driver, & - "If true, use a legacy version of the diabatic subroutine. "//& - "This is temporary and is needed to avoid change in answers.", & - default=.true.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as "//& "the gravity wave adjustment to h. This is a fragile feature and "//& @@ -1962,7 +1949,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call verticalGridInit( param_file, CS%GV, US ) GV => CS%GV -! dG%g_Earth = (GV%g_Earth*US%m_to_Z) +! dG%g_Earth = GV%mks_g_Earth ! Allocate the auxiliary non-symmetric domain for debugging or I/O purposes. if (CS%debug .or. dG%symmetric) & @@ -2158,7 +2145,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else ; G%Domain_aux => G%Domain ; endif ! Copy common variables from the vertical grid to the horizontal grid. ! Consider removing this later? - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, param_file, & dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2187,7 +2174,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug .or. CS%G%symmetric) then call clone_MOM_domain(CS%G%Domain, CS%G%Domain_aux, symmetric=.false.) else ; CS%G%Domain_aux => CS%G%Domain ;endif - G%ke = GV%ke ; G%g_Earth = (GV%g_Earth*US%m_to_Z) + G%ke = GV%ke ; G%g_Earth = GV%mks_g_Earth endif @@ -2639,7 +2626,11 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) call register_restart_field(US%m_to_Z_restart, "m_to_Z", .false., restart_CSp, & "Height unit conversion factor", "Z meter-1") call register_restart_field(GV%m_to_H_restart, "m_to_H", .false., restart_CSp, & - "Thickness unit conversion factor", "Z meter-1") + "Thickness unit conversion factor", "H meter-1") + call register_restart_field(US%m_to_Z_restart, "m_to_L", .false., restart_CSp, & + "Length unit conversion factor", "L meter-1") + call register_restart_field(US%s_to_T_restart, "s_to_T", .false., restart_CSp, & + "Time unit conversion factor", "T second-1") end subroutine set_restart_fields @@ -2674,7 +2665,7 @@ subroutine adjust_ssh_for_p_atm(tv, G, GV, US, ssh, p_atm, use_EOS) else Rho_conv=GV%Rho0 endif - IgR0 = 1.0 / (Rho_conv * (GV%g_Earth*US%m_to_Z)) + IgR0 = 1.0 / (Rho_conv * GV%mks_g_Earth) ssh(i,j) = ssh(i,j) + p_atm(i,j) * IgR0 enddo ; enddo endif ; endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c6bc7b5c6a..0fca4d35e3 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -490,7 +490,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call uvchksum("before vertvisc: up", up, vp, G%HI, haloshift=0, symmetric=sym) endif call vertvisc_coef(up, vp, h, forces, 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, CS%vertvisc_CSp) + 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)") @@ -594,7 +594,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uvp, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, CS%vertvisc_CSp) + call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt_pred, G, GV, US, CS%vertvisc_CSp) call cpu_clock_end(id_clock_vertvisc) call do_group_pass(CS%pass_visc_rem, G%Domain, clock=id_clock_pass) @@ -790,7 +790,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call start_group_pass(CS%pass_uv, G%Domain, clock=id_clock_pass) call cpu_clock_begin(id_clock_vertvisc) endif - call vertvisc_remnant(visc, CS%visc_rem_u, CS%visc_rem_v, dt, G, GV, CS%vertvisc_CSp) + 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 (step_MOM_dyn_split_RK2)") diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 515697c09e..79b8c251dd 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_EOS, only : calculate_density_derivs use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : sumSWoverBands, optics_type +use MOM_opacity, only : sumSWoverBands, optics_type, extract_optics_slice, optics_nbands use MOM_spatial_means, only : global_area_integral, global_area_mean use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : surface, thermo_var_ptrs @@ -50,9 +50,9 @@ module MOM_forcing_type ! surface stress components and turbulent velocity scale real, pointer, dimension(:,:) :: & - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. ustar_gustless => NULL() !< surface friction velocity scale without any - !! any augmentation for gustiness [Z s-1 ~> m s-1]. + !! any augmentation for gustiness [Z T-1 ~> m s-1]. ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -131,16 +131,16 @@ module MOM_forcing_type ! tide related inputs real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< tidal energy source driving mixing in bottom boundary layer [W m-2] - ustar_tidal => NULL() !< tidal contribution to bottom ustar [m s-1] + ustar_tidal => NULL() !< tidal contribution to bottom ustar [Z T-1 ~> m s-1] ! iceberg related inputs real, pointer, dimension(:,:) :: & - ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z s-1 ~> m s-1]. + ustar_berg => NULL(), & !< iceberg contribution to top ustar [Z T-1 ~> m s-1]. area_berg => NULL(), & !< area of ocean surface covered by icebergs [m2 m-2] mass_berg => NULL() !< mass of icebergs [kg m-2] ! land ice-shelf related inputs - real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z s-1 ~> m s-1]. + real, pointer, dimension(:,:) :: ustar_shelf => NULL() !< Friction velocity under ice-shelves [Z T-1 ~> m s-1]. !! as computed by the ocean at the previous time step. real, pointer, dimension(:,:) :: frac_shelf_h => NULL() !< Fractional ice shelf coverage of !! h-cells, nondimensional from 0 to 1. This is only @@ -187,7 +187,7 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & taux => NULL(), & !< zonal wind stress [Pa] tauy => NULL(), & !< meridional wind stress [Pa] - ustar => NULL(), & !< surface friction velocity scale [Z s-1 ~> m s-1]. + ustar => NULL(), & !< surface friction velocity scale [Z T-1 ~> m s-1]. net_mass_src => NULL() !< The net mass source to the ocean [kg m-2 s-1]. ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) @@ -375,7 +375,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean !! accumulated over a time step !! [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + real, dimension(max(1,nsw),G%isd:G%ied), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. !! [degC H ~> degC m or degC kg m-2] !! and array size nsw x SZI_(G), where !! nsw=number of SW bands in pen_SW_bnd. @@ -398,7 +398,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), & optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean !! [H s-1 ~> m s-1 or kg m-2 s-1]. - real, dimension(:,:), & + real, dimension(max(1,nsw),G%isd:G%ied), & optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating !! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics @@ -444,7 +444,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! error checking - if (nsw > 0) then ; if (nsw /= optics%nbands) call MOM_error(WARNING, & + if (nsw > 0) then ; if (nsw /= optics_nbands(optics)) call MOM_error(WARNING, & "mismatch in the number of bands of shortwave radiation in MOM_forcing_type extract_fluxes.") endif @@ -473,18 +473,22 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, do i=is,ie ; htot(i) = h(i,1) ; enddo do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h(i,k) ; enddo ; enddo + if (nsw >= 1) then + call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd) !, penSW_scale=J_m2_to_H*dt + if (do_PSWBR) call extract_optics_slice(optics, j, G, GV, penSW_top=Pen_SW_bnd_rate) !, penSW_scale=J_m2_to_H + endif do i=is,ie scale = 1.0 if (htot(i)*Ih_limit < 1.0) scale = htot(i)*Ih_limit - ! Convert the penetrating shortwave forcing to (K * H) + ! Convert the penetrating shortwave forcing to (K * H) and reduce fluxes for shallow depths. ! (H=m for Bouss, H=kg/m2 for non-Bouss) Pen_sw_tot(i) = 0.0 if (nsw >= 1) then - do n=1,nsw - Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, optics%sw_pen_band(n,i,j)) + do n=1,nsw + Pen_SW_bnd(n,i) = J_m2_to_H*scale*dt * max(0.0, Pen_SW_bnd(n,i)) Pen_sw_tot(i) = Pen_sw_tot(i) + Pen_SW_bnd(n,i) enddo else @@ -495,7 +499,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, pen_sw_tot_rate(i) = 0.0 if (nsw >= 1) then do n=1,nsw - Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, optics%sw_pen_band(n,i,j)) + Pen_SW_bnd_rate(n,i) = J_m2_to_H*scale * max(0.0, Pen_SW_bnd_rate(n,i)) pen_sw_tot_rate(i) = pen_sw_tot_rate(i) + pen_sw_bnd_rate(n,i) enddo else @@ -834,10 +838,10 @@ subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & !! [degC H ~> degC m or degC kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated !! over a time step [ppt H ~> ppt m or ppt kg m-2] - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! [degC H ~> degC m or degC kg m-2] array size - !! nsw x SZI_(G), where nsw=number of SW bands in - !! pen_SW_bnd. This heat flux is not in net_heat. + real, dimension(max(1,nsw),G%isd:G%ied,G%jsd:G%jed), intent(out) :: pen_SW_bnd !< penetrating SW flux, by frequency + !! band [degC H ~> degC m or degC kg m-2] with array + !! size nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not in net_heat. type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available !! thermodynamic fields. Here it is used to keep !! track of the heat flux associated with net @@ -863,13 +867,15 @@ end subroutine extractFluxes2d !! These are actual fluxes, with units of stuff per time. Setting dt=1 in the call to !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. -subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, & +subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt, tv, j, & buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(forcing), intent(inout) :: fluxes !< surface fluxes type(optics_type), pointer :: optics !< penetrating SW optics + integer, intent(in) :: nsw !< The number of frequency bands of + !! penetrating shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< prognostic temp [degC] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< salinity [ppt] @@ -883,13 +889,13 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables - integer :: nsw, start, npts, k + integer :: start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d real, dimension( SZI_(G) ) :: netH ! net FW flux [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension( SZI_(G) ) :: netEvap ! net FW flux leaving ocean via evaporation ! [H s-1 ~> m s-1 or kg m-2 s-1] real, dimension( SZI_(G) ) :: netHeat ! net temp flux [degC H s-1 ~> degC m s-2 or degC kg m-2 s-1] - real, dimension( optics%nbands, SZI_(G) ) :: penSWbnd ! SW penetration bands + real, dimension( max(nsw,1), SZI_(G) ) :: penSWbnd ! penetrating SW radiation by band real, dimension( SZI_(G) ) :: pressure ! pressurea the surface [Pa] real, dimension( SZI_(G) ) :: dRhodT ! density partial derivative wrt temp [kg m-3 degC-1] real, dimension( SZI_(G) ) :: dRhodS ! density partial derivative wrt saln [kg m-3 ppt-1] @@ -900,8 +906,6 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, real :: depthBeforeScalingFluxes, GoRho real :: H_limit_fluxes - nsw = optics%nbands - ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. useCalvingHeatContent = .False. @@ -928,7 +932,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h(:,j,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & + call sumSWoverBands(G, GV, US, h(:,j,:), optics, j, dt*US%s_to_T, & H_limit_fluxes, .true., penSWbnd, netPen) ! Density derivatives @@ -983,8 +987,8 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, !$OMP parallel do default(shared) firstprivate(netT,netS) do j=G%jsc,G%jec - call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & - netT, netS, skip_diags=skip_diags) + call calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, optics_nbands(optics), h, Temp, Salt, & + tv, j, buoyancyFlux(:,j,:), netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) enddo @@ -1009,7 +1013,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) ! counts, there must be no redundant points, so all variables use is..ie ! and js...je as their extent. if (associated(fluxes%ustar)) & - call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m) + call hchksum(fluxes%ustar, mesg//" fluxes%ustar",G%HI, haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%buoy)) & call hchksum(fluxes%buoy, mesg//" fluxes%buoy ",G%HI,haloshift=hshift) if (associated(fluxes%sw)) & @@ -1053,7 +1057,7 @@ subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) if (associated(fluxes%TKE_tidal)) & call hchksum(fluxes%TKE_tidal, mesg//" fluxes%TKE_tidal",G%HI,haloshift=hshift) if (associated(fluxes%ustar_tidal)) & - call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift) + call hchksum(fluxes%ustar_tidal, mesg//" fluxes%ustar_tidal",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(fluxes%lrunoff)) & call hchksum(fluxes%lrunoff, mesg//" fluxes%lrunoff",G%HI,haloshift=hshift) if (associated(fluxes%frunoff)) & @@ -1096,7 +1100,7 @@ subroutine MOM_mech_forcing_chksum(mesg, forces, G, US, haloshift) if (associated(forces%p_surf)) & call hchksum(forces%p_surf, mesg//" forces%p_surf",G%HI,haloshift=hshift) if (associated(forces%ustar)) & - call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m) + call hchksum(forces%ustar, mesg//" forces%ustar",G%HI,haloshift=hshift, scale=US%Z_to_m*US%s_to_T) if (associated(forces%rigidity_ice_u) .and. associated(forces%rigidity_ice_v)) & call uvchksum(mesg//" forces%rigidity_ice_[uv]", forces%rigidity_ice_u, & forces%rigidity_ice_v, G%HI, haloshift=hshift, symmetric=.true.) @@ -1218,12 +1222,12 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, handles%id_ustar = register_diag_field('ocean_model', 'ustar', diag%axesT1, Time, & 'Surface friction velocity = [(gustiness + tau_magnitude)/rho0]^(1/2)', & - 'm s-1', conversion=US%Z_to_m) + 'm s-1', conversion=US%Z_to_m*US%s_to_T) if (present(use_berg_fluxes)) then if (use_berg_fluxes) then handles%id_ustar_berg = register_diag_field('ocean_model', 'ustar_berg', diag%axesT1, Time, & - 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg ', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_area_berg = register_diag_field('ocean_model', 'area_berg', diag%axesT1, Time, & 'Area of grid cell covered by iceberg ', 'm2 m-2') @@ -1232,7 +1236,7 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, 'Mass of icebergs ', 'kg m-2') handles%id_ustar_ice_cover = register_diag_field('ocean_model', 'ustar_ice_cover', diag%axesT1, Time, & - 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m) + 'Friction velocity below iceberg and ice shelf together', 'm s-1', conversion=US%Z_to_m*US%s_to_T) handles%id_frac_ice_cover = register_diag_field('ocean_model', 'frac_ice_cover', diag%axesT1, Time, & 'Area of grid cell below iceberg and ice shelf together ', 'm2 m-2') @@ -2072,7 +2076,7 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - fluxes%ustar_gustless(i,j) = US%m_to_Z * sqrt(sqrt(taux2 + tauy2) / Rho0) + fluxes%ustar_gustless(i,j) = US%m_to_Z*US%T_to_s * sqrt(sqrt(taux2 + tauy2) / Rho0) !### Change to: ! fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) enddo ; enddo diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 3748684fd4..8df0b31406 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -203,9 +203,9 @@ module MOM_variables real, pointer, dimension(:,:) :: & bbl_thick_u => NULL(), & !< The bottom boundary layer thickness at the u-points [Z ~> m]. bbl_thick_v => NULL(), & !< The bottom boundary layer thickness at the v-points [Z ~> m]. - kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 s-1 ~> m2 s-1]. - kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 s-1 ~> m2 s-1]. - ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z s-1 ~> m s-1]. + kv_bbl_u => NULL(), & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. + kv_bbl_v => NULL(), & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. + ustar_BBL => NULL() !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:) :: TKE_BBL => NULL() !< A term related to the bottom boundary layer source of turbulent kinetic !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed @@ -218,9 +218,9 @@ module MOM_variables real, pointer, dimension(:,:) :: tbl_thick_shelf_v => NULL() !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. real, pointer, dimension(:,:) :: kv_tbl_shelf_u => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: kv_tbl_shelf_v => NULL() - !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 s-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:) :: nkml_visc_u => NULL() !< The number of layers in the viscous surface mixed layer at u-points [nondim]. !! This is not an integer because there may be fractional layers, and it is stored in @@ -231,31 +231,31 @@ module MOM_variables real, pointer, dimension(:,:) :: & MLD => NULL() !< Instantaneous active mixing layer depth [H ~> m or kg m-2]. real, pointer, dimension(:,:,:) :: & - Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z s-1 ~> m s-1]. - Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z s-1 ~> m s-1]. + Ray_u => NULL(), & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. + Ray_v => NULL() !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_T => NULL() !< The extra diffusivity of temperature due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kd_extra_S => NULL() !< The extra diffusivity of salinity due to double diffusion relative to the - !! diffusivity of density [Z2 s-1 ~> m2 s-1]. + !! diffusivity of density [Z2 T-1 ~> m2 s-1]. ! One of Kd_extra_T and Kd_extra_S is always 0. Kd_extra_S is positive for salt fingering; ! Kd_extra_T is positive for double diffusive convection. They are only allocated if ! DOUBLE_DIFFUSION is true. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns [Z2 s-1 ~> m2 s-1]. + !! in tracer columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns [Z2 s-1 ~> m2 s-1]. + !! corner columns [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc) [Z2 s-1 ~> m2 s-1]. + !! background, convection etc) [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: TKE_turb => NULL() - !< The turbulent kinetic energy per unit mass at the interfaces [m2 s-2]. + !< The turbulent kinetic energy per unit mass at the interfaces [Z2 T-2 ~> m2 s-2]. !! This may be at the tracer or corner points logical :: add_Kv_slow !< If True, add Kv_slow when calculating the 'coupling coefficient' (a_cpl) !! at the interfaces in find_coupling_coef. diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 83fb6d9268..83317192a7 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -27,6 +27,8 @@ module MOM_verticalGrid integer :: ke !< The number of layers/levels in the vertical real :: max_depth !< The maximum depth of the ocean [Z ~> m]. real :: g_Earth !< The gravitational acceleration [m2 Z-1 s-2 ~> m s-2]. + real :: mks_g_Earth !< The gravitational acceleration in unscaled MKS units [m s-2]. + real :: LZT_g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: Rho0 !< The density used in the Boussinesq approximation or nominal !! density used to convert depths into mass units [kg m-3]. @@ -88,7 +90,7 @@ subroutine verticalGridInit( param_file, GV, US ) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, & "Parameters providing information about the vertical grid.") - call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", GV%mks_g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) call get_param(param_file, mdl, "RHO_0", GV%Rho0, & @@ -122,7 +124,8 @@ subroutine verticalGridInit( param_file, GV, US ) "units of thickness into m.", units="m H-1", default=1.0) GV%H_to_m = GV%H_to_m * H_rescale_factor endif - GV%g_Earth = GV%g_Earth * US%Z_to_m + GV%g_Earth = GV%mks_g_Earth * US%Z_to_m + GV%LZT_g_Earth = US%m_to_L**2*US%Z_to_m*US%T_to_s**2 * GV%mks_g_Earth #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. call get_param(param_file, mdl, "NK", nk, & @@ -149,7 +152,7 @@ subroutine verticalGridInit( param_file, GV, US ) GV%Angstrom_H = GV%Angstrom_m*1000.0*GV%kg_m2_to_H endif GV%H_subroundoff = 1e-20 * max(GV%Angstrom_H,GV%m_to_H*1e-17) - GV%H_to_Pa = (GV%g_Earth*US%m_to_Z) * GV%H_to_kg_m2 + GV%H_to_Pa = GV%mks_g_Earth * GV%H_to_kg_m2 GV%H_to_Z = GV%H_to_m * US%m_to_Z GV%Z_to_H = US%Z_to_m * GV%m_to_H diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 45cfb0ac68..0f5553721b 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -866,7 +866,7 @@ subroutine calculate_vertical_integrals(h, tv, p_surf, G, GV, US, CS) ! pbo = (mass * g) + p_surf ! where p_surf is the sea water pressure at sea water surface. do j=js,je ; do i=is,ie - btm_pres(i,j) = mass(i,j) * (GV%g_Earth*US%m_to_Z) + btm_pres(i,j) = mass(i,j) * GV%mks_g_Earth if (associated(p_surf)) then btm_pres(i,j) = btm_pres(i,j) + p_surf(i,j) endif diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 0e563648f5..1e2eaea51c 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -162,6 +162,8 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "RINO_CRIT_EQ") call obsolete_real(param_file, "SHEARMIX_RATE_EQ") + call obsolete_real(param_file, "VSTAR_SCALE_FACTOR", hint="Use EPBL_VEL_SCALE_FACTOR instead.") + call obsolete_logical(param_file, "CONTINUITY_PPM", .true.) call obsolete_logical(param_file, "USE_LOCAL_PREF", .true.) @@ -203,6 +205,7 @@ subroutine find_obsolete_params(param_file) call obsolete_int(param_file, "SEAMOUNT_LENGTH_SCALE", hint="Use SEAMOUNT_X_LENGTH_SCALE instead.") call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") + call obsolete_logical(param_file, "USE_VISBECK_SLOPE_BUG", .false.) call obsolete_real(param_file, "MIN_Z_DIAG_INTERVAL") call obsolete_char(param_file, "Z_OUTPUT_GRID_FILE") diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index e8f1fecf60..bc3f8323f0 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -88,7 +88,7 @@ module MOM_ice_shelf real, pointer, dimension(:,:) :: & utide => NULL() !< tidal velocity [m s-1] - real :: ustar_bg !< A minimum value for ustar under ice shelves [Z s-1 ~> m s-1]. + real :: ustar_bg !< A minimum value for ustar under ice shelves [Z T-1 ~> m s-1]. real :: cdrag !< drag coefficient under ice shelves [nondim]. real :: g_Earth !< The gravitational acceleration [m s-2] real :: Cp !< The heat capacity of sea water [J kg-1 degC-1]. @@ -363,10 +363,10 @@ subroutine shelf_calc_flux(state, fluxes, Time, time_step, CS, forces) v_at_h = state%v(i,j) !### I think that CS%utide**1 should be CS%utide**2 - fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z * & - sqrt(CS%cdrag*((u_at_h**2.0 + v_at_h**2.0) + CS%utide(i,j)**1))) + fluxes%ustar_shelf(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s * & + sqrt(CS%cdrag*((u_at_h**2 + v_at_h**2) + CS%utide(i,j)**1))) - ustar_h = US%Z_to_m*fluxes%ustar_shelf(i,j) + ustar_h = US%Z_to_m*US%s_to_T*fluxes%ustar_shelf(i,j) if (associated(state%taux_shelf) .and. associated(state%tauy_shelf)) then state%taux_shelf(i,j) = ustar_h*ustar_h*CS%Rho0*Isqrt2 @@ -936,7 +936,7 @@ subroutine add_shelf_flux(G, CS, state, fluxes) ! tauy2 = (asv1 * state%tauy_shelf(i,J-1)**2 + & ! asv2 * state%tauy_shelf(i,J)**2 ) / (asv1 + asv2) - !fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*sqrt(Irho0 * sqrt(taux2 + tauy2))) + ! fluxes%ustar(i,j) = MAX(CS%ustar_bg, US%m_to_Z*US%T_to_s*sqrt(Irho0 * sqrt(taux2 + tauy2))) ! endif ; enddo ; enddo if (CS%active_shelf_dynamics .or. CS%override_shelf_movement) then @@ -1351,7 +1351,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", & - units="m s-1", default=0.0, scale=US%m_to_Z) + units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& "the velocity field to the surface stress.", units="nondim", & @@ -1362,7 +1362,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl "DRAG_BG_VEL is either the assumed bottom velocity (with "//& "LINEAR_DRAG) or an unresolved velocity that is "//& "combined with the resolved velocity to estimate the "//& - "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z) + "velocity magnitude.", units="m s-1", default=0.0, scale=US%m_to_Z*US%T_to_s) if (CS%cdrag*drag_bg_vel > 0.0) CS%ustar_bg = sqrt(CS%cdrag)*drag_bg_vel endif @@ -1575,7 +1575,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces, fl CS%id_tfl_shelf = register_diag_field('ocean_model', 'tflux_shelf', CS%diag%axesT1, CS%Time, & 'Heat conduction into ice shelf', 'W m-2') CS%id_ustar_shelf = register_diag_field('ocean_model', 'ustar_shelf', CS%diag%axesT1, CS%Time, & - 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m) + 'Fric vel under shelf', 'm/s', conversion=US%Z_to_m*US%s_to_T) if (CS%active_shelf_dynamics) then CS%id_h_mask = register_diag_field('ocean_model', 'h_mask', CS%diag%axesT1, CS%Time, & 'ice shelf thickness mask', 'none') diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index d497a7828e..45eb831d6c 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -141,7 +141,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) @@ -176,7 +176,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) @@ -228,7 +228,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state "The initial salinities.", units="PSU", default=35.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%Z_to_m) @@ -273,7 +273,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and "//& "salinities are read.", fail_if_missing=.true.) @@ -354,7 +354,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, & call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) k_light = GV%nk_rho_varies + 1 @@ -401,7 +401,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call get_param(param_file, mdl, "COORD_FILE", coord_file, & @@ -456,7 +456,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) units="kg m-3", default=2.0) call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) ! This following sets the target layer densities such that a the ! surface interface has density Rlay_ref and the bottom @@ -494,7 +494,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & - default=(GV%g_Earth*US%m_to_Z), scale=US%Z_to_m) + default=GV%mks_g_Earth, scale=US%Z_to_m) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a17bfc6aa9..2027a7bc41 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -232,13 +232,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = US%Z_to_m*visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = US%Z_to_m*visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = US%Z_to_m*US%s_to_T*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) @@ -400,7 +400,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h K4_here = CS%MEKE_K4 ! Limit Kh to avoid CFL violations. Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & - max(G%IareaT(i,j),G%IareaT(i+1,j))))**2.0 + max(G%IareaT(i,j),G%IareaT(i+1,j))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & @@ -411,7 +411,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do J=js-1,je ; do i=is,ie K4_here = CS%MEKE_K4 Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & - max(G%IareaT(i,j),G%IareaT(i,j+1))))**2.0 + max(G%IareaT(i,j),G%IareaT(i,j+1))))**2 if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 3a7d2a01a1..0df5ca75d0 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -41,11 +41,6 @@ module MOM_lateral_mixing_coeffs !! of first baroclinic wave for calculating the resolution fn. logical :: khth_use_ebt_struct !< If true, uses the equivalent barotropic structure !! as the vertical structure of thickness diffusivity. - logical :: use_Visbeck_slope_bug !< If true, then retain a legacy bug in the calculation of weights - !! applied to isoneutral slopes. There was an erroneous k-indexing - !! for layer thicknesses. In addition, masking at coastlines was not - !! used which introduced potential restart issues. This flag will be - !! deprecated in a future release. logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first !! baroclinic wave speed and populate CS%cg1. !! This parameter is set depending on other parameters. @@ -495,26 +490,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i+1,j,k)*h(i+1,j-1,k) * h(i+1,j,k)*h(i+1,j-1,k-1) - wNW = h(i ,j,k)*h(i ,j+1,k) * h(i ,j,k)*h(i ,j+1,k-1) - wNE = h(i+1,j,k)*h(i+1,j+1,k) * h(i+1,j,k)*h(i+1,j+1,k-1) - wSW = h(i ,j,k)*h(i ,j-1,k) * h(i ,j,k)*h(i ,j-1,k-1) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) - wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) - wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) - S2 = slope_x(I,j,K)**2 + ( & - (wNW*slope_y(i,J,K)**2+wSE*slope_y(i+1,J-1,K)**2) & - +(wNE*slope_y(i+1,J,K)**2+wSW*slope_y(i,J-1,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) - endif + wSE = G%mask2dCv(i+1,J-1) * ( (h(i+1,j,k)*h(i+1,j-1,k)) * (h(i+1,j,k-1)*h(i+1,j-1,k-1)) ) + wNW = G%mask2dCv(i ,J ) * ( (h(i ,j,k)*h(i ,j+1,k)) * (h(i ,j,k-1)*h(i ,j+1,k-1)) ) + wNE = G%mask2dCv(i+1,J ) * ( (h(i+1,j,k)*h(i+1,j+1,k)) * (h(i+1,j,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCv(i ,J-1) * ( (h(i ,j,k)*h(i ,j-1,k)) * (h(i ,j,k-1)*h(i ,j-1,k-1)) ) + S2 = slope_x(I,j,K)**2 + & + ((wNW*slope_y(i,J,K)**2 + wSE*slope_y(i+1,J-1,K)**2) + & + (wNE*slope_y(i+1,J,K)**2 + wSW*slope_y(i,J-1,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_u(I,j,k)) CS%SN_u(I,j) = CS%SN_u(I,j) + sqrt( S2*N2 )*H_geom S2_u(I,j) = S2_u(I,j) + S2*H_geom @@ -541,26 +526,16 @@ subroutine calc_Visbeck_coeffs(h, slope_x, slope_y, N2_u, N2_v, G, GV, CS) H_geom = sqrt( Hdn * Hup ) !H_geom = H_geom * sqrt(N2) ! WKB-ish !H_geom = H_geom * N2 ! WKB-ish - if (CS%use_Visbeck_slope_bug) then - wSE = h(i,j ,k)*h(i+1,j ,k) * h(i,j ,k)*h(i+1,j ,k-1) - wNW = h(i,j+1,k)*h(i-1,j+1,k) * h(i,j+1,k)*h(i-1,j+1,k-1) - wNE = h(i,j+1,k)*h(i+1,j+1,k) * h(i,j+1,k)*h(i+1,j+1,k-1) - wSW = h(i,j ,k)*h(i-1,j ,k) * h(i,j ,k)*h(i-1,j ,k-1) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**2 ) !### This should be **4 for consistent units. - else - wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) - wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) - wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) - wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) - S2 = slope_y(i,J,K)**2 + ( & - (wSE*slope_x(I,j,K)**2+wNW*slope_x(I-1,j+1,K)**2) & - +(wNE*slope_x(I,j+1,K)**2+wSW*slope_x(I-1,j,K)**2) ) / & - ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) !### This should be **4 for consistent units. - endif + wSE = G%mask2dCu(I,j) * ( (h(i,j ,k)*h(i+1,j ,k)) * (h(i,j ,k-1)*h(i+1,j ,k-1)) ) + wNW = G%mask2dCu(I-1,j+1) * ( (h(i,j+1,k)*h(i-1,j+1,k)) * (h(i,j+1,k-1)*h(i-1,j+1,k-1)) ) + wNE = G%mask2dCu(I,j+1) * ( (h(i,j+1,k)*h(i+1,j+1,k)) * (h(i,j+1,k-1)*h(i+1,j+1,k-1)) ) + wSW = G%mask2dCu(I-1,j) * ( (h(i,j ,k)*h(i-1,j ,k)) * (h(i,j ,k-1)*h(i-1,j ,k-1)) ) + S2 = slope_y(i,J,K)**2 + & + ((wSE*slope_x(I,j,K)**2 + wNW*slope_x(I-1,j+1,K)**2) + & + (wNE*slope_x(I,j+1,K)**2 + wSW*slope_x(I-1,j,K)**2) ) / & + ( ((wSE+wNW) + (wNE+wSW)) + GV%H_subroundoff**4 ) if (S2max>0.) S2 = S2 * S2max / (S2 + S2max) ! Limit S2 + N2 = max(0., N2_v(i,J,K)) CS%SN_v(i,J) = CS%SN_v(i,J) + sqrt( S2*N2 )*H_geom S2_v(i,J) = S2_v(i,J) + S2*H_geom @@ -926,7 +901,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) CS%calculate_Rd_dx = .false. CS%calculate_res_fns = .false. CS%calculate_Eady_growth_rate = .false. - absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter. + absurdly_small_freq2 = 1e-34 !### Note the hard-coded dimensional parameter in [s-2]. ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -993,7 +968,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& - units='m', default=2000.) + units="m", default=2000.) allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 endif @@ -1015,7 +990,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) 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.", & - default=1.0e-6, scale=US%m_to_Z**2) !### Add units argument. + units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2) endif if (CS%calculate_Eady_growth_rate) then @@ -1115,12 +1090,6 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "velocity points from the thickness points; otherwise "//& "interpolate the wave speed and calculate the resolution "//& "function independently at each point.", default=.true.) - call get_param(param_file, mdl, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & - "If true, then retain a legacy bug in the calculation of weights "//& - "applied to isoneutral slopes. There was an erroneous k-indexing "//& - "for layer thicknesses. In addition, masking at coastlines was not "//& - "used which introduced potential restart issues. This flag will be "//& - "deprecated in a future release.", default=.false.) if (CS%interpolate_Res_fn) then if (CS%Res_coef_visc /= CS%Res_coef_khth) call MOM_error(FATAL, & "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index f9db6eba2b..f763f562b0 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -344,7 +344,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var if (CS%debug) then call hchksum(h,'mixed_layer_restrat: h',G%HI,haloshift=1,scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m) + call hchksum(forces%ustar,'mixed_layer_restrat: u*',G%HI,haloshift=1,scale=US%Z_to_m*US%s_to_T) call hchksum(MLD_fast,'mixed_layer_restrat: MLD',G%HI,haloshift=1,scale=GV%H_to_m) call hchksum(Rml_av_fast,'mixed_layer_restrat: rml',G%HI,haloshift=1, scale=US%m_to_Z) endif @@ -356,7 +356,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -432,7 +432,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f if (res_upscale) res_scaling_fac = & @@ -653,7 +653,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -700,7 +700,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + u_star = US%s_to_T*0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index f281a7b927..159a88958b 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -489,7 +489,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2') CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & - 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m) + 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3') CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & @@ -499,7 +499,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z_to_m**2) + 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & @@ -590,17 +590,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP - !! [Z2 s-1 ~> m2 s-1] + !! [Z2 T-1 ~> m2 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport [m s-1] @@ -624,10 +624,10 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m*US%s_to_T) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif @@ -644,7 +644,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) iFaceHeight(1) = 0.0 ! BBL is all relative to the surface hcorr = 0. @@ -683,9 +683,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z_to_m**2 * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z_to_m**2 * Ks(i,j,:) - Kviscosity(:) = US%Z_to_m**2 * Kv(i,j,:) + Kdiffusivity(:,1) = US%Z2_T_to_m2_s * Kt(i,j,:) + Kdiffusivity(:,2) = US%Z2_T_to_m2_s * Ks(i,j,:) + Kviscosity(:) = US%Z2_T_to_m2_s * Kv(i,j,:) endif call CVMix_coeffs_kpp(Kviscosity(:), & ! (inout) Total viscosity [m2 s-1] @@ -739,7 +739,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & Kviscosity(k) = Kviscosity(k) * LangEnhK elseif (CS%LT_K_SHAPE == LT_K_SCALED) then sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - SigmaRatio = sigma * (1. - sigma)**2. / 0.148148037 + SigmaRatio = sigma * (1. - sigma)**2 / 0.148148037 if (CS%id_EnhK > 0) CS%EnhK(i,j,k) = (1.0 + (LangEnhK - 1.)*sigmaRatio) Kdiffusivity(k,1) = Kdiffusivity(k,1) * ( 1. + & ( LangEnhK - 1.)*sigmaRatio) @@ -828,17 +828,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + US%m_to_Z**2 * Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, G%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m_to_Z**2 * Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m_to_Z**2 * Kviscosity(k) - if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = US%Z_to_m**2 * Kv(i,j,k) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k) + if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo endif endif @@ -851,8 +851,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, uStar, & #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif #endif @@ -888,7 +888,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component [m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component [m s-1] type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z s-1 ~> m s-1] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [m2 s-3] type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS @@ -910,7 +910,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pRef, rho1, rhoK, Uk, Vk, sigma, sigmaRatio real :: zBottomMinusOffset ! Height of bottom plus a little bit [m] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -946,7 +947,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF #endif ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 ! loop over horizontal points on processor !$OMP parallel do default(shared) @@ -964,7 +965,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF ! things independent of position within the column Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) - surfFricVel = US%Z_to_m * uStar(i,j) + surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) ! Bullk Richardson number computed for each cell in a column, ! assuming OBLdepth = grid cell depth. After Rib(k) is @@ -1073,8 +1074,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, EOS, uStar, buoyF if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then MLD_GUESS = max( 1.*US%m_to_Z, abs(US%m_to_Z*CS%OBLdepthprev(i,j) ) ) - call get_Langmuir_Number( LA, G, GV, US, MLD_guess, surfFricVel, i, j, & - H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & + H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j)=LA endif diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 1a9cb890ef..1fbbc15120 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -42,8 +42,8 @@ module MOM_CVMix_conv ! Diagnostics arrays real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [s-2] - real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [m2 s-1] - real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_conv !< Diffusivity added by convection [Z2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kv_conv !< Viscosity added by convection [Z2 T-1 ~> m2 s-1] end type CVMix_conv_cs @@ -134,9 +134,9 @@ logical function CVMix_conv_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_conv', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_conv module', '1/s2') CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & - 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional diffusivity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & - 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z_to_m**2) + 'Additional viscosity added by MOM_CVMix_conv module', 'm2/s', conversion=US%Z2_T_to_m2_s) call CVMix_init_conv(convect_diff=CS%kd_conv_const, & convect_visc=CS%kv_conv_const, & @@ -168,10 +168,11 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces [m] real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers [m] integer :: kOBL !< level of OBL extent - real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + real :: g_o_rho0 ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, rhok, rhokm1, dz, dh, hcorr integer :: i, j, k - g_o_rho0 = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + g_o_rho0 = GV%mks_g_Earth / GV%Rho0 ! initialize dummy variables rho_lwr(:) = 0.0; rho_1d(:) = 0.0 @@ -231,8 +232,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) OBL_ind=kOBL) do K=1,G%ke+1 - CS%kv_conv(i,j,K) = US%m_to_Z**2 * kv_col(K) - CS%kd_conv(i,j,K) = US%m_to_Z**2 * kd_col(K) + CS%kv_conv(i,j,K) = US%m2_s_to_Z2_T * kv_col(K) + CS%Kd_conv(i,j,K) = US%m2_s_to_Z2_T * kd_col(K) enddo ! Do not apply mixing due to convection within the boundary layer do k=1,kOBL @@ -245,8 +246,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl) if (CS%debug) then call hchksum(CS%N2, "MOM_CVMix_conv: N2",G%HI,haloshift=0) - call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0) - call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0) + call hchksum(CS%kd_conv, "MOM_CVMix_conv: kd_conv",G%HI,haloshift=0,scale=US%Z2_T_to_m2_s) + call hchksum(CS%kv_conv, "MOM_CVMix_conv: kv_conv",G%HI,haloshift=0,scale=US%m2_s_to_Z2_T) endif ! send diagnostics to post_data diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 4f535197a7..57400e31bf 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -138,10 +138,10 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & 'Double-diffusion density ratio', 'nondim') @@ -170,9 +170,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 s-1 ~> m2 s-1]. + !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt [Z2 s-1 ~> m2 s-1]. + !! diffusivity for salt [Z2 T-1 ~> m2 s-1]. type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. integer, intent(in) :: j !< Meridional grid indice. @@ -275,8 +275,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - Kd_T(i,j,K) = US%m_to_Z**2 * Kd1_T(K) - Kd_S(i,j,K) = US%m_to_Z**2 * Kd1_S(K) + Kd_T(i,j,K) = US%m2_s_to_Z2_T * Kd1_T(K) + Kd_S(i,j,K) = US%m2_s_to_Z2_T * Kd1_S(K) enddo ! Do not apply mixing due to convection within the boundary layer diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 9e0f6ca708..6b6bf32bf7 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -65,15 +65,15 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous call to !! CVMix_shear_init. ! Local variables integer :: i, j, k, kk, km1 - real :: GoRho - real :: pref, DU, DV, DRHO, DZ, N2, S2, dummy + real :: GoRho ! Gravitational acceleration divided by density in MKS units [m4 s-2] + real :: pref, DU, DV, dRho, DZ, N2, S2, dummy real, dimension(2*(G%ke)) :: pres_1d, temp_1d, salt_1d, rho_1d real, dimension(G%ke+1) :: Ri_Grad !< Gradient Richardson number real, dimension(G%ke+1) :: Kvisc !< Vertical viscosity at interfaces [m2 s-1] @@ -81,7 +81,7 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, parameter :: epsln = 1.e-10 !< Threshold to identify vanished layers ! some constants - GoRho = (GV%g_Earth*US%m_to_Z) / GV%Rho0 + GoRho = GV%mks_g_Earth / GV%Rho0 do j = G%jsc, G%jec do i = G%isc, G%iec @@ -156,8 +156,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) endif do K=1,G%ke+1 - Kvisc(K) = US%Z_to_m**2 * kv(i,j,K) - Kdiff(K) = US%Z_to_m**2 * kd(i,j,K) + Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K) + Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. @@ -167,8 +167,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) nlev=G%ke, & max_nlev=G%ke) do K=1,G%ke+1 - kv(i,j,K) = US%m_to_Z**2 * Kvisc(K) - kd(i,j,K) = US%m_to_Z**2 * Kdiff(K) + kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K) + kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) enddo enddo enddo @@ -289,9 +289,9 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z_to_m**2) + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index e941ec3eea..0cbe700518 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -47,15 +47,16 @@ module MOM_bkgnd_mixing real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile [m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when - !! horiz_varying_background=.true. + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when - !! horiz_varying_background=.true. - real :: bckgrnd_vdc_ban !< Banda Sea diffusivity (Gordon) when - !! horiz_varying_background=.true. - real :: Kd_min !< minimum diapycnal diffusivity [Z2 s-1 ~> m2 s-1] - real :: Kd !< interior diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + real :: bckgrnd_vdc_Banda !< Banda Sea diffusivity (Gordon) when + !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the !! Henyey scaling from the mixing @@ -64,7 +65,7 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 s-1 ~> m2 s-1] + real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] !! when bulkmixedlayer==.false. real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on @@ -100,9 +101,9 @@ module MOM_bkgnd_mixing integer :: id_kd_bkgnd = -1 !< Diagnotic IDs integer :: id_kv_bkgnd = -1 !< Diagnostic IDs - real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: Kd_sfc !< surface value of the diffusivity [Z2 T-1 ~> m2 s-1] ! Diagnostics arrays - real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 s-1 ~> m2 s-1] + real, allocatable, dimension(:,:,:) :: kd_bkgnd !< Background diffusivity [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: kv_bkgnd !< Background viscosity [Z2 s-1 ~> m2 s-1] character(len=40) :: bkgnd_scheme_str = "none" !< Background scheme identifier @@ -125,7 +126,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. ! Local variables - real :: Kv ! The interior vertical viscosity [m2 s-1] - read to set prandtl + real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set prandtl ! number unless it is provided as a parameter real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. @@ -146,16 +147,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the "//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& - "may be used.", units="m2 s-1", scale=US%m_to_Z**2, fail_if_missing=.true.) + "may be used.", units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "KV", Kv, & "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.) + units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) ! The following is needed to set one of the choices of vertical background mixing @@ -175,7 +176,7 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "If BULKMIXEDLAYER is false, KDML is the elevated "//& "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z_to_m**2, scale=US%m_to_Z**2) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& "viscosity and diffusivity are elevated when the bulk "//& @@ -194,30 +195,25 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%Bryan_Lewis_diffusivity) then call check_bkgnd_scheme(CS, "BRYAN_LEWIS_DIFFUSIVITY") - call get_param(param_file, mdl, "BRYAN_LEWIS_C1", & - CS%Bryan_Lewis_c1, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C1", CS%Bryan_Lewis_c1, & "The vertical diffusivity values for Bryan-Lewis profile at |z|=D.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C2", & - CS%Bryan_Lewis_c2, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C2", CS%Bryan_Lewis_c2, & "The amplitude of variation in diffusivity for the Bryan-Lewis profile", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C3", & - CS%Bryan_Lewis_c3, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C3", CS%Bryan_Lewis_c3, & "The inverse length scale for transition region in the Bryan-Lewis profile", & units="m-1", fail_if_missing=.true.) - call get_param(param_file, mdl, "BRYAN_LEWIS_C4", & - CS%Bryan_Lewis_c4, & + call get_param(param_file, mdl, "BRYAN_LEWIS_C4", CS%Bryan_Lewis_c4, & "The depth where diffusivity is BRYAN_LEWIS_C1 in the Bryan-Lewis profile",& units="m", fail_if_missing=.true.) endif ! CS%Bryan_Lewis_diffusivity - call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", & - CS%horiz_varying_background, & + call get_param(param_file, mdl, "HORIZ_VARYING_BACKGROUND", CS%horiz_varying_background, & "If true, apply vertically uniform, latitude-dependent background "//& "diffusivity, as described in Danabasoglu et al., 2012", & default=.false.) @@ -225,25 +221,21 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) if (CS%horiz_varying_background) then call check_bkgnd_scheme(CS, "HORIZ_VARYING_BACKGROUND") - call get_param(param_file, mdl, "BCKGRND_VDC1", & - CS%bckgrnd_vdc1, & + call get_param(param_file, mdl, "BCKGRND_VDC1", CS%bckgrnd_vdc1, & "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.16e-04, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.16e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_EQ", & - CS%bckgrnd_vdc_eq, & + call get_param(param_file, mdl, "BCKGRND_VDC_EQ", CS%bckgrnd_vdc_eq, & "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.01e-04, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.01e-04, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", & - CS%bckgrnd_vdc_psim, & + call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", CS%bckgrnd_vdc_psim, & "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.13e-4, scale=US%m_to_Z**2) + units="m2 s-1",default = 0.13e-4, scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "BCKGRND_VDC_BAN", & - CS%bckgrnd_vdc_ban, & + call get_param(param_file, mdl, "BCKGRND_VDC_BAN", CS%bckgrnd_vdc_Banda, & "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 1.0e-4, scale=US%m_to_Z**2) + units="m2 s-1",default = 1.0e-4, scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -283,11 +275,15 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "diffusivity (KD) is specified along with "//trim(CS%bkgnd_scheme_str)) endif - if (CS%Henyey_IGW_background) & + if (CS%Henyey_IGW_background) then call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & "The ratio of the typical Buoyancy frequency to twice "//& "the Earth's rotation period, used with the Henyey "//& "scaling from the mixing.", units="nondim", default=20.0) + call get_param(param_file, mdl, "OMEGA", CS%omega, & + "The rotation rate of the earth.", units="s-1", & + default=7.2921e-5, scale=US%T_to_s) + endif call get_param(param_file, mdl, "KD_TANH_LAT_FN", & CS%Kd_tanh_lat_fn, & @@ -308,16 +304,16 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! call closeParameterBlock(param_file) ! allocate arrays and set them to zero - allocate(CS%kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. + allocate(CS%Kd_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kd_bkgnd(:,:,:) = 0. allocate(CS%kv_bkgnd(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%kv_bkgnd(:,:,:) = 0. allocate(CS%Kd_sfc(SZI_(G), SZJ_(G))); CS%Kd_sfc(:,:) = 0. ! Register diagnostics CS%diag => diag CS%id_kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z_to_m**2) + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) end subroutine bkgnd_mixing_init @@ -370,7 +366,7 @@ subroutine sfc_bkgnd_mixing(G, US, CS) enddo ; enddo endif - if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z_to_m**2) + if (CS%debug) call hchksum(CS%Kd_sfc,"After sfc_bkgnd_mixing: Kd_sfc",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) end subroutine sfc_bkgnd_mixing @@ -388,7 +384,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Kd_lay !< Diapycnal diffusivity of each layer !! [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1] + !! (not layer!) [Z2 T-1 ~> m2 s-1] integer, intent(in) :: j !< Meridional grid index type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by !! a previous call to bkgnd_mixing_init. @@ -400,15 +396,15 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) real, dimension(SZI_(G)) :: depth !< distance from surface of an interface [Z ~> m] real :: depth_c !< depth of the center of a layer [Z ~> m] real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] - real :: I_2Omega !< 1/(2 Omega) [s] - real :: N_2Omega - real :: N02_N2 - real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) + real :: I_2Omega !< 1/(2 Omega) [T ~> s] + real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] + real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] + real :: I_x30 !< 2/acos(2) = 1/(sin(30 deg) * acosh(1/sin(30 deg))) real :: deg_to_rad !< factor converting degrees to radians, pi/180. real :: abs_sin !< absolute value of sine of latitude [nondim] - real :: epsilon - real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere - real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere + real :: epsilon ! The minimum value of the sine of latitude [nondim] + real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] + real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1] integer :: i, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -439,8 +435,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) ! Update Kd and Kv. do K=1,nz+1 - CS%Kv_bkgnd(i,j,K) = US%m_to_Z**2*Kv_col(K) - CS%Kd_bkgnd(i,j,K) = US%m_to_Z**2*Kd_col(K) + CS%Kv_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kv_col(K) + CS%Kd_bkgnd(i,j,K) = US%m2_s_to_Z2_T*Kd_col(K) enddo do k=1,nz Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1)) @@ -456,7 +452,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) if (depth_c <= CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kdml elseif (depth_c >= 2.0*CS%Hmix) then ; CS%Kd_bkgnd(i,j,k) = CS%Kd_sfc(i,j) else - Kd_lay(i,j,k) = US%T_to_s * ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & + Kd_lay(i,j,k) = ((CS%Kd_sfc(i,j) - CS%Kdml) * I_Hmix) * depth_c + & (2.0*CS%Kdml - CS%Kd_sfc(i,j)) endif @@ -464,61 +460,64 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) enddo ; enddo elseif (CS%horiz_varying_background) then + !### Note that there are lots of hard-coded parameters (mostly latitudes and longitudes) here. do i=is,ie - bckgrnd_vdc_psis= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)+28.9))**2.0) - bckgrnd_vdc_psin= CS%bckgrnd_vdc_psim*exp(-(0.4*(G%geoLatT(i,j)-28.9))**2.0) - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis + bckgrnd_vdc_psis = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)+28.9))**2) + bckgrnd_vdc_psin = CS%bckgrnd_vdc_psim * exp(-(0.4*(G%geoLatT(i,j)-28.9))**2) + !### Add parentheses. + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_eq + bckgrnd_vdc_psin + bckgrnd_vdc_psis if (G%geoLatT(i,j) < -10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 elseif (G%geoLatT(i,j) <= 10.0) then - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2.0 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 * (G%geoLatT(i,j)/10.0)**2 else - CS%kd_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 + CS%Kd_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) + CS%bckgrnd_vdc1 endif ! North Banda Sea if ( (G%geoLatT(i,j) < -1.0) .and. (G%geoLatT(i,j) > -4.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 103.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 134.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Middle Banda Sea if ( (G%geoLatT(i,j) <= -4.0) .and. (G%geoLatT(i,j) > -7.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 106.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 140.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! South Banda Sea if ( (G%geoLatT(i,j) <= -7.0) .and. (G%geoLatT(i,j) > -8.3) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) > 111.0) .and. & ( mod(G%geoLonT(i,j)+360.0,360.0) < 142.0) ) then - CS%kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_ban + CS%Kd_bkgnd(i,j,:) = CS%bckgrnd_vdc_Banda endif ! Compute kv_bkgnd - CS%kv_bkgnd(i,j,:) = CS%kd_bkgnd(i,j,:) * CS%prandtl_bkgnd + CS%kv_bkgnd(i,j,:) = CS%Kd_bkgnd(i,j,:) * CS%prandtl_bkgnd ! Update Kd (uniform profile; no interpolation needed) - Kd_lay(i,j,:) = US%T_to_s * CS%kd_bkgnd(i,j,1) + Kd_lay(i,j,:) = CS%Kd_bkgnd(i,j,1) enddo elseif (CS%Henyey_IGW_background_new) then I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. + I_2Omega = 0.5 / CS%omega do k=1,nz ; do i=is,ie - abs_sin = max(epsilon,abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sin,sqrt(US%s_to_T**2 * N2_lay(i,k))*I_2Omega) + abs_sin = max(epsilon, abs(sin(G%geoLatT(i,j)*deg_to_rad))) + N_2Omega = max(abs_sin, sqrt(N2_lay(i,k))*I_2Omega) N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,j,k) = US%T_to_s * max(CS%Kd_min, CS%Kd_sfc(i,j) * & + Kd_lay(i,j,k) = max(CS%Kd_min, CS%Kd_sfc(i,j) * & ((abs_sin * invcosh(N_2Omega/abs_sin)) * I_x30)*N02_N2) enddo ; enddo else do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = US%T_to_s * CS%Kd_sfc(i,j) + Kd_lay(i,j,k) = CS%Kd_sfc(i,j) enddo ; enddo endif @@ -528,7 +527,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kv, j, G, GV, US, CS) CS%kd_bkgnd(i,j,1) = 0.0; CS%kv_bkgnd(i,j,1) = 0.0 CS%kd_bkgnd(i,j,nz+1) = 0.0; CS%kv_bkgnd(i,j,nz+1) = 0.0 do k=2,nz - CS%Kd_bkgnd(i,j,k) = US%s_to_T * (0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K))) + CS%Kd_bkgnd(i,j,k) = 0.5*(Kd_lay(i,j,K-1) + Kd_lay(i,j,K)) CS%Kv_bkgnd(i,j,k) = CS%Kd_bkgnd(i,j,k) * CS%prandtl_bkgnd enddo enddo diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 17b7bb5c15..7b355ff960 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -11,7 +11,7 @@ module MOM_bulk_mixed_layer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : extractFluxes1d, forcing use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type +use MOM_opacity, only : absorbRemainingSW, optics_type, extract_optics_slice use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -52,9 +52,9 @@ module MOM_bulk_mixed_layer real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to !! avoid boiling the ocean. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z s-1 ~> m s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: dT_dS_wt !< When forced to extrapolate T & S to match the !! layer densities, this factor (in degC / ppt) is !! combined with the derivatives of density with T & S @@ -62,12 +62,21 @@ module MOM_bulk_mixed_layer !! density contours. It should be a typical value of !! (dR/dS) / (dR/dT) in oceanic profiles. !! 6 degC ppt-1 might be reasonable. + real :: Hbuffer_min !< The minimum buffer layer thickness when the mixed layer + !! is very large [H ~> m or kg m-2]. + real :: Hbuffer_rel_min !< The minimum buffer layer thickness relative to the combined + !! mixed and buffer layer thicknesses when they are thin [nondim] + real :: BL_detrain_time !< A timescale that characterizes buffer layer detrainment + !! events [T ~> s]. real :: BL_extrap_lim !< A limit on the density range over which !! extrapolation can occur when detraining from the !! buffer layers, relative to the density range !! within the mixed and buffer layers, when the !! detrainment is going into the lightest interior - !! layer, nondimensional. + !! layer [nondim]. + real :: BL_split_rho_tol !< The fractional tolerance for matching layer target densities + !! when splitting layers to deal with massive interior layers + !! that are lighter than one of the mixed or buffer layers [nondim]. logical :: ML_resort !< If true, resort the layers by density, rather than !! doing convective adjustment. integer :: ML_presort_nz_conv_adj !< If ML_resort is true, do convective @@ -110,7 +119,7 @@ module MOM_bulk_mixed_layer real :: Allowed_S_chg !< The amount by which salinity is allowed !! to exceed previous values during detrainment, ppt. - ! These are terms in the mixed layer TKE budget, all in [Z m2 s-3 ~> m3 s-3]. + ! These are terms in the mixed layer TKE budget, all in [Z m2 T-3 ~> m3 s-3] except as noted. real, allocatable, dimension(:,:) :: & ML_depth, & !< The mixed layer depth [H ~> m or kg m-2]. diag_TKE_wind, & !< The wind source of TKE. @@ -121,8 +130,10 @@ module MOM_bulk_mixed_layer diag_TKE_conv_decay, & !< The decay of convective TKE. diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer. diag_TKE_conv_s2, & !< The convective source of TKE due to to mixing in sigma2. - diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer detrainment, W Z m-3. - diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only detrainment, W Z m-3. + diag_PE_detrain, & !< The spurious source of potential energy due to mixed layer + !! detrainment [kg T-3 Z m-1 ~> W m-2]. + diag_PE_detrain2 !< The spurious source of potential energy due to mixed layer only + !! detrainment [kg T-3 Z m-1 ~> W m-2]. logical :: allow_clocks_in_omp_loops !< If true, clocks can be called from inside loops that can !! be threaded. To run with multiple threads, set to False. type(group_pass_type) :: pass_h_sum_hmbl_prev !< For group halo pass @@ -173,7 +184,7 @@ module MOM_bulk_mixed_layer !! For a traditional Kraus-Turner mixed layer, the values are: !! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, !! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 -subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & +subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt_in_T, ea, eb, G, GV, US, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -192,7 +203,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: ea !< The amount of fluid moved downward into a !! layer; this should be increased due to @@ -213,7 +224,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C !! being applied separately. real, optional, intent(in) :: dt_diag !< The diagnostic time step, !! which may be less than dt if there are - !! two callse to mixedlayer [s]. + !! two callse to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< if true, this is the last call !! to mixedlayer in the current time step, so !! diagnostics will be written. The default is @@ -252,9 +263,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h_miss ! The summed absolute mismatch [Z ~> m]. real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a - ! time step [Z m2 s-2 ~> m3 s-2]. + ! time step [Z m2 T-2 ~> m3 s-2]. Conv_En, & ! The turbulent kinetic energy source due to mixing down to - ! the depth of free convection [Z m2 s-2 ~> m3 s-2]. + ! the depth of free convection [Z m2 T-2 ~> m3 s-2]. htot, & ! The total depth of the layers being considered for ! entrainment [H ~> m or kg m-2]. R0_tot, & ! The integrated potential density referenced to the surface @@ -289,8 +300,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! salinity [kg m-3 ppt-1]. dRcv_dS, & ! Partial derivative of the coordinate variable potential ! density in the mixed layer with salinity [kg m-3 ppt-1]. - TKE_river ! The turbulent kinetic energy available for mixing at rivermouths over a - ! time step [Z m2 s-2 ~> m3 s-2]. + TKE_river ! The source of turbulent kinetic energy available for mixing + ! at rivermouths [Z m2 T-3 ~> m3 s-3]. real, dimension(max(CS%nsw,1),SZI_(G)) :: & Pen_SW_bnd ! The penetrating fraction of the shortwave heating integrated @@ -304,19 +315,18 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: Irho0 ! 1.0 / rho_0 [m3 kg-1] real :: Inkml, Inkmlm1! 1.0 / REAL(nkml) and 1.0 / REAL(nkml-1) real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. - real :: Idt ! The inverse of the timestep [s-1]. - real :: Idt_diag ! The inverse of the timestep used for diagnostics [s-1]. + real :: Idt_diag ! The inverse of the timestep used for diagnostics [T-1 ~> s-1]. real :: RmixConst real, dimension(SZI_(G)) :: & dKE_FC, & ! The change in mean kinetic energy due to free convection - ! [Z m2 s-2 ~> m3 s-2]. + ! [Z m2 T-2 ~> m3 s-2]. h_CA ! The depth to which convective adjustment has gone [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)) :: & dKE_CA, & ! The change in mean kinetic energy due to convective - ! adjustment [Z m2 s-2 ~> m3 s-2]. + ! adjustment [Z m2 T-2 ~> m3 s-2]. cTKE ! The turbulent kinetic energy source due to convective - ! adjustment [Z m2 s-2 ~> m3 s-2]. + ! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZJ_(G)) :: & Hsfc_max, & ! The thickness of the surface region (mixed and buffer layers) ! after entrainment but before any buffer layer detrainment [Z ~> m]. @@ -335,9 +345,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: dHsfc, dHD ! Local copies of nondimensional parameters. real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. - real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z s-1 ~> m s-1]. - real :: kU_star ! Ustar times the Von Karmen constant [Z s-1 ~> m s-1]. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. + real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. + real :: kU_star ! Ustar times the Von Karmen constant [Z T-1 ~> m s-1]. +! real :: dt_in_T ! Time increment in time units [T ~> s]. + real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. integer :: i, j, k, is, ie, js, je, nz, nkmb, n @@ -359,10 +370,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C Inkml = 1.0 / REAL(CS%nkml) if (CS%nkml > 1) Inkmlm1 = 1.0 / REAL(CS%nkml-1) +! dt_in_T = dt * US%s_to_T + Irho0 = 1.0 / GV%Rho0 - dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - Idt = 1.0 / dt - Idt_diag = 1.0 / dt__diag + dt__diag = dt_in_T ; if (present(dt_diag)) dt__diag = dt_diag + Idt_diag = 1.0 / (dt__diag) write_diags = .true. ; if (present(last_call)) write_diags = last_call p_ref(:) = 0.0 ; p_ref_cv(:) = tv%P_Ref @@ -394,7 +406,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! Determine whether to zero out diagnostics before accumulation. reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt_in_T)) & reset_diags = .false. ! This is the second call to mixedlayer. if (reset_diags) then @@ -442,10 +454,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C h_orig(i,k) = h_3d(i,j,k) eps(i,k) = 0.0 ; if (k > nkmb) eps(i,k) = GV%Angstrom_H T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - do n=1,nsw - opacity_band(n,i,k) = GV%H_to_m*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacity_band, opacity_scale=GV%H_to_m) do k=1,nz ; do i=is,ie d_ea(i,k) = 0.0 ; d_eb(i,k) = 0.0 @@ -473,7 +483,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_resort>0) call cpu_clock_begin(id_clock_resort) if (CS%ML_presort_nz_conv_adj > 0) & call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS, & + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS, & CS%ML_presort_nz_conv_adj) call sort_ML(h(:,1:), R0(:,1:), eps, G, GV, CS, ksort) @@ -486,7 +496,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! to remove hydrostatic instabilities. Any water that is lighter than ! currently in the mixed or buffer layer is entrained. call convective_adjustment(h(:,1:), u, v, R0(:,1:), Rcv(:,1:), T(:,1:), & - S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, CS) + S(:,1:), eps, d_eb, dKE_CA, cTKE, j, G, GV, US, CS) do i=is,ie ; h_CA(i) = h(i,1) ; enddo if (id_clock_adjustment>0) call cpu_clock_end(id_clock_adjustment) @@ -504,10 +514,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RmixConst = 0.5*CS%rivermix_depth * (GV%g_Earth*US%m_to_Z) * Irho0**2 + RmixConst = 0.5*CS%rivermix_depth * (US%L_to_m**2*GV%LZT_g_Earth*US%m_to_Z) * Irho0**2 do i=is,ie TKE_river(i) = max(0.0, RmixConst*dR0_dS(i)* & - (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) + US%T_to_s*(fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * S(i,1)) enddo else do i=is,ie ; TKE_river(i) = 0.0 ; enddo @@ -523,7 +533,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! net_heat = heat via surface fluxes [degC H ~> degC m or degC kg m-2] ! net_salt = salt via surface fluxes [ppt H ~> dppt m or gSalt m-2] ! Pen_SW_bnd = components to penetrative shortwave radiation - call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & + call extractFluxes1d(G, GV, fluxes, optics, nsw, j, US%T_to_s*dt_in_T, & CS%H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h(:,1:), T(:,1:), netMassInOut, netMassOut, Net_heat, Net_salt, Pen_SW_bnd,& tv, aggregate_FW_forcing) @@ -535,21 +545,21 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) if (id_clock_conv>0) call cpu_clock_end(id_clock_conv) ! Now the mixed layer undergoes mechanically forced entrainment. ! The mixed layer may entrain down to the Monin-Obukhov depth if the - ! surface is becoming lighter, and is effectively detraining. + ! surface is becoming lighter, and is effecti1336vely detraining. ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. if (id_clock_mech>0) call cpu_clock_begin(id_clock_mech) call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & j, ksort, G, GV, US, CS) ! Here the mechanically driven entrainment occurs. @@ -558,8 +568,8 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C cMKE, Idt_diag, nsw, Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, US, CS) - call absorbRemainingSW(G, GV, h(:,1:), opacity_band, nsw, j, dt, CS%H_limit_fluxes, & - CS%correct_absorption, CS%absorb_all_SW, & + call absorbRemainingSW(G, GV, US, h(:,1:), opacity_band, nsw, optics, j, dt_in_T, & + CS%H_limit_fluxes, CS%correct_absorption, CS%absorb_all_SW, & T(:,1:), Pen_SW_bnd, eps, ksort, htot, Ttot) if (CS%TKE_diagnostics) then ; do i=is,ie @@ -632,11 +642,11 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C if (id_clock_detrain>0) call cpu_clock_begin(id_clock_detrain) if (CS%nkbl == 1) then call mixedlayer_detrain_1(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, d_eb, j, G, GV, CS, & + GV%Rlay, dt_in_T, dt__diag, d_ea, d_eb, j, G, GV, US, CS, & dRcv_dT, dRcv_dS, max_BL_det) elseif (CS%nkbl == 2) then call mixedlayer_detrain_2(h(:,0:), T(:,0:), S(:,0:), R0(:,0:), Rcv(:,0:), & - GV%Rlay, dt, dt__diag, d_ea, j, G, GV, CS, & + GV%Rlay, dt_in_T, dt__diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) else ! CS%nkbl not = 1 or 2 ! This code only works with 1 or 2 buffer layers. @@ -663,20 +673,19 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_Star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - kU_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & + kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) endif - absf_x_H = 0.25 * US%m_to_Z * US%s_to_T * h(i,0) * & !### I think this should be H_to_Z -RWH + absf_x_H = 0.25 * GV%H_to_Z * h(i,0) * & ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) ! If the mixed layer vertical viscosity specification is changed in ! MOM_vert_friction.F90, this line will have to be modified accordingly. - h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / & - (kU_star**2)) ) + h_3d(i,j,1) = h(i,0) / (3.0 + sqrt(absf_x_H*(absf_x_H + 2.0*kU_star) / kU_star**2)) do k=2,CS%nkml ! The other layers are evenly distributed through the mixed layer. h_3d(i,j,k) = (h(i,0)-h_3d(i,j,1)) * Inkmlm1 @@ -793,7 +802,7 @@ end subroutine bulkmixedlayer !! layers and mixed layers to remove hydrostatic instabilities. Any water that !! is lighter than currently in the mixed- or buffer- layer is entrained. subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & - dKE_CA, cTKE, j, G, GV, CS, nz_conv) + dKE_CA, cTKE, j, G, GV, US, CS, nz_conv) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. @@ -816,11 +825,12 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & !! that will be left in each layer [H ~> m or kg m-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. integer, optional, intent(in) :: nz_conv !< If present, the number of layers !! over which to do convective adjustment @@ -851,11 +861,11 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! in m7 s-2 Z-1 H-2 kg-1. !### CHECK UNITS + ! in [m5 Z T-2 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. integer :: is, ie, nz, i, k, k1, nzc, nkmb is = G%isc ; ie = G%iec ; nz = GV%ke - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + g_H2_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) nzc = nz ; if (present(nz_conv)) nzc = nz_conv nkmb = CS%nkml+CS%nkbl @@ -905,7 +915,7 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & Ih = 1.0 / h(i,k1) R0(i,k1) = R0_tot(i) * Ih u(i,k1) = uhtot(i) * Ih ; v(i,k1) = vhtot(i) * Ih - dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * (CS%bulk_Ri_convective * & + dKE_CA(i,k1) = dKE_CA(i,k1) + GV%H_to_Z * US%T_to_s**2*(CS%bulk_Ri_convective * & (KE_orig(i) - 0.5*h(i,k1)*(u(i,k1)**2 + v(i,k1)**2))) Rcv(i,k1) = Rcv_tot(i) * Ih T(i,k1) = Ttot(i) * Ih ; S(i,k1) = Stot(i) * Ih @@ -928,7 +938,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & netMassInOut, netMassOut, Net_heat, Net_salt, & nsw, Pen_SW_bnd, opacity_band, Conv_en, & - dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & + dKE_FC, j, ksort, G, GV, US, CS, tv, fluxes, dt_in_T, & aggregate_FW_forcing) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -997,21 +1007,21 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. !! The indicies of opacity_band are band, i, k. real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + !! due to free convection [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change in kinetic - !! energy due to free convection [Z m2 s-2 ~> m3 s-2]. + !! energy due to free convection [Z m2 T-2 ~> m3 s-2]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indices. - type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this - !! module. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent !! fields have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -1045,13 +1055,13 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! h_ent between iterations [H ~> m or kg m-2]. real :: g_H2_2Rho0 ! Half the gravitational acceleration times the square of ! the conversion from H to Z divided by the mean density, - ! [m7 s-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. + ! [m7 T-2 Z-1 H-2 kg-1 ~> m4 s-2 kg-1 or m10 s-2 kg-3]. real :: Angstrom ! The minimum layer thickness [H ~> m or kg m-2]. real :: opacity ! The opacity converted to inverse thickness units [H-1 ~> m-1 or m2 kg-1] real :: sum_Pen_En ! The potential energy change due to penetrating ! shortwave radiation, integrated over a layer ! [H kg m-3 ~> kg m-2 or kg2 m-5]. - real :: Idt ! 1.0/dt [s-1] + real :: Idt ! 1.0/dt [T-1 ~> s-1] real :: netHeatOut ! accumulated heat content of mass leaving ocean integer :: is, ie, nz, i, k, ks, itt, n real, dimension(max(nsw,1)) :: & @@ -1060,8 +1070,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Angstrom = GV%Angstrom_H C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 - g_H2_2Rho0 = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) - Idt = 1.0/dt + g_H2_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0) + Idt = 1.0 / dt_in_T is = G%isc ; ie = G%iec ; nz = GV%ke do i=is,ie ; if (ksort(i,1) > 0) then @@ -1114,8 +1124,8 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & dRcv_dS(i) * (netMassIn(i) * S(i,1) - Net_salt(i))) Conv_En(i) = 0.0 ; dKE_FC(i) = 0.0 if (associated(fluxes%heat_content_massin)) & - fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) & - + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt + fluxes%heat_content_massin(i,j) = fluxes%heat_content_massin(i,j) + US%s_to_T * & + T_precip * netMassIn(i) * GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + & T_precip * netMassIn(i) * GV%H_to_kg_m2 endif ; enddo @@ -1166,9 +1176,9 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & ! heat_content_massout = heat_content_massout - T(i,k)*h_evap*GV%H_to_kg_m2*fluxes%C_p*Idt ! by uncommenting the lines here. ! we will also then completely remove TempXpme from the model. - if (associated(fluxes%heat_content_massout)) & - fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) & - - T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt + if (associated(fluxes%heat_content_massout)) & + fluxes%heat_content_massout(i,j) = fluxes%heat_content_massout(i,j) - US%s_to_T * & + T(i,k)*h_evap*GV%H_to_kg_m2 * fluxes%C_p * Idt if (associated(tv%TempxPmE)) tv%TempxPmE(i,j) = tv%TempxPmE(i,j) - & T(i,k)*h_evap*GV%H_to_kg_m2 @@ -1278,7 +1288,7 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (htot(i) > 0.0) & dKE_FC(i) = dKE_FC(i) + CS%bulk_Ri_convective * 0.5 * & ((GV%H_to_Z*h_ent) / (htot(i)*(h_ent+htot(i)))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) + US%T_to_s**2*((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) htot(i) = htot(i) + h_ent h(i,k) = h(i,k) - h_ent @@ -1296,7 +1306,7 @@ end subroutine mixedlayer_convection !> This subroutine determines the TKE available at the depth of free !! convection to drive mechanical entrainment. subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & - TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & + TKE, TKE_river, Idecay_len_TKE, cMKE, dt_in_T, Idt_diag, & j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1309,31 +1319,31 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, !! possible forcing fields. Unused fields !! have NULL ptrs. real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source - !! due to free convection [Z m2 s-2 ~> m3 s-2]. + !! due to free convection [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in !! kinetic energy due to free convection - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: cTKE !< The buoyant turbulent kinetic energy !! source due to convective adjustment - !! [Z m2 s-2 ~> m3 s-2]. + !! [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G),SZK_(GV)), & intent(in) :: dKE_CA !< The vertically integrated change in !! kinetic energy due to convective - !! adjustment [Z m2 s-2 ~> m3 s-2]. + !! adjustment [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for - !! mixing over a time step [Z m2 s-2 ~> m3 s-2]. + !! mixing over a time step [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay !! scale for TKE [H-1 ~> m-1 or m2 kg-1]. - real, dimension(SZI_(G)), intent(in) :: TKE_river !< The turbulent kinetic energy available - !! for driving mixing at river mouths - !! integrated over a time step [Z m2 s-2 ~> m3 s-2]. + real, dimension(SZI_(G)), intent(in) :: TKE_river !< The source of turbulent kinetic energy + !! available for driving mixing at river mouths + !! [Z m2 T-3 ~> m3 s-3]. real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in !! calculating the denominator of MKE_rate, !! [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. - real, intent(in) :: dt !< The time step [s]. + real, intent(in) :: dt_in_T !< The time step [T ~> s]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & intent(in) :: ksort !< The density-sorted k-indicies. @@ -1343,46 +1353,46 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! convection to drive mechanical entrainment. ! Local variables - real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 s-2 ~> m3 s-2]. + real :: dKE_conv ! The change in mean kinetic energy due to all convection [Z m2 T-2 ~> m3 s-2]. real :: nstar_FC ! The effective efficiency with which the energy released by ! free convection is converted to TKE, often ~0.2 [nondim]. real :: nstar_CA ! The effective efficiency with which the energy released by ! convective adjustment is converted to TKE, often ~0.2 [nondim]. real :: TKE_CA ! The potential energy released by convective adjustment if - ! that release is positive [Z m2 s-2 ~> m3 s-2]. + ! that release is positive [Z m2 T-2 ~> m3 s-2]. real :: MKE_rate_CA ! MKE_rate for convective adjustment [nondim], 0 to 1. real :: MKE_rate_FC ! MKE_rate for free convection [nondim], 0 to 1. - real :: totEn_Z ! The total potential energy released by convection, [Z3 s-2 ~> m3 s-2]. + real :: totEn_Z ! The total potential energy released by convection, [Z3 T-2 ~> m3 s-2]. real :: Ih ! The inverse of a thickness [H-1 ~> m-1 or m2 kg-1]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. - real :: absf ! The absolute value of f averaged to thickness points [s-1]. - real :: U_star ! The friction velocity [Z s-1 ~> m s-1]. + real :: absf ! The absolute value of f averaged to thickness points [T-1 ~> s-1]. + real :: U_star ! The friction velocity [Z T-1 ~> m s-1]. real :: absf_Ustar ! The absolute value of f divided by U_star [Z-1 ~> m-1]. - real :: wind_TKE_src ! The surface wind source of TKE [Z m2 s-3 ~> m3 s-3]. + real :: wind_TKE_src ! The surface wind source of TKE [Z m2 T-3 ~> m3 s-3]. real :: diag_wt ! The ratio of the current timestep to the diagnostic ! timestep (which may include 2 calls) [nondim]. integer :: is, ie, nz, i is = G%isc ; ie = G%iec ; nz = GV%ke - diag_wt = dt * Idt_diag + diag_wt = dt_in_T * Idt_diag if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_Star = fluxes%ustar(i,j) + U_star = fluxes%ustar(i,j) if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_Star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & + U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (U_star < CS%ustar_min) U_star = CS%ustar_min if (CS%omega_frac < 1.0) then - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif - absf_Ustar = absf / U_Star + absf_Ustar = absf / U_star Idecay_len_TKE(i) = (absf_Ustar * CS%TKE_decay) * GV%H_to_Z ! The first number in the denominator could be anywhere up to 16. The @@ -1395,7 +1405,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! scales contribute to mixed layer deepening at similar rates, even though ! small scales are dissipated more rapidly (implying they are less efficient). ! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) + Ih = GV%H_to_Z/(3.0*0.41*U_star*dt_in_T) cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then @@ -1414,7 +1424,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (totEn_Z > 0.0) then nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1424,7 +1434,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (Conv_En(i) > 0.0) then totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA * (htot(i) / h_CA(i)) ) nstar_FC = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(htot(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_FC = CS%nstar endif @@ -1432,7 +1442,7 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, totEn_Z = US%m_to_Z**2 * (Conv_En(i) + TKE_CA) if (TKE_CA > 0.0) then nstar_CA = CS%nstar * totEn_Z / (totEn_Z + 0.2 * & - sqrt(0.5 * dt * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) + sqrt(0.5 * dt_in_T * (absf*(h_CA(i)*GV%H_to_Z))**3 * totEn_Z)) else nstar_CA = CS%nstar endif @@ -1454,15 +1464,15 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, dKE_conv = dKE_CA(i,1) * MKE_rate_CA + dKE_FC(i) * MKE_rate_FC ! At this point, it is assumed that cTKE is positive and stored in TKE_CA! ! Note: Removed factor of 2 in u*^3 terms. - TKE(i) = (dt*CS%mstar)*((US%Z_to_m**2*(U_Star*U_Star*U_Star))*exp_kh) + & + TKE(i) = (dt_in_T*CS%mstar)*((US%Z_to_m**2*(U_star*U_Star*U_Star))*exp_kh) + & (exp_kh * dKE_conv + nstar_FC*Conv_En(i) + nstar_CA * TKE_CA) if (CS%do_rivermix) then ! Add additional TKE at river mouths - TKE(i) = TKE(i) + TKE_river(i)*dt*exp_kh + TKE(i) = TKE(i) + TKE_river(i)*dt_in_T*exp_kh endif if (CS%TKE_diagnostics) then - wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_Star*U_Star*U_Star) * diag_wt + wind_TKE_src = CS%mstar*(US%Z_to_m**2*U_star*U_Star*U_Star) * diag_wt CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + & ( wind_TKE_src + TKE_river(i) * diag_wt ) CS%diag_TKE_RiBulk(i,j) = CS%diag_TKE_RiBulk(i,j) + dKE_conv*Idt_diag @@ -1532,7 +1542,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! denominator of MKE_rate; the two elements have differing !! units of [H-1 ~> m-1 or m2 kg-1] and [H-2 ~> m-2 or m4 kg-2]. real, intent(in) :: Idt_diag !< The inverse of the accumulated diagnostic - !! time interval [s-1]. + !! time interval [T-1 ~> s-1]. integer, intent(in) :: nsw !< The number of bands of penetrating !! shortwave radiation. real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave heating at the @@ -1544,7 +1554,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & !! The indicies of opacity_band are (band, i, k). real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy !! available for mixing over a time - !! step [Z m2 s-2 ~> m3 s-2]. + !! step [Z m2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE !< The vertical TKE decay rate [H-1 ~> m-1 or m2 kg-1]. integer, intent(in) :: j !< The j-index to work on. integer, dimension(SZI_(G),SZK_(GV)), & @@ -1569,22 +1579,22 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & real :: HpE ! The current thickness plus entrainment [H ~> m or kg m-2]. real :: g_H_2Rho0 ! Half the gravitational acceleration times the ! conversion from H to m divided by the mean density, - ! in m5 s-2 H-1 kg-1. + ! in [m5 T-2 H-1 kg-1 ~> m4 s-2 kg-1 or m7 s-2 kg-2]. real :: TKE_full_ent ! The TKE remaining if a layer is fully entrained - ! [Z m2 s-2 ~> m3 s-2]. + ! [Z m2 T-2 ~> m3 s-2]. real :: dRL ! Work required to mix water from the next layer - ! across the mixed layer [m2 s-2]. + ! across the mixed layer [m2 T-2 ~> m2 s-2]. real :: Pen_En_Contrib ! Penetrating SW contributions to the changes in - ! TKE, divided by layer thickness in m [m2 s-2]. - real :: C1 ! A temporary variable [m2 s-2]. + ! TKE, divided by layer thickness in m [m2 T2 ~> m2 s-2]. + real :: Cpen1 ! A temporary variable [m2 T-2 ~> m2 s-2]. real :: dMKE ! A temporary variable related to the release of mean - ! kinetic energy, with units of H Z m2 s-2. - real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 s-2 ~> m3 s-2]. + ! kinetic energy [H Z m2 T-2 ~> m4 s-2 or kg m s-2] + real :: TKE_ent ! The TKE that remains if h_ent were entrained [Z m2 T-2 ~> m3 s-2]. real :: TKE_ent1 ! The TKE that would remain, without considering the - ! release of mean kinetic energy [Z m2 s-2 ~> m3 s-2]. - real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 s-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. + ! release of mean kinetic energy [Z m2 T-2 ~> m3 s-2]. + real :: dTKE_dh ! The partial derivative of TKE with h_ent [Z m2 T-2 H-1 ~> m2 s-2 or m5 s-2 kg-1]. real :: Pen_dTKE_dh_Contrib ! The penetrating shortwave contribution to - ! dTKE_dh [m2 s-2]. + ! dTKE_dh [m2 T-2 ~> m2 s-2]. real :: EF4_val ! The result of EF4() (see later) [H-1 ~> m-1 or m2 kg-1]. 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]. @@ -1603,7 +1613,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & integer :: is, ie, nz, i, k, ks, itt, n C1_3 = 1.0/3.0 ; C1_6 = 1.0/6.0 ; C1_24 = 1.0/24.0 - g_H_2Rho0 = (GV%g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) + g_H_2Rho0 = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z) / (2.0 * GV%Rho0) Hmix_min = CS%Hmix_min h_neglect = GV%H_subroundoff is = G%isc ; ie = G%iec ; nz = GV%ke @@ -1616,7 +1626,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & h_avail = h(i,k) - eps(i,k) if ((h_avail > 0.) .and. ((TKE(i) > 0.) .or. (htot(i) < Hmix_min))) then dRL = g_H_2Rho0 * (R0(i,k)*htot(i) - R0_tot(i) ) - dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * & + dMKE = (GV%H_to_Z * CS%bulk_Ri_ML) * 0.5 * US%T_to_s**2 * & ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) ! Find the TKE that would remain if the entire layer were entrained. @@ -1671,8 +1681,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & if (CS%TKE_diagnostics) then E_HxHpE = h_ent / ((htot(i)+h_neglect)*(htot(i)+h_ent+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & MKE_rate*dMKE*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(GV%H_to_Z*h_ent)*dRL @@ -1683,7 +1692,8 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & endif TKE(i) = TKE_full_ent - if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%m_to_Z + !### The minimum TKE value in this line may be problematically small. + if (TKE(i) <= 0.0) TKE(i) = 1.0e-150*US%T_to_s**2*US%m_to_Z else ! The layer is only partially entrained. The amount that will be ! entrained is determined iteratively. No further layers will be @@ -1736,10 +1746,10 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & Pen_En1 = exp_kh * ((1.0+opacity*htot(i))*f1_x1 + & opacity*h_ent*f2_x1) endif - C1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) - Pen_En_Contrib = Pen_En_Contrib + C1*(Pen_En1 - f1_kh) + Cpen1 = g_H_2Rho0*dR0_dT(i)*Pen_SW_bnd(n,i) + Pen_En_Contrib = Pen_En_Contrib + Cpen1*(Pen_En1 - f1_kh) Pen_dTKE_dh_Contrib = Pen_dTKE_dh_Contrib + & - C1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) + Cpen1*((1.0-SW_trans) - opacity*(htot(i) + h_ent)*SW_trans) endif ; enddo ! (Pen_SW_bnd(n,i) > 0.0) TKE_ent1 = exp_kh*TKE(i) - (h_ent*GV%H_to_Z)*(dRL*f1_kh + Pen_En_Contrib) @@ -1784,8 +1794,7 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & E_HxHpE = h_ent / ((htot(i)+h_neglect)*(HpE+h_neglect)) CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + & - Idt_diag * ((exp_kh-1.0)*TKE(i) + & - (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & + Idt_diag * ((exp_kh-1.0)*TKE(i) + (h_ent*GV%H_to_Z)*dRL*(1.0-f1_kh) + & dMKE*MKE_rate*(EF4_val-E_HxHpE)) CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) - & Idt_diag*(h_ent*GV%H_to_Z)*dRL @@ -1939,7 +1948,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS real :: h_move, h_tgt_old, I_hnew real :: dT_dS_wt2, dT_dR, dS_dR, I_denom real :: Rcv_int - real :: target_match_tol real :: T_up, S_up, R0_up, I_hup, h_to_up real :: T_dn, S_dn, R0_dn, I_hdn, h_to_dn real :: wt_dn @@ -1956,7 +1964,6 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS is = G%isc ; ie = G%iec ; nz = GV%ke nkmb = CS%nkml+CS%nkbl - target_match_tol = 0.1 ! ### MAKE THIS A PARAMETER. dT_dS_wt2 = CS%dT_dS_wt**2 @@ -2018,10 +2025,10 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS k = ks2(ks) leave_in_layer = .false. if ((k > nkmb) .and. (Rcv(i,k) <= RcvTgt(k))) then - if (RcvTgt(k)-Rcv(i,k) < target_match_tol*(RcvTgt(k) - RcvTgt(k-1))) & + if (RcvTgt(k)-Rcv(i,k) < CS%BL_split_rho_tol*(RcvTgt(k) - RcvTgt(k-1))) & leave_in_layer = .true. elseif (k > nkmb) then - if (Rcv(i,k)-RcvTgt(k) < target_match_tol*(RcvTgt(k+1) - RcvTgt(k))) & + if (Rcv(i,k)-RcvTgt(k) < CS%BL_split_rho_tol*(RcvTgt(k+1) - RcvTgt(k))) & leave_in_layer = .true. endif @@ -2199,7 +2206,7 @@ end subroutine resort_ML !> This subroutine moves any water left in the former mixed layers into the !! two buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, CS, & +subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, j, G, GV, US, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -2213,13 +2220,14 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. - real, intent(in) :: dt_diag !< The diagnostic time step [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. + real, intent(in) :: dt_diag !< The diagnostic time step [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea !! goes with layer thickness increases. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of @@ -2257,11 +2265,6 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, real :: S_to_bl ! The depth integrated amount of S that is detrained to the ! buffer layer [ppt H ~> ppt m or ppt kg m-2] real :: h_min_bl ! The minimum buffer layer thickness [H ~> m or kg m-2]. - real :: h_min_bl_thick ! The minimum buffer layer thickness when the - ! mixed layer is very large [H ~> m or kg m-2]. - real :: h_min_bl_frac_ml = 0.05 ! The minimum buffer layer thickness relative - ! to the total mixed layer thickness for thin - ! mixed layers [nondim], maybe 0.1/CS%nkbl. real :: h1, h2 ! Scalar variables holding the values of ! h(i,CS%nkml+1) and h(i,CS%nkml+2) [H ~> m or kg m-2]. @@ -2292,7 +2295,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! rho_0*g [H2 ~> m2 or kg2 m-4]. real :: dPE_det, dPE_merge ! The energy required to mix the detrained water ! into the buffer layer or the merge the two - ! buffer layers [J H2 Z m-5 ~> J m-2 or J kg2 m-8]. + ! buffer layers [kg H2 Z T-2 m-3 ~> J m-2 or J kg2 m-8]. real :: h_from_ml ! The amount of additional water that must be ! drawn from the mixed layer [H ~> m or kg m-2]. @@ -2325,26 +2328,23 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! days? real :: num_events ! The number of detrainment events over which ! to prefer merging the buffer layers. - real :: detrainment_timescale ! The typical timescale for a detrainment - ! event [s]. - real :: dPE_time_ratio ! Larger of 1 and the detrainment_timescale - ! over dt, nondimensional. + real :: dPE_time_ratio ! Larger of 1 and the detrainment timescale over dt [nondim]. real :: dT_dS_gauge, dS_dT_gauge ! The relative scales of temperature and ! salinity changes in defining spiciness, in ! [degC ppt-1] and [ppt degC-1]. real :: I_denom ! A work variable with units of [ppt2 m6 kg-2]. - real :: G_2 ! 1/2 G_Earth [m2 Z-1 s-2 ~> m s-2]. - real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_2 ! 1/2 g_Earth [m2 Z-1 T-2 ~> m s-2]. + real :: Rho0xG ! Rho0 times G_Earth [kg m-1 Z-1 T-2 ~> kg m-2 s-2]. real :: I2Rho0 ! 1 / (2 Rho0) [m3 kg-1]. real :: Idt_H2 ! The square of the conversion from thickness to Z - ! divided by the time step [Z2 H-2 s-1 ~> s-1 or m6 kg-2 s-1]. + ! divided by the time step [Z2 H-2 T-1 ~> s-1 or m6 kg-2 s-1]. logical :: stable_Rcv ! If true, the buffer layers are stable with ! respect to the coordinate potential density. 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 :: s1en ! A work variable [H2 kg m s-3 ~> kg m3 s-3 or kg3 m-3 s-3]. + real :: s1en ! A work variable [H2 kg m T-3 ~> kg m3 s-3 or kg3 m-3 s-3]. real :: s1, s2, bh0 ! Work variables [H ~> m or kg m-2]. real :: s3sq ! A work variable [H2 ~> m2 or kg2 m-4]. real :: I_ya, b1 ! Nondimensional work variables. @@ -2363,22 +2363,20 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, kb1 = CS%nkml+1; kb2 = CS%nkml+2 nkmb = CS%nkml+CS%nkbl h_neglect = GV%H_subroundoff - G_2 = 0.5*GV%g_Earth - Rho0xG = GV%Rho0 * GV%g_Earth + g_2 = 0.5 * US%L_to_m**2*GV%LZT_g_Earth + Rho0xG = GV%Rho0 * US%L_to_m**2*GV%LZT_g_Earth Idt_H2 = GV%H_to_Z**2 / dt_diag I2Rho0 = 0.5 / GV%Rho0 Angstrom = GV%Angstrom_H ! This is hard coding of arbitrary and dimensional numbers. - h_min_bl_thick = 5.0 * GV%m_to_H !### DIMENSIONAL CONSTANT - dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 /dT_dS_gauge + dT_dS_gauge = CS%dT_dS_wt ; dS_dT_gauge = 1.0 / dT_dS_gauge num_events = 10.0 - detrainment_timescale = 4.0*3600.0 !### DIMENSIONAL CONSTANT if (CS%nkbl /= 2) call MOM_error(FATAL, "MOM_mixed_layer"// & "CS%nkbl must be 2 in mixedlayer_detrain_2.") - if (dt < detrainment_timescale) then ; dPE_time_ratio = detrainment_timescale/dt + if (dt_in_T < CS%BL_detrain_time) then ; dPE_time_ratio = CS%BL_detrain_time / (dt_in_T) else ; dPE_time_ratio = 1.0 ; endif do i=is,ie @@ -2425,7 +2423,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, ! Determine whether more must be detrained from the mixed layer to keep a ! minimal amount of mass in the buffer layers. In this case the 5% of the ! mixed layer thickness is hard-coded, but probably shouldn't be! - h_min_bl = MIN(h_min_bl_thick,h_min_bl_frac_ml*h(i,0)) + h_min_bl = MIN(CS%Hbuffer_min, CS%Hbuffer_rel_min*h(i,0)) stable_Rcv = .true. if (((R0(i,kb2)-R0(i,kb1)) * (Rcv(i,kb2)-Rcv(i,kb1)) <= 0.0)) & @@ -2621,7 +2619,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if ((stays_merge > stays_min_merge) .and. & (stays_merge + h2_to_k1_rem >= h1 + h2)) then mergeable_bl = .true. - dPE_merge = G_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge) + dPE_merge = g_2*(R0(i,kb2)-R0(i,kb1))*(h1-stays_merge)*(h2-stays_merge) endif endif @@ -2802,7 +2800,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, if (allocated(CS%diag_PE_detrain) .or. allocated(CS%diag_PE_detrain2)) then R0_det = R0_to_bl*Ihdet - s1en = G_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + & + s1en = g_2 * Idt_H2 * ( ((R0(i,kb2)-R0(i,kb1))*h1*h2 + & h_det_to_h2*( (R0(i,kb1)-R0_det)*h1 + (R0(i,kb2)-R0_det)*h2 ) + & h_ml_to_h2*( (R0(i,kb2)-R0(i,0))*h2 + (R0(i,kb1)-R0(i,0))*h1 + & (R0_det-R0(i,0))*h_det_to_h2 ) + & @@ -2898,7 +2896,7 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, endif endif - dPE_det = G_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + & + dPE_det = g_2*((R0(i,kb1)*h_to_bl - R0_to_bl)*stays + & (R0(i,kb2)-R0(i,kb1)) * (h1-stays) * & (h2 - scale_slope*stays*((h1+h2)+h_to_bl)/(h1+h2)) ) - & Rho0xG*dPE_extrap @@ -3099,8 +3097,8 @@ end subroutine mixedlayer_detrain_2 !> This subroutine moves any water left in the former mixed layers into the !! single buffer layers and may also move buffer layer water into the interior !! isopycnal layers. -subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, & - j, G, GV, CS, dRcv_dT, dRcv_dS, max_BL_det) +subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt_in_T, dt_diag, d_ea, d_eb, & + j, G, GV, US, CS, dRcv_dT, dRcv_dS, max_BL_det) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2]. @@ -3113,9 +3111,9 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! density [kg m-3]. real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each !! layer [kg m-3]. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [T ~> s]. real, intent(in) :: dt_diag !< The accumulated time interval for - !! diagnostics [s]. + !! diagnostics [T ~> s]. real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in !! the entrainment from above !! [H ~> m or kg m-2]. Positive d_ea @@ -3125,6 +3123,7 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e !! Positive values go with mass gain by !! a layer. integer, intent(in) :: j !< The meridional row to work on. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a !! previous call to mixedlayer_init. real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of @@ -3145,17 +3144,16 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e real :: max_det_rem(SZI_(G)) ! Remaining permitted detrainment [H ~> m or kg m-2]. real :: detrain(SZI_(G)) ! The thickness of fluid to detrain ! from the mixed layer [H ~> m or kg m-2]. - real :: Idt ! The inverse of the timestep [s-1]. real :: dT_dR, dS_dR, dRml, dR0_dRcv, dT_dS_wt2 real :: I_denom ! A work variable [ppt2 m6 kg-2]. real :: Sdown, Tdown - real :: dt_Time, Timescale = 86400.0*30.0! *365.0/12.0 + real :: dt_Time ! The timestep divided by the detrainment timescale [nondim]. real :: g_H2_2Rho0dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the mean density times the time - ! step [m7 s-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. + ! step [m7 T-3 Z-1 H-2 kg-1 ~> m4 s-3 kg-1 or m10 s-3 kg-3]. real :: g_H2_2dt ! Half the gravitational acceleration times the square of the ! conversion from H to m divided by the diagnostic time step - ! [m4 Z-1 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! [m4 Z-1 H-2 T-3 ~> m s-3 or m7 kg-2 s-3]. logical :: splittable_BL(SZI_(G)), orthogonal_extrap real :: x1 @@ -3165,10 +3163,10 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e nkmb = CS%nkml+CS%nkbl if (CS%nkbl /= 1) call MOM_error(FATAL,"MOM_mixed_layer: "// & "CS%nkbl must be 1 in mixedlayer_detrain_1.") - Idt = 1.0/dt - dt_Time = dt/Timescale - g_H2_2Rho0dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) - g_H2_2dt = (GV%g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) + + dt_Time = dt_in_T / CS%BL_detrain_time + g_H2_2Rho0dt = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * GV%Rho0 * dt_diag) + g_H2_2dt = (US%L_to_m**2*GV%LZT_g_Earth * GV%H_to_Z**2) / (2.0 * dt_diag) ! Move detrained water into the buffer layer. do k=1,CS%nkml @@ -3257,7 +3255,6 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e dT_dS_wt2 = CS%dT_dS_wt**2 -! dt_Time = dt/Timescale do k=nz-1,nkmb+1,-1 ; do i=is,ie if (splittable_BL(i)) then if (RcvTgt(k)<=Rcv(i,nkmb)) then @@ -3408,6 +3405,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. + real :: BL_detrain_time_dflt ! The default value for BUFFER_LAY_DETRAIN_TIME [s] real :: omega_frac_dflt, ustar_min_dflt, Hmix_min_m integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -3494,13 +3492,29 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "buffer layers, when the detrainment is going into the "//& "lightest interior layer, nondimensional, or a negative "//& "value not to apply this limit.", units="nondim", default = -1.0) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_THICK", CS%Hbuffer_min, & + "The minimum buffer layer thickness when the mixed layer is very thick.", & + units="m", default=5.0, scale=GV%m_to_H) + call get_param(param_file, mdl, "BUFFER_LAYER_HMIN_REL", CS%Hbuffer_rel_min, & + "The minimum buffer layer thickness relative to the combined mixed "//& + "land buffer ayer thicknesses when they are thin.", & + units="nondim", default=0.1/CS%nkbl) + BL_detrain_time_dflt = 4.0*3600.0 ; if (CS%nkbl==1) BL_detrain_time_dflt = 86400.0*30.0 + call get_param(param_file, mdl, "BUFFER_LAY_DETRAIN_TIME", CS%BL_detrain_time, & + "A timescale that characterizes buffer layer detrainment events.", & + units="s", default=BL_detrain_time_dflt, scale=US%s_to_T) + call get_param(param_file, mdl, "BUFFER_SPLIT_RHO_TOL", CS%BL_split_rho_tol, & + "The fractional tolerance for matching layer target densities when splitting "//& + "layers to deal with massive interior layers that are lighter than one of the "//& + "mixed or buffer layers.", units="nondim", default=0.1) + call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean "//& "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*Hmix_min_m, scale=GV%m_to_H) - call get_param(param_file, mdl, "OMEGA",CS%omega, & - "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + call get_param(param_file, mdl, "OMEGA", CS%omega, & + "The rotation rate of the earth.", & + default=7.2921e-5, units="s-1", scale=US%T_to_s) call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& "vertical component of rotation when setting the decay "//& @@ -3524,12 +3538,12 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. - ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) + ustar_min_dflt = 2e-4*US%s_to_T*CS%omega*(GV%Angstrom_m + GV%H_to_m*GV%H_subroundoff) call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the "//& "bulk mixed layer model in setting vertical TKE decay "//& "scales. This must be greater than 0.", units="m s-1", & - default=ustar_min_dflt, scale=US%m_to_Z) + default=ustar_min_dflt, scale=US%m_to_Z*US%T_to_s) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & @@ -3569,28 +3583,28 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) CS%id_ML_depth = register_diag_field('ocean_model', 'h_ML', diag%axesT1, & Time, 'Surface mixed layer depth', 'm') CS%id_TKE_wind = register_diag_field('ocean_model', 'TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_RiBulk = register_diag_field('ocean_model', 'TKE_RiBulk', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv = register_diag_field('ocean_model', 'TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_pen_SW = register_diag_field('ocean_model', 'TKE_pen_SW', diag%axesT1, & Time, 'TKE consumed by mixing penetrative shortwave radation through the mixed layer', & 'm3 s-3', conversion=US%Z_to_m) CS%id_TKE_mixing = register_diag_field('ocean_model', 'TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m) + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_TKE_conv_s2 = register_diag_field('ocean_model', 'TKE_conv_s2', diag%axesT1, & - Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m) + Time, 'Spurious source of mixed layer TKE from sigma2', 'm3 s-3', conversion=US%Z_to_m*US%T_to_s**3) CS%id_PE_detrain = register_diag_field('ocean_model', 'PE_detrain', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer detrainment', & - 'W m-2', conversion=US%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) CS%id_PE_detrain2 = register_diag_field('ocean_model', 'PE_detrain2', diag%axesT1, & Time, 'Spurious source of potential energy from mixed layer only detrainment', & - 'W m-2', conversion=US%Z_to_m) + 'W m-2', conversion=US%Z_to_m*US%T_to_s**3) CS%id_h_mismatch = register_diag_field('ocean_model', 'h_miss_ML', diag%axesT1, & Time, 'Summed absolute mismatch in entrainment terms', 'm', conversion=US%Z_to_m) CS%id_Hsfc_used = register_diag_field('ocean_model', 'Hs_used', diag%axesT1, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 5259d4ed25..20380f22c5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -12,13 +12,18 @@ module MOM_diabatic_aux use MOM_EOS, only : calculate_specific_vol_derivs, calculate_density_derivs use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint -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_forcing_type, only : forcing, extractFluxes1d, forcing_SinglePointPrint use MOM_grid, only : ocean_grid_type -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type, sumSWoverBands +use MOM_io, only : slasher +use MOM_opacity, only : set_opacity, opacity_CS, extract_optics_slice, extract_optics_fields +use MOM_opacity, only : optics_type, optics_nbands, absorbRemainingSW, sumSWoverBands +use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type! , accel_diag_ptrs use MOM_verticalGrid, only : verticalGrid_type +use time_interp_external_mod, only : init_external_field, time_interp_external +use time_interp_external_mod, only : time_interp_external_init implicit none ; private @@ -26,7 +31,7 @@ module MOM_diabatic_aux public diabatic_aux_init, diabatic_aux_end public make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS -public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +public find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut, set_pen_shortwave ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -55,7 +60,13 @@ module MOM_diabatic_aux logical :: use_calving_heat_content !< If true, assumes that ice-ocean boundary !! has provided a calving heat content. Otherwise, calving !! is added with a temperature of the local SST. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes to determine the + !! e-folding depth of incoming shortwave radiation. + integer :: sbc_chl !< An integer handle used in time interpolation of + !! chlorophyll read from a file. + logical :: chl_from_file !< If true, chl_a is read from a file. + type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output ! Diagnostic handles @@ -64,6 +75,7 @@ module MOM_diabatic_aux integer :: id_penSW_diag = -1 !< Diagnostic ID of Penetrative shortwave heating (flux convergence) integer :: id_penSWflux_diag = -1 !< Diagnostic ID of Penetrative shortwave flux integer :: id_nonpenSW_diag = -1 !< Diagnostic ID of Non-penetrative shortwave heating + integer :: id_Chl = -1 !< Diagnostic ID of chlorophyll-A handles for opacity ! Optional diagnostic arrays real, allocatable, dimension(:,:) :: createdH !< The amount of volume added in order to @@ -216,7 +228,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! available thermodynamic fields. type(vertvisc_type), intent(in) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. ! local variables real, dimension(SZI_(G)) :: & @@ -235,7 +247,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) real :: b_denom_T ! The first term in the denominators for the expressions real :: b_denom_S ! for b1_T and b1_S, both [H ~> m or kg m-2]. real, dimension(:,:,:), pointer :: T=>NULL(), S=>NULL() - real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 s-1 ~> m2 s-1]. + real, dimension(:,:,:), pointer :: Kd_T=>NULL(), Kd_S=>NULL() ! Diffusivities [Z2 T-1 ~> m2 s-1]. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -381,8 +393,8 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) integer, intent(in) :: nkmb !< The number of layers in the mixed and buffer layers type(diabatic_aux_CS), intent(in) :: CS !< The control structure returned by a previous !! call to diabatic_aux_init - real, intent(in) :: dt !< The thermodyanmic time step [s]. - integer, intent(in) :: id_brine_lay !< The handle for a diagnostic + real, intent(in) :: dt !< The thermodynamic time step [s]. + integer, intent(in) :: id_brine_lay !< The handle for a diagnostic of !! which layer receivees the brine. ! local variables @@ -572,7 +584,7 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) real :: s, Idenom logical :: mix_vertically integer :: i, j, k, is, ie, js, je, nz - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke call cpu_clock_begin(id_clock_uv_at_h) h_neglect = GV%H_subroundoff @@ -638,6 +650,63 @@ subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) end subroutine find_uv_at_h +subroutine set_pen_shortwave(optics, fluxes, G, GV, CS, opacity_CSp, tracer_flow_CSp) + type(optics_type), pointer :: optics !< An optics structure that has will contain + !! information about shortwave fluxes and absorption. + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux + type(opacity_CS), pointer :: opacity_CSp !< The control structure for the opacity module. + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< A pointer to the control structure of the tracer modules. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] + character(len=128) :: mesg + integer :: i, j, k, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + if (.not.associated(optics)) return + + if (CS%var_pen_sw) then + if (CS%chl_from_file) then + ! Only the 2-d surface chlorophyll can be read in from a file. The + ! same value is assumed for all layers. + call time_interp_external(CS%sbc_chl, CS%Time, chl_2d) + do j=js,je ; do i=is,ie + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_2d(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_diabatic_aux set_pen_shortwave: "//trim(mesg)) + endif + enddo ; enddo + + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_2d, CS%diag) + + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_2d=chl_2d) + else + if (.not.associated(tracer_flow_CSp)) call MOM_error(FATAL, & + "The tracer flow control structure must be associated when the model sets "//& + "the chlorophyll internally in set_pen_shortwave.") + call get_chl_from_model(chl_3d, G, tracer_flow_CSp) + + if (CS%id_chl > 0) call post_data(CS%id_chl, chl_3d(:,:,1), CS%diag) + + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp, chl_3d=chl_3d) + endif + else + call set_opacity(optics, fluxes%sw, fluxes%sw_vis_dir, fluxes%sw_vis_dif, & + fluxes%sw_nir_dir, fluxes%sw_nir_dif, G, GV, opacity_CSp) + endif + +end subroutine set_pen_shortwave + + !> Diagnose a mixed layer depth (MLD) determined by a given density difference with the surface. !> This routine is appropriate in MOM_diabatic_driver due to its position within the time stepping. subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, diagPtr, & @@ -667,20 +736,20 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, real, dimension(SZI_(G)) :: dK, dKm1 ! Depths [Z ~> m]. real, dimension(SZI_(G)) :: rhoSurf ! Density used in finding the mixedlayer depth [kg m-3]. real, dimension(SZI_(G), SZJ_(G)) :: MLD ! Diagnosed mixed layer depth [Z ~> m]. - real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [s-2]. + real, dimension(SZI_(G), SZJ_(G)) :: subMLN2 ! Diagnosed stratification below ML [T-2 ~> s-2]. real, dimension(SZI_(G), SZJ_(G)) :: MLD2 ! Diagnosed MLD^2 [Z2 ~> m2]. logical, dimension(SZI_(G)) :: N2_region_set ! If true, all necessary values for calculating N2 ! have been stored already. - real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [m4 s-2 kg-1]. + real :: gE_Rho0 ! The gravitational acceleration divided by a mean density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. real :: dH_subML ! Depth below ML over which to diagnose stratification [H ~> m]. integer :: i, j, is, ie, js, je, k, nz, id_N2, id_SQ real :: aFac, ddRho id_N2 = -1 ; if (PRESENT(id_N2subML)) id_N2 = id_N2subML - id_SQ = -1 ; if (PRESENT(id_N2subML)) id_SQ = id_MLDsq + id_SQ = -1 ; if (PRESENT(id_MLDsq)) id_SQ = id_MLDsq - gE_rho0 = US%m_to_Z**2 * GV%g_Earth / GV%Rho0 + gE_rho0 = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 dH_subML = 50.*GV%m_to_H ; if (present(dz_subML)) dH_subML = GV%Z_to_H*dz_subML is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -761,7 +830,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, enddo ! j-loop if (id_MLD > 0) call post_data(id_MLD, MLD, diagPtr) - if (id_N2 > 0) call post_data(id_N2, subMLN2 , diagPtr) + if (id_N2 > 0) call post_data(id_N2, subMLN2, diagPtr) if (id_SQ > 0) call post_data(id_SQ, MLD2, diagPtr) end subroutine diagnoseMLDbyDensityDifference @@ -769,7 +838,7 @@ end subroutine diagnoseMLDbyDensityDifference !> Update the thickness, temperature, and salinity due to thermodynamic !! boundary forcing (contained in fluxes type) applied to h, tv%T and tv%S, !! and calculate the TKE implications of this heating. -subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & +subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, tv, & aggregate_FW_forcing, evap_CFL_limit, & minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, & SkinBuoyFlux ) @@ -780,6 +849,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & real, intent(in) :: dt !< Time-step over which forcing is applied [s] type(forcing), intent(inout) :: fluxes !< Surface fluxes container type(optics_type), pointer :: optics !< Optical properties container + integer, intent(in) :: nsw !< The number of frequency bands of penetrating + !! shortwave radiation real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Structure containing pointers to any @@ -791,7 +862,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & !! heat and freshwater fluxes is applied [m]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: cTKE !< Turbulent kinetic energy requirement to mix - !! forcing through each layer [W m-2] + !! forcing through each layer [kg m-3 Z3 T-2 ~> J m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(out) :: dSV_dT !< Partial derivative of specific volume with !! potential temperature [m3 kg-1 degC-1]. @@ -799,7 +870,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & optional, intent(out) :: dSV_dS !< Partial derivative of specific volume with !! salinity [m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & - optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 s-3 ~> m2 s-3]. + optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. ! Local variables integer, parameter :: maxGroundings = 5 @@ -828,21 +899,31 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) ! [ppt H s-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate! netmassinout but for dt=1 [H s-1 ~> m s-1 or kg m-2 s-1] - real, dimension(SZI_(G), SZK_(G)) :: h2d, T2d - real, dimension(SZI_(G), SZK_(G)) :: pen_TKE_2d, dSV_dT_2d - real, dimension(SZI_(G),SZK_(G)+1) :: netPen - real, dimension(max(optics%nbands,1),SZI_(G)) :: Pen_SW_bnd, Pen_SW_bnd_rate - !^ _rate is w/ dt=1 - real, dimension(max(optics%nbands,1),SZI_(G),SZK_(G)) :: opacityBand - real :: hGrounding(maxGroundings) + real, dimension(SZI_(G), SZK_(G)) :: & + h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] + T2d, & ! A 2-d copy of the layer temperatures [degC] + pen_TKE_2d, & ! The TKE required to homogenize the heating by shortwave radiation within + ! a layer [kg m-3 Z3 T-2 ~> J m-2] + dSV_dT_2d ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + real, dimension(SZI_(G),SZK_(G)+1) :: netPen + real, dimension(max(nsw,1),SZI_(G)) :: & + Pen_SW_bnd, & ! The penetrative shortwave heating integrated over a timestep by band + ! [degC H ~> degC m or degC kg m-2] + Pen_SW_bnd_rate ! The penetrative shortwave heating rate by band + ! [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1] + real, dimension(max(nsw,1),SZI_(G),SZK_(G)) :: & + opacityBand ! The opacity (inverse of the exponential absorption length) of each frequency + ! band of shortwave radation in each layer [H-1 ~> m-1 or m2 kg-1] + real, dimension(maxGroundings) :: hGrounding real :: Temp_in, Salin_in ! real :: I_G_Earth + real :: dt_in_T ! The time step converted to T units [T ~> s] real :: g_Hconv2 real :: GoRho ! g_Earth times a unit conversion factor divided by density - ! [Z m3 s-2 kg-1 ~> m4 s-2 kg-1] + ! [Z3 m T-2 kg-1 ~> m4 s-2 kg-1] logical :: calculate_energetics logical :: calculate_buoyancy - integer :: i, j, is, ie, js, je, k, nz, n, nsw + integer :: i, j, is, ie, js, je, k, nz, n integer :: start, npts character(len=45) :: mesg @@ -852,19 +933,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (.not.associated(fluxes%sw)) return #define _OLD_ALG_ - nsw = optics%nbands + dt_in_T = dt * US%s_to_T Idt = 1.0/dt calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) if (calculate_buoyancy) SkinBuoyFlux(:,:) = 0.0 ! I_G_Earth = 1.0 / GV%g_Earth - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 + g_Hconv2 = (US%m_to_Z**3 * US%T_to_s**2) * GV%H_to_Pa * GV%H_to_kg_m2 if (present(cTKE)) cTKE(:,:,:) = 0.0 if (calculate_buoyancy) then SurfPressure(:) = 0.0 - GoRho = GV%g_Earth / GV%Rho0 + GoRho = US%L_to_Z**2*GV%LZT_g_Earth / GV%Rho0 start = 1 + G%isc - G%isd npts = 1 + G%iec - G%isc endif @@ -902,10 +983,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & do k=1,nz ; do i=is,ie h2d(i,k) = h(i,j,k) T2d(i,k) = tv%T(i,j,k) - do n=1,nsw - opacityBand(n,i,k) = (1.0 / GV%m_to_H)*optics%opacity_band(n,i,j,k) - enddo enddo ; enddo + if (nsw>0) call extract_optics_slice(optics, j, G, GV, opacity=opacityBand, opacity_scale=(1.0/GV%m_to_H)) if (calculate_energetics) then ! The partial derivatives of specific volume with temperature and @@ -977,8 +1056,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & h2d, T2d, netMassInOut, netMassOut, netHeat, netSalt, & Pen_SW_bnd, tv, aggregate_FW_forcing, nonpenSW=nonpenSW, & - net_Heat_rate=netheat_rate,net_salt_rate=netsalt_rate, & - netmassinout_rate=netmassinout_rate,pen_sw_bnd_rate=pen_sw_bnd_rate) + net_Heat_rate=netheat_rate, net_salt_rate=netsalt_rate, & + netmassinout_rate=netmassinout_rate, pen_sw_bnd_rate=pen_sw_bnd_rate) else call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & H_limit_fluxes, CS%use_river_heat_content, CS%use_calving_heat_content, & @@ -1049,7 +1128,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! rivermix_depth = The prescribed depth over which to mix river inflow ! drho_ds = The gradient of density wrt salt at the ambient surface salinity. ! Sriver = 0 (i.e. rivers are assumed to be pure freshwater) - RivermixConst = -0.5*(CS%rivermix_depth*dt)*GV%Z_to_H*GV%H_to_Pa + RivermixConst = -0.5*(CS%rivermix_depth*dt)*(US%m_to_Z**3 * US%T_to_s**2) * GV%Z_to_H*GV%H_to_Pa cTKE(i,j,k) = cTKE(i,j,k) + max(0.0, RivermixConst*dSV_dS(i,j,1) * & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j)) * tv%S(i,j,1)) @@ -1061,7 +1140,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (h2d(i,k) > 0.0) then if (calculate_energetics .and. (dThickness > 0.)) then ! Calculate the energy required to mix the newly added water over - ! the topmost grid cell. ###CHECK THE SIGNS!!! + ! the topmost grid cell. cTKE(i,j,k) = cTKE(i,j,k) + 0.5*g_Hconv2*(hOld*dThickness) * & ((T2d(i,k) - Temp_in) * dSV_dT(i,j,k) + (tv%S(i,j,k) - Salin_in) * dSV_dS(i,j,k)) endif @@ -1123,14 +1202,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & if (h2d(i,k) > 0.) then if (calculate_energetics) then - ! Calculate the energy required to mix the newly added water over - ! the topmost grid cell, assuming that the fluxes of heat and salt - ! and rejected brine are initially applied in vanishingly thin - ! layers at the top of the layer before being mixed throughout - ! the layer. Note that dThickness is always <= 0. ###CHECK THE SIGNS!!! + ! Calculate the energy required to mix the newly added water over the topmost grid + ! cell, assuming that the fluxes of heat and salt and rejected brine are initially + ! applied in vanishingly thin layers at the top of the layer before being mixed + ! throughout the layer. Note that dThickness is always <= 0 here, and that + ! negative cTKE is a deficit that will need to be filled later. cTKE(i,j,k) = cTKE(i,j,k) - (0.5*h2d(i,k)*g_Hconv2) * & - ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & - (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) + ((dTemp - dthickness*T2d(i,k)) * dSV_dT(i,j,k) + & + (dSalt - dthickness*tv%S(i,j,k)) * dSV_dS(i,j,k)) endif Ithickness = 1.0/h2d(i,k) ! Inverse of new thickness T2d(i,k) = (hOld*T2d(i,k) + dTemp)*Ithickness @@ -1189,19 +1268,19 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & CS%penSWflux_diag(i,j,k) = 0.0 enddo ; enddo k=nz+1 ; do i=is,ie - CS%penSWflux_diag(i,j,k) = 0.0 + CS%penSWflux_diag(i,j,k) = 0.0 enddo endif if (calculate_energetics) then - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd, TKE=pen_TKE_2d, dSV_dT=dSV_dT_2d) k = 1 ! For setting break-points. do k=1,nz ; do i=is,ie cTKE(i,j,k) = cTKE(i,j,k) + pen_TKE_2d(i,k) enddo ; enddo else - call absorbRemainingSW(G, GV, h2d, opacityBand, nsw, j, dt, H_limit_fluxes, & + call absorbRemainingSW(G, GV, US, h2d, opacityBand, nsw, optics, j, dt_in_T, H_limit_fluxes, & .false., .true., T2d, Pen_SW_bnd) endif @@ -1254,8 +1333,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & netPen(:,:) = 0.0 ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth - call sumSWoverBands(G, GV, h2d(:,:), optics%opacity_band(:,:,j,:), nsw, j, dt, & - H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) + call sumSWoverBands(G, GV, US, h2d(:,:), optics, j, dt_in_T, & + H_limit_fluxes, .true., pen_SW_bnd_rate, netPen) ! Density derivatives call calculate_density_derivs(T2d(:,1), tv%S(:,j,1), SurfPressure, & dRhodT, dRhodS, start, npts, tv%eqn_of_state) @@ -1265,9 +1344,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, h, tv, & ! 3. Convert to a buoyancy flux, excluding penetrating SW heating ! BGR-Jul 5, 2017: The contribution of SW heating here needs investigated for ePBL. do i=is,ie - SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%m_to_Z**2 * ( & - dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & - dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 + SkinBuoyFlux(i,j) = - GoRho * GV%H_to_Z * US%T_to_s * & + (dRhodS(i) * (netSalt_rate(i) - tv%S(i,j,1)*netMassInOut_rate(i)) + & + dRhodT(i) * ( netHeat_rate(i) + netPen(i,1)) ) ! m^2/s^3 enddo endif @@ -1300,7 +1379,7 @@ end subroutine applyBoundaryFluxesInOut !> This subroutine initializes the parameters and control structure of the diabatic_aux module. subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgorithm, use_ePBL) - type(time_type), intent(in) :: Time !< The current model time + type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1318,6 +1397,12 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori #include "version_variable.h" character(len=40) :: mdl = "MOM_diabatic_aux" ! This module's name. character(len=48) :: thickness_units + character(len=200) :: inputdir ! The directory where NetCDF input files + character(len=240) :: chl_filename ! A file from which chl_a concentrations are to be read. + character(len=128) :: chl_file ! Data containing chl_a concentrations. Used + ! when var_pen_sw is defined and reading from file. + character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. + logical :: use_temperature ! True if thermodynamics are enabled. integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -1331,11 +1416,16 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif CS%diag => diag + CS%Time => Time ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for auxiliary diabatic processes.") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & + "If true, temperature and salinity are used as state "//& + "variables.", default=.true.) + call get_param(param_file, mdl, "RECLAIM_FRAZIL", CS%reclaim_frazil, & "If true, try to use any frazil heat deficit to cool any "//& "overlying layers down to the freezing point, thereby "//& @@ -1417,6 +1507,35 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori endif endif + if (use_temperature) then + call get_param(param_file, mdl, "VAR_PEN_SW", CS%var_pen_sw, & + "If true, use one of the CHL_A schemes specified by "//& + "OPACITY_SCHEME to determine the e-folding depth of "//& + "incoming short wave radiation.", default=.false.) + if (CS%var_pen_sw) then + + call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & + "If true, chl_a is read from a file.", default=.true.) + if (CS%chl_from_file) then + call time_interp_external_init() + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "CHL_FILE", chl_file, & + "CHL_FILE is the file containing chl_a concentrations in "//& + "the variable CHL_A. It is used when VAR_PEN_SW and "//& + "CHL_FROM_FILE are true.", fail_if_missing=.true.) + chl_filename = trim(slasher(inputdir))//trim(chl_file) + call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", chl_filename) + call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & + "Name of CHL_A variable in CHL_FILE.", default='CHL_A') + CS%sbc_chl = init_external_field(chl_filename, trim(chl_varname), domain=G%Domain%mpp_domain) + endif + + CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & + 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') + endif + endif + id_clock_uv_at_h = cpu_clock_id('(Ocean find_uv_at_h)', grain=CLOCK_ROUTINE) id_clock_frazil = cpu_clock_id('(Ocean frazil)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 25d4eadb7d..526dc4dfe3 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -14,6 +14,7 @@ module MOM_diabatic_driver use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, insert_brine, differential_diffuse_T_S, triDiagTS use MOM_diabatic_aux, only : find_uv_at_h, diagnoseMLDbyDensityDifference, applyBoundaryFluxesInOut +use MOM_diabatic_aux, only : set_pen_shortwave use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled, enable_averaging, disable_averaging @@ -51,12 +52,12 @@ module MOM_diabatic_driver use MOM_CVMix_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln -use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS +use MOM_opacity, only : opacity_init, opacity_end, opacity_CS +use MOM_opacity, only : absorbRemainingSW, optics_type, optics_nbands use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS use MOM_set_diffusivity, only : set_diffusivity, set_BBL_TKE use MOM_set_diffusivity, only : set_diffusivity_init, set_diffusivity_end use MOM_set_diffusivity, only : set_diffusivity_CS -use MOM_shortwave_abs, only : absorbRemainingSW, optics_type use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) @@ -67,7 +68,6 @@ module MOM_diabatic_driver use MOM_variables, only : cont_diag_ptrs, MOM_thermovar_chksum, p3d use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speeds -use time_manager_mod, only : increment_time ! for testing itides (BDM) use MOM_wave_interface, only : wave_parameters_CS @@ -81,7 +81,7 @@ module MOM_diabatic_driver public extract_diabatic_member public adiabatic public adiabatic_driver_init -public legacy_diabatic +! public legacy_diabatic ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with @@ -90,6 +90,10 @@ module MOM_diabatic_driver !> Control structure for this module type, public:: diabatic_CS; private + + logical :: use_legacy_diabatic !< If true (default), use the a legacy version of the diabatic + !! algorithm. This is temporary and is needed to avoid change + !! in answers. logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with !! nkml sublayers (and additional buffer layers). logical :: use_energetic_PBL !< If true, use the implicit energetics planetary @@ -116,20 +120,8 @@ module MOM_diabatic_driver !! other diffusivities. Otherwise, the larger of kappa- !! shear and ePBL diffusivities are used. integer :: nMode = 1 !< Number of baroclinic modes to consider - logical :: int_tide_source_test !< If true, apply an arbitrary generation site - !! for internal tide testing (BDM) - real :: int_tide_source_x !< X Location of generation site - !! for internal tide for testing (BDM) - real :: int_tide_source_y !< Y Location of generation site - !! for internal tide for testing (BDM) - integer :: tlen_days !< Time interval from start for adding wave source - !! for testing internal tides (BDM) - logical :: uniform_cg !< If true, set cg = cg_test everywhere - !! for testing internal tides (BDM) - real :: cg_test !< Uniform group velocity of internal tide - !! for testing internal tides (BDM) - type(time_type) :: time_max_source !< For use in testing internal tides (BDM) - type(time_type) :: time_end !< For use in testing internal tides (BDM) + real :: uniform_test_cg !< Uniform group velocity of internal tide + !! for testing internal tides [m s-1] (BDM) logical :: useALEalgorithm !< If true, use the ALE algorithm rather than layered !! isopycnal/stacked shallow water mode. This logical !! passed by argument to diabatic_driver_init. @@ -151,11 +143,11 @@ module MOM_diabatic_driver !! operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! [Z2 s-1 ~> m2 s-1]. The entrainment at the bottom is at + !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at !! least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom [Z2 s-1 ~> m2 s-1]. + !! near the bottom [Z2 T-1 ~> m2 s-1]. real :: minimum_forcing_depth = 0.001 !< The smallest depth over which heat and freshwater !! fluxes are applied [m]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -174,7 +166,6 @@ module MOM_diabatic_driver real :: MLDdensityDifference !< Density difference used to determine MLD_user real :: dz_subML_N2 !< The distance over which to calculate a diagnostic of the !! average stratification at the base of the mixed layer [Z ~> m]. - integer :: nsw !< SW_NBANDS !>@{ Diagnostic IDs integer :: id_cg1 = -1 ! diag handle for mode-1 speed (BDM) @@ -191,80 +182,1055 @@ module MOM_diabatic_driver integer :: id_u_predia = -1, id_v_predia = -1, id_h_predia = -1 integer :: id_T_predia = -1, id_S_predia = -1, id_e_predia = -1 - integer :: id_diabatic_diff_temp_tend = -1 - integer :: id_diabatic_diff_saln_tend = -1 - integer :: id_diabatic_diff_heat_tend = -1 - integer :: id_diabatic_diff_salt_tend = -1 - integer :: id_diabatic_diff_heat_tend_2d = -1 - integer :: id_diabatic_diff_salt_tend_2d = -1 - integer :: id_diabatic_diff_h= -1 + integer :: id_diabatic_diff_temp_tend = -1 + integer :: id_diabatic_diff_saln_tend = -1 + integer :: id_diabatic_diff_heat_tend = -1 + integer :: id_diabatic_diff_salt_tend = -1 + integer :: id_diabatic_diff_heat_tend_2d = -1 + integer :: id_diabatic_diff_salt_tend_2d = -1 + integer :: id_diabatic_diff_h= -1 + + integer :: id_boundary_forcing_h = -1 + integer :: id_boundary_forcing_h_tendency = -1 + integer :: id_boundary_forcing_temp_tend = -1 + integer :: id_boundary_forcing_saln_tend = -1 + integer :: id_boundary_forcing_heat_tend = -1 + integer :: id_boundary_forcing_salt_tend = -1 + integer :: id_boundary_forcing_heat_tend_2d = -1 + integer :: id_boundary_forcing_salt_tend_2d = -1 + + integer :: id_frazil_h = -1 + integer :: id_frazil_temp_tend = -1 + integer :: id_frazil_heat_tend = -1 + integer :: id_frazil_heat_tend_2d = -1 + !!@} + + logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics + logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics + logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics + real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil + real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil + + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module + type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module + type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module + type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module + type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module + type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module + type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module + type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module + type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module + type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module + type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module + type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module + type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module + type(optics_type), pointer :: optics => NULL() !< Control structure for a child module + type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module + type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module + type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() !< Control structure for a child module + type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module + + type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass + type(group_pass_type) :: pass_Kv !< For group halo pass + type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm + ! Data arrays for communicating between components + real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] + real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] + real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [m2 s-3] + real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] + real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + + type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) +end type diabatic_CS + +! clock ids +integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity +integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge +integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap +integer :: id_clock_kpp + +contains + +!> This subroutine imposes the diapycnal mass fluxes and the +!! accompanying diapycnal advection of momentum and tracers. +subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: & + eta ! Interface heights before diapycnal mixing [m]. + real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & + cn_IGW ! baroclinic internal gravity wave speeds + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) + real :: dt_in_T ! The time step converted to T units [T ~> s] + integer :: i, j, k, m, is, ie, js, je, nz + logical :: showCallTree ! If true, show the call tree + + if (G%ke == 1) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "Module must be initialized before it is used.") + if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a zero length timestep.") + if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & + "diabatic was called with a negative timestep.") + + showCallTree = callTree_showQuery() + + ! Offer diagnostics of various state varables at the start of diabatic + ! these are mostly for debugging purposes. + if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) + if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) + if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) + if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) + if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) + if (CS%id_e_predia > 0) then + call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) + call post_data(CS%id_e_predia, eta, CS%diag) + endif + + dt_in_T = dt * US%s_to_T + if (CS%debug) then + call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) + endif + if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) + + if (CS%debug_energy_req) & + call diapyc_energy_req_test(h, dt_in_T, tv, G, GV, US, CS%diapyc_en_rec_CSp) + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) + call cpu_clock_end(id_clock_set_diffusivity) + + ! Frazil formation keeps the temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + ! For frazil diagnostic, the first call covers the first half of the time step + call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) + endif + if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) + endif + call disable_averaging(CS%diag) + endif ! associated(tv%T) .AND. associated(tv%frazil) + if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) + + + if (CS%use_int_tides) then + ! This block provides an interface for the unresolved low-mode internal tide module (BDM). + call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & + CS%int_tide_input_CSp) + cn_IGW(:,:,:) = 0.0 + if (CS%uniform_test_cg > 0.0) then + do m=1,CS%nMode ; cn_IGW(:,:,m) = CS%uniform_test_cg ; enddo + else + call wave_speeds(h, tv, G, GV, US, CS%nMode, cn_IGW, full_halos=.true.) + endif + + call propagate_int_tide(h, tv, cn_IGW, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & + CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) + if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") + endif ! end CS%use_int_tides + + + if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then + call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + elseif (CS%useALEalgorithm) then + call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + else + call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) + endif + + + + call cpu_clock_begin(id_clock_pass) + if (associated(visc%Kv_shear)) & + call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass) + + call disable_averaging(CS%diag) + ! Frazil formation keeps temperature above the freezing point. + ! make_frazil is deliberately called at both the beginning and at + ! the end of the diabatic processes. + if (associated(tv%T) .AND. associated(tv%frazil)) then + call enable_averaging(0.5*dt, Time_end, CS%diag) + if (CS%frazil_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + + if (associated(fluxes%p_surf_full)) then + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) + else + call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) + endif + + if (CS%frazil_tendency_diag) then + call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) + if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) + endif + + if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) + call disable_averaging(CS%diag) + + endif ! endif for frazil + + + ! Diagnose mixed layer depths. + call enable_averaging(dt, Time_end, CS%diag) + if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) + endif + if (CS%use_int_tides) then + if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn_IGW(:,:,1),CS%diag) + do m=1,CS%nMode ; if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m), cn_IGW(:,:,m), CS%diag) ; enddo + endif + call disable_averaging(CS%diag) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + +end subroutine diabatic + + + +!> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use +!! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. +subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) + type(ocean_grid_type), intent(inout) :: 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),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity [m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity [m s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] + type(forcing), intent(inout) :: fluxes !< points to forcing fields + !! unused fields have NULL ptrs + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and + type(accel_diag_ptrs), intent(inout) :: ADp !< related points to accelerations in momentum + !! equations, to enable the later derived + !! diagnostics, like energy budgets + type(cont_diag_ptrs), intent(inout) :: CDp !< points to terms in continuity equations + real, intent(in) :: dt !< time increment [s] + type(time_type), intent(in) :: Time_end !< Time at the end of the interval + type(diabatic_CS), pointer :: CS !< module control structure + type(Wave_parameters_CS), optional, pointer :: Waves !< Surface gravity waves + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea_s, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb_s, & ! amount of fluid entrained from the layer below within + ! one time step [H ~> m or kg m-2] + ea_t, & ! amount of fluid entrained from the layer above within + ! one time step [H ~> m or kg m-2] + eb_t, & ! amount of fluid entrained from the layer below within + ! one time step [H ~> m or kg m-2] + Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] + h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! [H ~> m or kg m-2] + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment [m s-1] + real, dimension(SZI_(G),SZJ_(G)) :: & + Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL + real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness + real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp + real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity + real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn + + real :: net_ent ! The net of ea-eb at an interface. + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and + ebtr ! eb in that they tend to homogenize tracers in massless layers + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] + Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] + Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] + + logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, + ! where massive is defined as sufficiently thick that + ! the no-flux boundary conditions have not restricted + ! the entrainment - usually sqrt(Kd*dt). + + real :: b_denom_1 ! The first term in the denominator of b1 + ! [H ~> m or kg m-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 :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + real :: add_ent ! Entrainment that needs to be added when mixing tracers + ! [H ~> m or kg m-2] + real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2] + real :: hval ! hval is 2*h at velocity grid points [H ~> m or kg m-2] + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness [H ~> m or kg m-2] + real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is + ! coupled to the bottom within a timestep [H ~> m or kg m-2] + + real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. + real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the + real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. + + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] + + integer :: dir_flag ! An integer encoding the directions in which to do halo updates. + logical :: showCallTree ! If true, show the call tree + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo + + integer :: ig, jg ! global indices for testing testing itide point source (BDM) + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + nkmb = GV%nk_rho_varies + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + + showCallTree = callTree_showQuery() + if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") +! if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") + + dt_in_T = dt * US%s_to_T + + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep + call enable_averaging(dt, Time_end, CS%diag) + + if (CS%use_geothermal) then + halo = CS%halo_TS_diff + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 + enddo ; enddo ; enddo + endif + + if (CS%use_geothermal) then + call cpu_clock_begin(id_clock_geothermal) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call cpu_clock_end(id_clock_geothermal) + if (showCallTree) call callTree_waypoint("geothermal (diabatic)") + if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) + endif + + ! Whenever thickness changes let the diag manager know, target grids + ! for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! Set_pen_shortwave estimates the optical properties of the water column. + ! It will need to be modified later to include information about the + ! biological properties and layer thicknesses. + if (associated(CS%optics)) & + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) + + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + + if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) + if (CS%debug) then + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) + endif + else + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + endif + if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") + endif + + call cpu_clock_begin(id_clock_set_diffusivity) + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & + CS%set_diff_CSp, Kd_lay, Kd_int) + call cpu_clock_end(id_clock_set_diffusivity) + if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + + ! Set diffusivities for heat and salt separately + + if (.not.CS%use_legacy_diabatic .or. CS%useKPP) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_salt(i,j,k) + visc%Kd_extra_S(i,j,k) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,k) = Kd_heat(i,j,k) + visc%Kd_extra_T(i,j,k) + enddo ; enddo ; enddo + endif + endif + + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! total vertical viscosity in the interior is represented via visc%Kv_shear + if (.not.CS%use_legacy_diabatic) then + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + visc%Kv_slow(i,j,k) + enddo ; enddo ; enddo + endif + + ! KPP needs the surface buoyancy flux but does not update state variables. + ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. + ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux + ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! unlike other instances where the fluxes are integrated in time over a time-step. + call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + + if (associated(Hml)) then + !$OMP parallel default(shared) + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + !$OMP end parallel + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy KPP's BLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + endif + + if (CS%use_legacy_diabatic .and. .not.CS%KPPisPassive) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + enddo ; enddo ; enddo + if (associated(visc%Kd_extra_S)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + if (associated(visc%Kd_extra_T)) then + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) + enddo ; enddo ; enddo + endif + endif ! not passive + + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after KPP", tv, G) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + endif ! endif for KPP + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + if (CS%debug) then + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + endif + ! Apply non-local transport of heat and salt + ! Changes: tv%T, tv%S + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, dt, tv%T, tv%C_p) + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, dt, tv%S) + call cpu_clock_end(id_clock_kpp) + if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") + if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after KPP_applyNLT ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) + endif + endif ! endif for KPP + + ! This is the "old" method for applying differential diffusion. + ! Changes: tv%T, tv%S + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (CS%use_legacy_diabatic .or. .not.CS%use_CVMix_ddiff)) then + + call cpu_clock_begin(id_clock_differential_diff) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) + call cpu_clock_end(id_clock_differential_diff) + + if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") + if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) + + ! increment heat and salt diffusivity. + ! CS%useKPP==.true. already has extra_T and extra_S included + if (.not. CS%useKPP) then + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) + enddo ; enddo ; enddo + endif + + endif + + ! Calculate vertical mixing due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) + ! Increment vertical diffusion and viscosity due to convection + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + enddo ; enddo ; enddo + else + !$OMP parallel do default(shared) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + if (CS%useKPP) then + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + else + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) + endif + enddo ; enddo ; enddo + endif + endif + + ! This block sets ea, eb from h and Kd_int. + if (CS%use_legacy_diabatic) then + do j=js,je ; do i=is,ie + ea_s(i,j,1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_int(i,j,K) + eb_s(i,j,k-1) = ea_s(i,j,k) + ea_t(i,j,k-1) = ea_s(i,j,k-1) ; eb_t(i,j,k-1) = eb_s(i,j,k-1) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_s(i,j,nz) = 0.0 + ea_t(i,j,nz) = ea_s(i,j,nz) ; eb_t(i,j,nz) = eb_s(i,j,nz) + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") + endif + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after calc_entrain ", tv, G) + call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, haloshift=0) + call hchksum(ea_s, "after calc_entrain ea_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after calc_entrain eb_s", G%HI, haloshift=0, scale=GV%H_to_m) + endif + + ! Save fields before boundary forcing is applied for tendency diagnostics + if (CS%boundary_forcing_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + h_diag(i,j,k) = h(i,j,k) + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + ! Apply forcing + call cpu_clock_begin(id_clock_remap) + + ! Changes made to following fields: h, tv%T and tv%S. + do k=1,nz ; do j=js,je ; do i=is,ie + h_prebound(i,j,k) = h(i,j,k) + enddo ; enddo ; enddo + if (CS%use_energetic_PBL) then + + skinbuoyflux(:,:) = 0.0 + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + + if (CS%debug) then + call hchksum(ea_t, "after applyBoundaryFluxes ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after applyBoundaryFluxes eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after applyBoundaryFluxes ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after applyBoundaryFluxes eb_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) + call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) + call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) + endif + + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & + CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) + + if (associated(Hml)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, Hml(:,:), G, US) + call pass_var(Hml, G%domain, halo=1) + ! If visc%MLD exists, copy ePBL's MLD into it + if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) + elseif (associated(visc%MLD)) then + call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) + call pass_var(visc%MLD, G%domain, halo=1) + endif + + ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. + do K=2,nz ; do j=js,je ; do i=is,ie + !### These expressions assume a Prandtl number of 1. + if (CS%ePBL_is_additive) then + Kd_add_here = Kd_ePBL(i,j,K) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) + else + Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) + visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) + endif + + if (CS%use_legacy_diabatic) then + Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt_in_T) / & + (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + eb_s(i,j,k-1) = eb_s(i,j,k-1) + Ent_int + ea_s(i,j,k) = ea_s(i,j,k) + Ent_int + Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here + + ! for diagnostics + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_int(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_int(i,j,K) + else + Kd_heat(i,j,K) = Kd_heat(i,j,K) + Kd_add_here + Kd_salt(i,j,K) = Kd_salt(i,j,K) + Kd_add_here + endif + + enddo ; enddo ; enddo + + if (CS%debug) then + call hchksum(ea_t, "after ePBL ea_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & + CS%evap_CFL_limit, CS%minimum_forcing_depth) + + endif ! endif for CS%use_energetic_PBL + + ! diagnose the tendencies due to boundary forcing + ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme + ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards + if (CS%boundary_forcing_tendency_diag) then + call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) + if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) + endif + ! Boundary fluxes may have changed T, S, and h + call diag_update_remap_grids(CS%diag) + call cpu_clock_end(id_clock_remap) + if (CS%debug) then + call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) + call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") + if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) + + ! Update h according to divergence of the difference between + ! ea and eb. We keep a record of the original h in hold. + ! In the following, the checks for negative values are to guard against + ! instances where entrainment drives a layer to negative thickness. + !### This code may be unnecessary, but the negative-thickness checks do appear to change + ! answers slightly in some cases. + if (CS%use_legacy_diabatic) then + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + ! Does nothing with ALE: h(i,j,1) = h(i,j,1) + (eb_s(i,j,1) - ea_s(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + ! Does nothing with ALE: h(i,j,nz) = h(i,j,nz) + (ea_s(i,j,nz) - eb_s(i,j,nz-1)) + if (h(i,j,1) <= 0.0) h(i,j,1) = GV%Angstrom_H + if (h(i,j,nz) <= 0.0) h(i,j,nz) = GV%Angstrom_H + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + ! Does nothing with ALE: h(i,j,k) = h(i,j,k) + ((ea_s(i,j,k) - eb_s(i,j,k-1)) + & + ! (eb_s(i,j,k) - ea_s(i,j,k+1))) + if (h(i,j,k) <= 0.0) h(i,j,k) = GV%Angstrom_H + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + endif + + if (CS%debug) then + call MOM_state_chksum("after negative check ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after negative check ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after negative check ", tv, G) + endif + if (showCallTree) call callTree_waypoint("done with h=ea-eb (diabatic)") + if (CS%debugConservation) call MOM_state_stats('h=ea-eb', u, v, h, tv%T, tv%S, G) + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea_t, "before triDiagTS ea_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_t, "before triDiagTS eb_t ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(ea_s, "before triDiagTS ea_s ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb_s, "before triDiagTS eb_s ",G%HI,haloshift=0, scale=GV%H_to_m) + endif + + call cpu_clock_begin(id_clock_tridiag) + ! Keep salinity from falling below a small but positive threshold. + ! This constraint is needed for SIS1 ice model, which can extract + ! more salt than is present in the ocean. SIS2 does not suffer + ! from this limitation, in which case we can let salinity=0 and still + ! have salt conserved with SIS2 ice. So for SIS2, we can run with + ! BOUND_SALINITY=False in MOM.F90. + if (associated(tv%S) .and. associated(tv%salt_deficit)) & + call adjust_salt(h, tv, G, GV, CS%diabatic_aux_CSp) + + if (CS%diabatic_diff_tendency_diag) then + do k=1,nz ; do j=js,je ; do i=is,ie + temp_diag(i,j,k) = tv%T(i,j,k) + saln_diag(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + + if (CS%use_legacy_diabatic) then + ! Changes T and S via the tridiagonal solver; no change to h + do k=1,nz ; do j=js,je ; do i=is,ie + ea_t(i,j,k) = ea_s(i,j,k) ; eb_t(i,j,k) = eb_s(i,j,k) + enddo ; enddo ; enddo + if (CS%tracer_tridiag) then + call tracer_vertdiff(hold, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea_s, eb_s, dt, tv%S, G, GV) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea_s, eb_s, tv%T, tv%S) + endif + + ! diagnose temperature, salinity, heat, and salt tendencies + ! Note: hold here refers to the thicknesses from before the dual-entraintment when using + ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will (not?) have changed + ! In either case, tendencies should be posted on hold + if (CS%diabatic_diff_tendency_diag) then + call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) + if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) + endif + else + ! Set ea_t=eb_t based on Kd_heat and ea_s=eb_s based on Kd_salt on interfaces for use in the tri-diagonal solver. + + do j=js,je ; do i=is,ie + ea_t(i,j,1) = 0.; ea_s(i,j,1) = 0. + enddo ; enddo + + !$OMP parallel do default(shared) private(hval) + do k=2,nz ; do j=js,je ; do i=is,ie + hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) + eb_t(i,j,k-1) = ea_t(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) + eb_s(i,j,k-1) = ea_s(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + eb_t(i,j,nz) = 0. ; eb_s(i,j,nz) = 0. + enddo ; enddo + if (showCallTree) call callTree_waypoint("done setting ea_t,ea_s,eb_t,eb_s from Kd_heat" //& + "and Kd_salt (diabatic)") + + ! Changes T and S via the tridiagonal solver; no change to h + call tracer_vertdiff(h, ea_t, eb_t, dt, tv%T, G, GV) + call tracer_vertdiff(h, ea_s, eb_s, dt, tv%S, G, GV) + + ! In ALE-mode, layer thicknesses do not change. Therefore, we can use h below + if (CS%diabatic_diff_tendency_diag) & + call diagnose_diabatic_diff_tendency(tv, h, temp_diag, saln_diag, dt, G, GV, CS) + endif + + call cpu_clock_end(id_clock_tridiag) + + if (showCallTree) call callTree_waypoint("done with triDiagTS (diabatic)") + + endif ! endif corresponding to if (associated(tv%T)) + + if (CS%debugConservation) call MOM_state_stats('triDiagTS', u, v, h, tv%T, tv%S, G) + + if (CS%debug) then + call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("after mixed layer ", tv, G) + endif + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + if (CS%id_dudt_dia > 0 .or. CS%id_dvdt_dia > 0) & + ! Remapped d[uv]dt_dia require east/north halo updates of h + call pass_var(h, G%domain, To_West+To_South+Omit_Corners, halo=1) + call diag_update_remap_grids(CS%diag) + + ! diagnostics + Idt = 1.0 / dt + if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then + do j=js,je ; do i=is,ie + Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 + Tadv_flx(i,j,1) = 0.0 ; Tadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Tdif_flx(i,j,K) = (Idt * 0.5*(ea_t(i,j,k) + eb_t(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea_t(i,j,k) - eb_t(i,j,k-1))) * & + 0.5*(tv%T(i,j,k-1) + tv%T(i,j,k)) + enddo ; enddo ; enddo + endif + if ((CS%id_Sdif > 0) .or. (CS%id_Sadv > 0)) then + do j=js,je ; do i=is,ie + Sdif_flx(i,j,1) = 0.0 ; Sdif_flx(i,j,nz+1) = 0.0 + Sadv_flx(i,j,1) = 0.0 ; Sadv_flx(i,j,nz+1) = 0.0 + enddo ; enddo + !$OMP parallel do default(shared) + do K=2,nz ; do j=js,je ; do i=is,ie + Sdif_flx(i,j,K) = (Idt * 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea_s(i,j,k) - eb_s(i,j,k-1))) * & + 0.5*(tv%S(i,j,k-1) + tv%S(i,j,k)) + enddo ; enddo ; enddo + endif + + ! mixing of passive tracers from massless boundary layers to interior + call cpu_clock_begin(id_clock_tracers) + + if (CS%mix_boundary_tracers) then + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) + !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) + do j=js,je + do i=is,ie + ebtr(i,j,nz) = eb_s(i,j,nz) + htot(i) = 0.0 + in_boundary(i) = (G%mask2dT(i,j) > 0.0) + enddo + do k=nz,2,-1 ; do i=is,ie + if (in_boundary(i)) then + htot(i) = htot(i) + h(i,j,k) + ! If diapycnal mixing has been suppressed because this is a massless + ! layer near the bottom, add some mixing of tracers between these + ! layers. This flux is based on the harmonic mean of the two + ! thicknesses, as this corresponds pretty closely (to within + ! differences in the density jumps between layers) with what is done + ! in the calculation of the fluxes in the first place. Kd_min_tr + ! should be much less than the values that have been set in Kd_int, + ! perhaps a molecular diffusivity. + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & + ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & + (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea_s(i,j,k),eb_s(i,j,k-1))) + elseif (add_ent < 0.0) then + add_ent = 0.0 ; in_boundary(i) = .false. + endif + + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent + else + ebtr(i,j,k-1) = eb_s(i,j,k-1) ; eatr(i,j,k) = ea_s(i,j,k) + endif + + if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif + ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea_s(i,j,1) ; enddo + + enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + ! so hold should be h_orig + call call_tracer_column_fns(h_prebound, h, ea_s, eb_s, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + + elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers + + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = eb_s(i,j,nz) ; eatr(i,j,1) = ea_s(i,j,1) + enddo ; enddo + !$OMP parallel do default(shared) private(add_ent) + do k=nz,2,-1 ; do j=js,je ; do i=is,ie + if (visc%Kd_extra_S(i,j,k) > 0.0) then + if (CS%use_legacy_diabatic) then + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + h_neglect) + else + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + (0.5 * (h(i,j,k-1) + h(i,j,k)) + & + h_neglect) + endif + else + add_ent = 0.0 + endif + ebtr(i,j,k-1) = eb_s(i,j,k-1) + add_ent + eatr(i,j,k) = ea_s(i,j,k) + add_ent + enddo ; enddo ; enddo + + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug,& + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + else + ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied + call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug, & + evap_CFL_limit = CS%evap_CFL_limit, & + minimum_forcing_depth = CS%minimum_forcing_depth) + endif ! (CS%mix_boundary_tracers) + + call cpu_clock_end(id_clock_tracers) + + ! Apply ALE sponge + if (CS%use_sponge) then + call cpu_clock_begin(id_clock_sponge) + if (associated(CS%ALE_sponge_CSp)) then + call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + endif + + call cpu_clock_end(id_clock_sponge) + if (CS%debug) then + call MOM_state_chksum("apply_sponge ", u, v, h, G, GV, haloshift=0) + call MOM_thermovar_chksum("apply_sponge ", tv, G) + endif + endif ! CS%use_sponge + + call disable_averaging(CS%diag) + ! Diagnose the diapycnal diffusivities and other related quantities. + call enable_averaging(dt, Time_end, CS%diag) - integer :: id_boundary_forcing_h = -1 - integer :: id_boundary_forcing_h_tendency = -1 - integer :: id_boundary_forcing_temp_tend = -1 - integer :: id_boundary_forcing_saln_tend = -1 - integer :: id_boundary_forcing_heat_tend = -1 - integer :: id_boundary_forcing_salt_tend = -1 - integer :: id_boundary_forcing_heat_tend_2d = -1 - integer :: id_boundary_forcing_salt_tend_2d = -1 + if (CS%id_Kd_interface > 0) call post_data(CS%id_Kd_interface, Kd_int, CS%diag) + if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) + if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) + if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - integer :: id_frazil_h = -1 - integer :: id_frazil_temp_tend = -1 - integer :: id_frazil_heat_tend = -1 - integer :: id_frazil_heat_tend_2d = -1 - !!@} + if (CS%id_ea > 0) call post_data(CS%id_ea, ea_s, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb_s, CS%diag) + if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ea_t, CS%diag) + if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, eb_t, CS%diag) + if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ea_s, CS%diag) + if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, eb_s, CS%diag) - logical :: diabatic_diff_tendency_diag = .false. !< If true calculate diffusive tendency diagnostics - logical :: boundary_forcing_tendency_diag = .false. !< If true calculate frazil diagnostics - logical :: frazil_tendency_diag = .false. !< If true calculate frazil tendency diagnostics - real, allocatable, dimension(:,:,:) :: frazil_heat_diag !< diagnose 3d heat tendency from frazil - real, allocatable, dimension(:,:,:) :: frazil_temp_diag !< diagnose 3d temp tendency from frazil + if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) + if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) + if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() !< Control structure for a child module - type(entrain_diffusive_CS), pointer :: entrain_diffusive_CSp => NULL() !< Control structure for a child module - type(bulkmixedlayer_CS), pointer :: bulkmixedlayer_CSp => NULL() !< Control structure for a child module - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< Control structure for a child module - type(regularize_layers_CS), pointer :: regularize_layers_CSp => NULL() !< Control structure for a child module - type(geothermal_CS), pointer :: geothermal_CSp => NULL() !< Control structure for a child module - type(int_tide_CS), pointer :: int_tide_CSp => NULL() !< Control structure for a child module - type(int_tide_input_CS), pointer :: int_tide_input_CSp => NULL() !< Control structure for a child module - type(int_tide_input_type), pointer :: int_tide_input => NULL() !< Control structure for a child module - type(opacity_CS), pointer :: opacity_CSp => NULL() !< Control structure for a child module - type(set_diffusivity_CS), pointer :: set_diff_CSp => NULL() !< Control structure for a child module - type(sponge_CS), pointer :: sponge_CSp => NULL() !< Control structure for a child module - type(ALE_sponge_CS), pointer :: ALE_sponge_CSp => NULL() !< Control structure for a child module - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() !< Control structure for a child module - type(optics_type), pointer :: optics => NULL() !< Control structure for a child module - type(KPP_CS), pointer :: KPP_CSp => NULL() !< Control structure for a child module - type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() !< Control structure for a child module - type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() !< Control structure for a child module - type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() !< Control structure for a child module + if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) + if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) + if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) + if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass - type(group_pass_type) :: pass_Kv !< For group halo pass - type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm - ! Data arrays for communicating between components - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [m s-1] - real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [m2 s-3] - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux [degC m s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux [ppt m s-1] + call disable_averaging(CS%diag) - type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) -end type diabatic_CS + if (showCallTree) call callTree_leave("diabatic_ALE_legacy()") -! clock ids -integer :: id_clock_entrain, id_clock_mixedlayer, id_clock_set_diffusivity -integer :: id_clock_tracers, id_clock_tridiag, id_clock_pass, id_clock_sponge -integer :: id_clock_geothermal, id_clock_differential_diff, id_clock_remap -integer :: id_clock_kpp +end subroutine diabatic_ALE_legacy -contains !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: 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 @@ -273,7 +1239,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< mixed layer depth [m] + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -302,55 +1268,36 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] - dSV_dT, & ! The partial derivatives of specific volume with temperature - dSV_dS, & ! and salinity in [m3 kg-1 degC-1] and [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J/m^2]. + dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] + dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [Z2 s-3 ~> m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target :: & - ! These are targets so that the space can be shared with eaml & ebml. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] Sadv_flx ! advective diapycnal salt flux across interfaces [ppt m s-1] - ! The following 5 variables are only used with a bulk mixed layer. - real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes [H ~> m or kg m-2] - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as - ! the arrays are not needed at the same time. - - integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser - ! than the buffer layer [nondim] - - real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential - ! density which defines the coordinate - ! variable, set to P_Ref [Pa]. - logical :: in_boundary(SZI_(G)) ! True if there are no massive layers below, ! where massive is defined as sufficiently thick that ! the no-flux boundary conditions have not restricted @@ -376,16 +1323,15 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -393,94 +1339,28 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") + if (showCallTree) call callTree_enter("diabatic_ALE(), MOM_diabatic_driver.F90") if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "The ALE algorithm must be enabled when using MOM_diabatic_driver.") - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif - - - ! set equivalence between the same bits of memory for these arrays - eaml => eatr ; ebml => ebtr - - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "diabatic was called with a negative timestep.") - Idt = 1.0 / dt - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) - - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif !associated(tv%T) .AND. associated(tv%frazil) + dt_in_T = dt * US%s_to_T ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + if (CS%use_geothermal) then halo = CS%halo_TS_diff !$OMP parallel do default(shared) do k=1,nz ; do j=js-halo,je+halo ; do i=is-halo,ie+halo - h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(i,j,k) = 0.0 + h_orig(i,j,k) = h(i,j,k) ; eatr(i,j,k) = 0.0 ; ebtr(i,j,k) = 0.0 enddo ; enddo ; enddo endif if (CS%use_geothermal) then call cpu_clock_begin(id_clock_geothermal) - call geothermal(h, tv, dt, eaml, ebml, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) + call geothermal(h, tv, dt, eatr, ebtr, G, GV, CS%geothermal_CSp, halo=CS%halo_TS_diff) call cpu_clock_end(id_clock_geothermal) if (showCallTree) call callTree_waypoint("geothermal (diabatic)") if (CS%debugConservation) call MOM_state_stats('geothermal', u, v, h, tv%T, tv%S, G) @@ -490,21 +1370,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) - if (CS%debug) & - call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) + if (CS%debug) call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then - if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then - call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) + if (CS%use_geothermal) then + call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eatr, ebtr) if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml",G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml",G%HI, scale=GV%H_to_m) + call hchksum(eatr, "after find_uv_at_h eatr",G%HI, scale=GV%H_to_m) + call hchksum(ebtr, "after find_uv_at_h ebtr",G%HI, scale=GV%H_to_m) endif else call find_uv_at_h(u, v, h, u_h, v_h, G, GV) @@ -512,67 +1391,27 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, & - CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, US, & - CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif ! end CS%use_int_tides - call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%Kv_slow and visc%TKE_turb (not clear that TKE_turb is used as input ???? - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear, visc%Kv_shear and visc%Kv_slow + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") + if (CS%debug) then + call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + endif + ! Set diffusivities for heat and salt separately !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) enddo ; enddo ; enddo ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then @@ -589,11 +1428,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (CS%debug) then - call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (CS%useKPP) then @@ -616,7 +1452,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) call KPP_calculate(CS%KPP_CSp, G, GV, US, h, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) if (associated(Hml)) then !$OMP parallel default(shared) @@ -633,8 +1469,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -643,10 +1479,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S @@ -665,11 +1501,11 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! This is the "old" method for applying differential diffusion. ! Changes: tv%T, tv%S - if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. .not. & - CS%use_CVMix_ddiff) then + if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T) .and. & + (.not.CS%use_CVMix_ddiff)) then call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") @@ -692,13 +1528,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) ! Increment vertical diffusion and viscosity due to convection !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_heat(i,j,k) = Kd_heat(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) - Kd_salt(i,j,k) = Kd_salt(i,j,k) + CS%CVMix_conv_csp%kd_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_heat(i,j,K) = Kd_heat(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + Kd_salt(i,j,K) = Kd_salt(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) if (CS%useKPP) then - visc%Kv_shear(i,j,k) = visc%Kv_shear(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) else - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) endif enddo ; enddo ; enddo endif @@ -717,13 +1553,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Changes made to following fields: h, tv%T and tv%S. do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) + h_prebound(i,j,k) = h(i,j,k) enddo ; enddo ; enddo if (CS%use_energetic_PBL) then skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) if (CS%debug) then @@ -737,7 +1573,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & + call energetic_PBL(h, u_h, v_h, tv, fluxes, dt_in_T, Kd_ePBL, G, GV, US, & CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) if (associated(Hml)) then @@ -752,7 +1588,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie - !### These expressesions assume a Prandtl number of 1. + !### These expressions assume a Prandtl number of 1. if (CS%ePBL_is_additive) then Kd_add_here = Kd_ePBL(i,j,K) visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) @@ -771,12 +1607,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call hchksum(eb_t, "after ePBL eb_t",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(ea_s, "after ePBL ea_s",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(eb_s, "after ePBL eb_s",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & CS%evap_CFL_limit, CS%minimum_forcing_depth) endif ! endif for CS%use_energetic_PBL @@ -839,9 +1675,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(hval) do k=2,nz ; do j=js,je ; do i=is,ie hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea_t(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_heat(i,j,k) + ea_t(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_heat(i,j,k) eb_t(i,j,k-1) = ea_t(i,j,k) - ea_s(i,j,k) = (GV%Z_to_H**2) * dt * hval * Kd_salt(i,j,k) + ea_s(i,j,k) = (GV%Z_to_H**2) * dt_in_T * hval * Kd_salt(i,j,k) eb_s(i,j,k-1) = ea_s(i,j,k) enddo ; enddo ; enddo do j=js,je ; do i=is,ie @@ -894,6 +1730,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -925,7 +1762,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -942,9 +1779,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & ! thicknesses, as this corresponds pretty closely (to within ! differences in the density jumps between layers) with what is done ! in the calculation of the fluxes in the first place. Kd_min_tr - ! should be much less than the values that have been set in Kd_lay, + ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea_s(i,j,k) + eb_s(i,j,k-1)) @@ -962,7 +1799,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -988,7 +1825,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.5 * (h(i,j,k-1) + h(i,j,k)) + & h_neglect) else @@ -1003,23 +1840,20 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%optics, CS%tracer_flow_CSp, CS%debug,& evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - else ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & evap_CFL_limit = CS%evap_CFL_limit, & minimum_forcing_depth = CS%minimum_forcing_depth) - endif ! (CS%mix_boundary_tracers) call cpu_clock_end(id_clock_tracers) - ! sponges + ! Apply ALE sponge if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) endif @@ -1038,42 +1872,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & call create_group_pass(CS%pass_hold_eb_ea, ea_t, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea_s, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear and visc%Kv_slow are not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + ! visc%Kv_slow is not in the group pass because it has larger vertical extent. if (associated(visc%Kv_slow)) & call pass_var(visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) - call cpu_clock_end(id_clock_pass) call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -1091,39 +1895,21 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & if (CS%id_dudt_dia > 0) call post_data(CS%id_dudt_dia, ADp%du_dt_dia, CS%diag) if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("diabatic_ALE()") -end subroutine diabatic +end subroutine diabatic_ALE !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. -subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & - G, GV, US, CS, WAVES) +subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, US, CS, WAVES) type(ocean_grid_type), intent(inout) :: 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 @@ -1132,7 +1918,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< active mixed layer depth + real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, BBL properies, and @@ -1152,27 +1938,22 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! one time step [H ~> m or kg m-2] Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] - h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] + h_prebound, & ! initial layer thicknesses [H ~> m or kg m-2] hold, & ! layer thickness before diapycnal entrainment, and later ! the initial layer thicknesses (if a mixed layer is used), ! [H ~> m or kg m-2] dSV_dT, & ! The partial derivative of specific volume with temperature [m3 kg-1 degC-1] dSV_dS, & ! The partial derivative of specific volume with salinity [m3 kg-1 ppt-1]. - cTKE, & ! convective TKE requirements for each layer [J m-2]. + cTKE, & ! convective TKE requirements for each layer [kg m-3 Z3 T-2 ~> J m-2]. u_h, & ! zonal and meridional velocities at thickness points after v_h ! entrainment [m s-1] - - real, dimension(SZI_(G),SZJ_(G),CS%nMode) :: & - cn ! baroclinic gravity wave speeds (formerly cg1 - BDM) - real, dimension(SZI_(G),SZJ_(G)) :: & Rcv_ml, & ! coordinate density of mixed layer, used for applying sponges - SkinBuoyFlux! 2d surface buoyancy flux [m2 s-3], used by ePBL + SkinBuoyFlux! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL real, dimension(SZI_(G),SZJ_(G),G%ke) :: h_diag ! diagnostic array for thickness real, dimension(SZI_(G),SZJ_(G),G%ke) :: temp_diag ! diagnostic array for temp real, dimension(SZI_(G),SZJ_(G),G%ke) :: saln_diag ! diagnostic array for salinity real, dimension(SZI_(G),SZJ_(G)) :: tendency_2d ! depth integrated content tendency for diagn - real, dimension(SZI_(G),SZJ_(G)) :: TKE_itidal_input_test ! override of energy input for testing (BDM) real :: net_ent ! The net of ea-eb at an interface. @@ -1180,14 +1961,13 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! These are targets so that the space can be shared with eaml & ebml. eatr, & ! The equivalent of ea and eb for tracers, which differ from ea and ebtr ! eb in that they tend to homogenize tracers in massless layers - ! near the boundaries [H ~> m or kg m-2] + ! near the boundaries [H ~> m or kg m-2] (for Bous or non-Bouss) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 s-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 s-1 ~> m2 s-1] - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1] - eta, & ! Interface heights before diapycnal mixing [m]. + Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [degC m s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [degC m s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [ppt m s-1] @@ -1195,9 +1975,9 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! The following 5 variables are only used with a bulk mixed layer. real, pointer, dimension(:,:,:) :: & - eaml, & ! The equivalent of ea and eb due to mixed layer processes, - ebml ! [H ~> m or kg m-2]. These will be - ! pointers to eatr and ebtr so as to reuse the memory as + eaml, & ! The equivalent of ea due to mixed layer processes [H ~> m or kg m-2]. + ebml ! The equivalent of eb due to mixed layer processes [H ~> m or kg m-2]. + ! eaml and ebml are pointers to eatr and ebtr so as to reuse the memory as ! the arrays are not needed at the same time. integer :: kb(SZI_(G),SZJ_(G)) ! index of the lightest layer denser @@ -1231,17 +2011,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en real :: b1(SZIB_(G)), d1(SZIB_(G)) ! b1, c1, and d1 are variables used by the real :: c1(SZIB_(G),SZK_(G)) ! tridiagonal solver. - real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2]. - real :: dt_mix ! amount of time over which to apply mixing [s] - real :: Idt ! inverse time step [s-1] + real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] + real :: dt_mix ! The amount of time over which to apply mixing [T ~> s] + real :: Idt ! The inverse time step [s-1] + real :: dt_in_T ! The time step converted to T units [T ~> s] integer :: dir_flag ! An integer encoding the directions in which to do halo updates. logical :: showCallTree ! If true, show the call tree integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb, m, halo integer :: ig, jg ! global indices for testing testing itide point source (BDM) - logical :: avg_enabled ! for testing internal tides (BDM) - real :: Kd_add_here ! An added diffusivity [Z2 s-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1250,76 +2030,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() - if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") - - ! Offer diagnostics of various state varables at the start of diabatic - ! these are mostly for debugging purposes. - if (CS%id_u_predia > 0) call post_data(CS%id_u_predia, u, CS%diag) - if (CS%id_v_predia > 0) call post_data(CS%id_v_predia, v, CS%diag) - if (CS%id_h_predia > 0) call post_data(CS%id_h_predia, h, CS%diag) - if (CS%id_T_predia > 0) call post_data(CS%id_T_predia, tv%T, CS%diag) - if (CS%id_S_predia > 0) call post_data(CS%id_S_predia, tv%S, CS%diag) - if (CS%id_e_predia > 0) then - call find_eta(h, tv, G, GV, US, eta, eta_to_m=1.0) - call post_data(CS%id_e_predia, eta, CS%diag) - endif + if (showCallTree) call callTree_enter("layered_diabatic(), MOM_diabatic_driver.F90") ! set equivalence between the same bits of memory for these arrays eaml => eatr ; ebml => ebtr + dt_in_T = dt * US%s_to_T - ! inverse time step - if (dt == 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a zero length timestep.") - if (dt < 0.0) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "legacy_diabatic was called with a negative timestep.") - Idt = 1.0 / dt - - if (.not. associated(CS)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & - "Module must be initialized before it is used.") - - if (CS%debug) then - call MOM_state_chksum("Start of diabatic ", u, v, h, G, GV, haloshift=0) - call MOM_forcing_chksum("Start of diabatic", fluxes, G, US, haloshift=0) - endif - if (CS%debugConservation) call MOM_state_stats('Start of diabatic', u, v, h, tv%T, tv%S, G) - - if (CS%debug_energy_req) & - call diapyc_energy_req_test(h, dt, tv, G, GV, US, CS%diapyc_en_rec_CSp) - - call cpu_clock_begin(id_clock_set_diffusivity) - call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS%set_diff_CSp) - call cpu_clock_end(id_clock_set_diffusivity) - - ! Frazil formation keeps the temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - ! For frazil diagnostic, the first call covers the first half of the time step - call enable_averaging(0.5*dt, Time_end - real_to_time(0.5*dt), CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full, halo=CS%halo_TS_diff) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, halo=CS%halo_TS_diff) - endif - if (showCallTree) call callTree_waypoint("done with 1st make_frazil (diabatic)") - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0) call post_data(CS%id_frazil_h, h, CS%diag) - endif - call disable_averaging(CS%diag) - endif ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averaging(dt, Time_end, CS%diag) - if (CS%debugConservation) call MOM_state_stats('1st make_frazil', u, v, h, tv%T, tv%S, G) if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then halo = CS%halo_TS_diff @@ -1341,16 +2060,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) - ! Set_opacity estimates the optical properties of the water column. + ! Set_pen_shortwave estimates the optical properties of the water column. ! It will need to be modified later to include information about the ! biological properties and layer thicknesses. if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, G, GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, G, GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) if (CS%bulkmixedlayer) then - if (CS%debug) then - call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) - endif + if (CS%debug) call MOM_forcing_chksum("Before mixedlayer", fluxes, G, US, haloshift=0) if (CS%ML_mix_first > 0.0) then ! This subroutine @@ -1365,17 +2082,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call cpu_clock_begin(id_clock_mixedlayer) if (CS%ML_mix_first < 1.0) then ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T*CS%ML_mix_first, & eaml,ebml, G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.false.) if (CS%salt_reject_below_ML) & call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, & dt*CS%ML_mix_first, CS%id_brine_lay) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) - call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & + call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_in_T, eaml, ebml, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) endif ! Keep salinity from falling below a small but positive threshold. @@ -1396,9 +2113,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif endif - if (CS%debug) then + if (CS%debug) & call MOM_state_chksum("before find_uv_at_h", u, v, h, G, GV, haloshift=0) - endif if (CS%use_kappa_shear .or. CS%use_CVMix_shear) then if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, eaml, ebml) @@ -1412,61 +2128,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (showCallTree) call callTree_waypoint("done with find_uv_at_h (diabatic)") endif - if (CS%use_int_tides) then - ! This block provides an interface for the unresolved low-mode internal - ! tide module (BDM). - - ! PROVIDE ENERGY DISTRIBUTION (calculate time-varying energy source) - call set_int_tide_input(u, v, h, tv, fluxes, CS%int_tide_input, dt, G, GV, US, & - CS%int_tide_input_CSp) - ! CALCULATE MODAL VELOCITIES - cn(:,:,:) = 0.0 - if (CS%uniform_cg) then - ! SET TO CONSTANT VALUE TO TEST PROPAGATE CODE - do m=1,CS%nMode ; cn(:,:,m) = CS%cg_test ; enddo - else - call wave_speeds(h, tv, G, GV, US, CS%nMode, cn, full_halos=.true.) - ! uncomment the lines below for a hard-coded cn that changes linearly with latitude - !do j=G%jsd,G%jed ; do i=G%isd,G%ied - ! cn(i,j,:) = ((7.-1.)/14000000.)*G%geoLatBu(i,j) + (1.-((7.-1.)/14000000.)*-7000000.) - !enddo ; enddo - endif - - if (CS%int_tide_source_test) then - ! BUILD 2D ARRAY WITH POINT SOURCE FOR TESTING - ! This block of code should be moved into set_int_tide_input. -RWH - TKE_itidal_input_test(:,:) = 0.0 - avg_enabled = query_averaging_enabled(CS%diag,time_end=CS%time_end) - if (CS%time_end <= CS%time_max_source) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - !INPUT ARBITRARY ENERGY POINT SOURCE - if ((G%idg_offset + i == CS%int_tide_source_x) .and. & - (G%jdg_offset + j == CS%int_tide_source_y)) then - TKE_itidal_input_test(i,j) = 1.0 - endif - enddo ; enddo - endif - ! CALL ROUTINE USING PRESCRIBED KE FOR TESTING - call propagate_int_tide(h, tv, cn, TKE_itidal_input_test, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - else - ! CALL ROUTINE USING CALCULATED KE INPUT - call propagate_int_tide(h, tv, cn, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide_CSp) - endif - if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif - call cpu_clock_begin(id_clock_set_diffusivity) - ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S - ! Also changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ???? - ! And sets visc%Kv_shear + ! Sets: Kd_lay, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S and visc%TKE_turb + ! Also changes: visc%Kd_shear and visc%Kv_shear if ((CS%halo_TS_diff > 0) .and. (CS%ML_mix_first > 0.0)) then if (associated(tv%T)) call pass_var(tv%T, G%Domain, halo=CS%halo_TS_diff, complete=.false.) if (associated(tv%T)) call pass_var(tv%S, G%Domain, halo=CS%halo_TS_diff, complete=.false.) call pass_var(h, G%domain, halo=CS%halo_TS_diff, complete=.true.) endif - call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, US, & + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt_in_T, G, GV, US, & CS%set_diff_CSp, Kd_lay, Kd_int) call cpu_clock_end(id_clock_set_diffusivity) if (showCallTree) call callTree_waypoint("done with set_diffusivity (diabatic)") @@ -1475,10 +2145,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif @@ -1493,11 +2161,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. - !$OMP parallel do default(shared) - do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_salt(i,j,k) = US%s_to_T * Kd_int(i,j,K) - Kd_heat(i,j,k) = US%s_to_T * Kd_int(i,j,K) - enddo ; enddo ; enddo + ! Set diffusivities for heat and salt separately + + !$OMP parallel do default(shared) + do k=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_salt(i,j,k) = Kd_int(i,j,K) + Kd_heat(i,j,k) = Kd_int(i,j,K) + enddo ; enddo ; enddo + ! Add contribution from double diffusion if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie @@ -1527,18 +2198,18 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = US%T_to_s * min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) + Kd_int(i,j,K) = min( Kd_salt(i,j,k), Kd_heat(i,j,k) ) enddo ; enddo ; enddo if (associated(visc%Kd_extra_S)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_S(i,j,k) = (Kd_salt(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif if (associated(visc%Kd_extra_T)) then !$OMP parallel do default(shared) do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - US%s_to_T * Kd_int(i,j,K)) + visc%Kd_extra_T(i,j,k) = (Kd_heat(i,j,k) - Kd_int(i,j,K)) enddo ; enddo ; enddo endif endif ! not passive @@ -1549,10 +2220,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_state_chksum("after KPP", u, v, h, G, GV, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G) - call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, & - scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif endif ! endif for KPP @@ -1561,24 +2230,19 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%use_CVMix_conv) then call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv_csp, Hml) - !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - !### The vertical extent here is more limited that Kv_slow or Kd_int; it might be k=1,nz+1. - do k=1,nz ; do j=js,je ; do i=is,ie - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * CS%CVMix_conv_csp%kd_conv(i,j,k) - visc%Kv_slow(i,j,k) = visc%Kv_slow(i,j,k) + CS%CVMix_conv_csp%kv_conv(i,j,k) + do K=1,nz+1 ; do j=js,je ; do i=is,ie + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%CVMix_conv_csp%kd_conv(i,j,K) + visc%Kv_slow(i,j,K) = visc%Kv_slow(i,j,K) + CS%CVMix_conv_csp%kv_conv(i,j,K) enddo ; enddo ; enddo - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - endif if (CS%useKPP) then - call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat",G%HI,haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar",G%HI,haloshift=0) + call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S @@ -1593,15 +2257,14 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G) endif - endif ! endif for KPP ! Differential diffusion done here. ! Changes: tv%T, tv%S if (associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S) .and. associated(tv%T)) then - call cpu_clock_begin(id_clock_differential_diff) - call differential_diffuse_T_S(h, tv, visc, dt, G, GV) + call cpu_clock_begin(id_clock_differential_diff) + call differential_diffuse_T_S(h, tv, visc, dt_in_T, G, GV) call cpu_clock_end(id_clock_differential_diff) if (showCallTree) call callTree_waypoint("done with differential_diffuse_T_S (diabatic)") if (CS%debugConservation) call MOM_state_stats('differential_diffuse_T_S', u, v, h, tv%T, tv%S, G) @@ -1609,6 +2272,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! increment heat and salt diffusivity. ! CS%useKPP==.true. already has extra_T and extra_S included if (.not. CS%useKPP) then + !$OMP parallel do default(shared) do K=2,nz ; do j=js,je ; do i=is,ie Kd_heat(i,j,K) = Kd_heat(i,j,K) + visc%Kd_extra_T(i,j,K) Kd_salt(i,j,K) = Kd_salt(i,j,K) + visc%Kd_extra_S(i,j,K) @@ -1618,39 +2282,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en endif ! This block sets ea, eb from Kd or Kd_int. - ! If using ALE algorithm, set ea=eb=Kd_int on interfaces for - ! use in the tri-diagonal solver. ! Otherwise, call entrainment_diffusive() which sets ea and eb ! based on KD and target densities (ie. does remapping as well). - if (CS%useALEalgorithm) then - - do j=js,je ; do i=is,ie - ea(i,j,1) = 0. - enddo ; enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_neglect,h,ea,GV,dt,Kd_int,eb) & -!$OMP private(hval) - do k=2,nz ; do j=js,je ; do i=is,ie - hval=1.0/(h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ea(i,j,k) = (GV%Z_to_H**2) * dt * hval * (US%s_to_T * Kd_int(i,j,K)) - eb(i,j,k-1) = ea(i,j,k) - enddo ; enddo ; enddo - do j=js,je ; do i=is,ie - eb(i,j,nz) = 0. - enddo ; enddo - if (showCallTree) call callTree_waypoint("done setting ea,eb from Kd_int (diabatic)") - - else ! .not. CS%useALEalgorithm - ! When not using ALE, calculate layer entrainments/detrainments from - ! diffusivities and differences between layer and target densities - call cpu_clock_begin(id_clock_entrain) - ! Calculate appropriately limited diapycnal mass fluxes to account - ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb - call Entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS%entrain_diffusive_CSp, & - ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) - call cpu_clock_end(id_clock_entrain) - if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") - - endif ! endif for (CS%useALEalgorithm) + ! When not using ALE, calculate layer entrainments/detrainments from + ! diffusivities and differences between layer and target densities + call cpu_clock_begin(id_clock_entrain) + ! Calculate appropriately limited diapycnal mass fluxes to account + ! for diapycnal diffusion and advection. Sets: ea, eb. Changes: kb + call Entrainment_diffusive(h, tv, fluxes, dt_in_T, G, GV, US, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_lay=Kd_lay, Kd_int=Kd_int) + call cpu_clock_end(id_clock_entrain) + if (showCallTree) call callTree_waypoint("done with Entrainment_diffusive (diabatic)") if (CS%debug) then call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) @@ -1669,97 +2311,6 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo ; enddo ; enddo endif - ! Apply forcing when using the ALE algorithm - if (CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - - ! Changes made to following fields: h, tv%T and tv%S. - - do k=1,nz ; do j=js,je ; do i=is,ie - h_prebound(i,j,k) = h(i,j,k) - enddo ; enddo ; enddo - if (CS%use_energetic_PBL) then - - skinbuoyflux(:,:) = 0.0 - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) - - if (CS%debug) then - call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after applyBoundaryFluxes eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(cTKE, "after applyBoundaryFluxes cTKE",G%HI,haloshift=0) - call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT",G%HI,haloshift=0) - call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS",G%HI,haloshift=0) - endif - - call find_uv_at_h(u, v, h, u_h, v_h, G, GV) - call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & - CS%energetic_PBL_CSp, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - - ! If visc%MLD exists, copy the ePBL's MLD into it - if (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, visc%MLD, G, US) - call pass_var(visc%MLD, G%domain, halo=1) - Hml(:,:) = visc%MLD(:,:) - endif - - ! Augment the diffusivities due to those diagnosed in energetic_PBL. - do K=2,nz ; do j=js,je ; do i=is,ie - - if (CS%ePBL_is_additive) then - Kd_add_here = Kd_ePBL(i,j,K) - visc%Kv_shear(i,j,K) = visc%Kv_shear(i,j,K) + Kd_ePBL(i,j,K) - else - Kd_add_here = max(Kd_ePBL(i,j,K) - visc%Kd_shear(i,j,K), 0.0) - visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), Kd_ePBL(i,j,K)) - endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / & - (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) - eb(i,j,k-1) = eb(i,j,k-1) + Ent_int - ea(i,j,k) = ea(i,j,k) + Ent_int - Kd_int(i,j,K) = Kd_int(i,j,K) + US%T_to_s * Kd_add_here - - ! for diagnostics - Kd_heat(i,j,K) = Kd_heat(i,j,K) + US%T_to_s * Kd_int(i,j,K) - Kd_salt(i,j,K) = Kd_salt(i,j,K) + US%T_to_s * Kd_int(i,j,K) - - enddo ; enddo ; enddo - - if (CS%debug) then - call hchksum(ea, "after ePBL ea",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after ePBL eb",G%HI,haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z_to_m**2) - endif - - else - call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - endif ! endif for CS%use_energetic_PBL - - ! diagnose the tendencies due to boundary forcing - ! At this point, the diagnostic grids have not been updated since the call to the boundary layer scheme - ! so all tendency diagnostics need to be posted on h_diag, and grids rebuilt afterwards - if (CS%boundary_forcing_tendency_diag) then - call diagnose_boundary_forcing_tendency(tv, h, temp_diag, saln_diag, h_diag, dt, G, GV, CS) - if (CS%id_boundary_forcing_h > 0) call post_data(CS%id_boundary_forcing_h, h, CS%diag, alt_h = h_diag) - endif - ! Boundary fluxes may have changed T, S, and h - call diag_update_remap_grids(CS%diag) - - call cpu_clock_end(id_clock_remap) - if (CS%debug) then - call MOM_forcing_chksum("after applyBoundaryFluxes ", fluxes, G, US, haloshift=0) - call MOM_thermovar_chksum("after applyBoundaryFluxes ", tv, G) - call MOM_state_chksum("after applyBoundaryFluxes ", u, v, h, G, GV, haloshift=0) - endif - if (showCallTree) call callTree_waypoint("done with applyBoundaryFluxes (diabatic)") - if (CS%debugConservation) call MOM_state_stats('applyBoundaryFluxes', u, v, h, tv%T, tv%S, G) - - endif ! endif for (CS%useALEalgorithm) - ! Update h according to divergence of the difference between ! ea and eb. We keep a record of the original h in hold. ! In the following, the checks for negative values are to guard @@ -1921,15 +2472,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call find_uv_at_h(u, v, hold, u_h, v_h, G, GV, ea, eb) if (CS%debug) call MOM_state_chksum("find_uv_at_h1 ", u, v, h, G, GV, haloshift=0) - dt_mix = min(dt,dt*(1.0 - CS%ML_mix_first)) + dt_mix = min(dt_in_T, dt_in_T*(1.0 - CS%ML_mix_first)) call cpu_clock_begin(id_clock_mixedlayer) ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer_CSp, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + Hml, CS%aggregate_FW_forcing, dt_in_T, last_call=.true.) if (CS%salt_reject_below_ML) & - call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, US%T_to_s*dt_mix, & CS%id_brine_lay) ! Keep salinity from falling below a small but positive threshold. @@ -1975,16 +2526,15 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! Changes T and S via the tridiagonal solver; no change to h if (CS%tracer_tridiag) then - call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) - call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%T, G, GV) + call tracer_vertdiff(hold, ea, eb, dt, tv%S, G, GV) else call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) endif ! diagnose temperature, salinity, heat, and salt tendencies ! Note: hold here refers to the thicknesses from before the dual-entraintment when using - ! the bulk mixed layer scheme. Otherwise in ALE-mode, layer thicknesses will have changed - ! In either case, tendencies should be posted on hold + ! the bulk mixed layer scheme, so tendencies should be posted on hold. if (CS%diabatic_diff_tendency_diag) then call diagnose_diabatic_diff_tendency(tv, hold, temp_diag, saln_diag, dt, G, GV, CS) if (CS%id_diabatic_diff_h > 0) call post_data(CS%id_diabatic_diff_h, hold, CS%diag, alt_h = hold) @@ -2005,13 +2555,11 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) endif - if (.not. CS%useALEalgorithm) then - call cpu_clock_begin(id_clock_remap) - call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) - call cpu_clock_end(id_clock_remap) - if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") - if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) - endif + call cpu_clock_begin(id_clock_remap) + call regularize_layers(h, tv, dt, ea, eb, G, GV, CS%regularize_layers_CSp) + call cpu_clock_end(id_clock_remap) + if (showCallTree) call callTree_waypoint("done with regularize_layers (diabatic)") + if (CS%debugConservation) call MOM_state_stats('regularize_layers', u, v, h, tv%T, tv%S, G) ! Whenever thickness changes let the diag manager know, as the ! target grids for vertical remapping may need to be regenerated. @@ -2021,6 +2569,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call diag_update_remap_grids(CS%diag) ! diagnostics + Idt = 1.0 / dt if ((CS%id_Tdif > 0) .or. (CS%id_Tadv > 0)) then do j=js,je ; do i=is,ie Tdif_flx(i,j,1) = 0.0 ; Tdif_flx(i,j,nz+1) = 0.0 @@ -2051,7 +2600,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracers) then - Tr_ea_BBL = sqrt(dt*CS%Kd_BBL_tr) !### I think this needs GV%Z_to_H + Tr_ea_BBL = GV%Z_to_H * sqrt(dt_in_T*CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2070,7 +2619,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & + add_ent = ((dt_in_T * CS%Kd_min_tr) * GV%Z_to_H**2) * & ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) @@ -2087,7 +2636,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (associated(visc%Kd_extra_S)) then ; if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent @@ -2098,17 +2647,8 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - ! so hold should be h_orig - call call_tracer_column_fns(h_prebound, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) elseif (associated(visc%Kd_extra_S)) then ! extra diffusivity for passive tracers @@ -2118,7 +2658,7 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (visc%Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & + add_ent = ((dt_in_T * visc%Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & h_neglect) else @@ -2128,28 +2668,12 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug,& - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) else - if (CS%useALEalgorithm) then - ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_prebound, h, eatr, ebtr, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & - minimum_forcing_depth = CS%minimum_forcing_depth) - else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) - endif + call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, tv, & + CS%optics, CS%tracer_flow_CSp, CS%debug) endif ! (CS%mix_boundary_tracers) @@ -2158,22 +2682,17 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en ! sponges if (CS%use_sponge) then call cpu_clock_begin(id_clock_sponge) - if (associated(CS%ALE_sponge_CSp)) then - ! ALE sponge - call apply_ALE_sponge(h, dt, G, GV, US, CS%ALE_sponge_CSp, CS%Time) + ! Layer mode sponge + if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then + do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo + !$OMP parallel do default(shared) + do j=js,je + call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & + is, ie-is+1, tv%eqn_of_state) + enddo + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) else - ! Layer mode sponge - if (CS%bulkmixedlayer .and. associated(tv%eqn_of_state)) then - do i=is,ie ; p_ref_cv(i) = tv%P_Ref ; enddo - !$OMP parallel do default(shared) - do j=js,je - call calculate_density(tv%T(:,j,1), tv%S(:,j,1), p_ref_cv, Rcv_ml(:,j), & - is, ie-is+1, tv%eqn_of_state) - enddo - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp, Rcv_ml) - else - call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) - endif + call apply_sponge(h, dt, G, GV, ea, eb, CS%sponge_CSp) endif call cpu_clock_end(id_clock_sponge) if (CS%debug) then @@ -2238,118 +2757,85 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en call create_group_pass(CS%pass_hold_eb_ea, eb, G%Domain, dir_flag, halo=1) call create_group_pass(CS%pass_hold_eb_ea, ea, G%Domain, dir_flag, halo=1) call do_group_pass(CS%pass_hold_eb_ea, G%Domain) - ! visc%Kv_shear is not in the group pass because it has larger vertical extent. - if (associated(visc%Kv_shear)) & - call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) - if (.not. CS%useALEalgorithm) then - ! Use a tridiagonal solver to determine effect of the diapycnal - ! advection on velocity field. It is assumed that water leaves - ! or enters the ocean with the surface velocity. - if (CS%debug) then - call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) - call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) - endif - call cpu_clock_begin(id_clock_tridiag) - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do j=js,je + ! Use a tridiagonal solver to determine effect of the diapycnal + ! advection on velocity field. It is assumed that water leaves + ! or enters the ocean with the surface velocity. + if (CS%debug) then + call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, haloshift=0) + call hchksum(ea, "before u/v tridiag ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before u/v tridiag eb",G%HI, scale=GV%H_to_m) + call hchksum(hold, "before u/v tridiag hold",G%HI, scale=GV%H_to_m) + endif + call cpu_clock_begin(id_clock_tridiag) + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do j=js,je + do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) + hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect + b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) + d1(I) = hval * b1(I) + u(I,j,1) = b1(I) * (hval * u(I,j,1)) + enddo + do k=2,nz ; do I=Isq,Ieq + if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) + c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) + eaval = ea(i,j,k) + ea(i+1,j,k) + hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect + b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) + d1(I) = (hval + d1(I)*eaval) * b1(I) + u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) + enddo ; enddo + do k=nz-1,1,-1 ; do I=Isq,Ieq + u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) + if (associated(ADp%du_dt_dia)) & + ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt + enddo ; enddo + if (associated(ADp%du_dt_dia)) then do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,1) = u(I,j,1) - hval = (hold(i,j,1) + hold(i+1,j,1)) + (ea(i,j,1) + ea(i+1,j,1)) + h_neglect - b1(I) = 1.0 / (hval + (eb(i,j,1) + eb(i+1,j,1))) - d1(I) = hval * b1(I) - u(I,j,1) = b1(I) * (hval * u(I,j,1)) + ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt enddo - do k=2,nz ; do I=Isq,Ieq - if (associated(ADp%du_dt_dia)) ADp%du_dt_dia(I,j,k) = u(I,j,k) - c1(I,k) = (eb(i,j,k-1)+eb(i+1,j,k-1)) * b1(I) - eaval = ea(i,j,k) + ea(i+1,j,k) - hval = hold(i,j,k) + hold(i+1,j,k) + h_neglect - b1(I) = 1.0 / ((eb(i,j,k) + eb(i+1,j,k)) + (hval + d1(I)*eaval)) - d1(I) = (hval + d1(I)*eaval) * b1(I) - u(I,j,k) = (hval*u(I,j,k) + eaval*u(I,j,k-1))*b1(I) - enddo ; enddo - do k=nz-1,1,-1 ; do I=Isq,Ieq - u(I,j,k) = u(I,j,k) + c1(I,k+1)*u(I,j,k+1) - if (associated(ADp%du_dt_dia)) & - ADp%du_dt_dia(I,j,k) = (u(I,j,k) - ADp%du_dt_dia(I,j,k)) * Idt - enddo ; enddo - if (associated(ADp%du_dt_dia)) then - do I=Isq,Ieq - ADp%du_dt_dia(I,j,nz) = (u(I,j,nz)-ADp%du_dt_dia(I,j,nz)) * Idt - enddo - endif - enddo - if (CS%debug) then - call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) endif - !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) - do J=Jsq,Jeq + enddo + if (CS%debug) then + call MOM_state_chksum("aft 1st loop tridiag ", u, v, h, G, GV, haloshift=0) + endif + !$OMP parallel do default(shared) private(hval,b1,d1,c1,eaval) + do J=Jsq,Jeq + do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) + hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect + b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) + d1(I) = hval * b1(I) + v(i,J,1) = b1(i) * (hval * v(i,J,1)) + enddo + do k=2,nz ; do i=is,ie + if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) + c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) + eaval = ea(i,j,k) + ea(i,j+1,k) + hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect + b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) + d1(i) = (hval + d1(i)*eaval) * b1(i) + v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) + enddo ; enddo + do k=nz-1,1,-1 ; do i=is,ie + v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) + if (associated(ADp%dv_dt_dia)) & + ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt + enddo ; enddo + if (associated(ADp%dv_dt_dia)) then do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,1) = v(i,J,1) - hval = (hold(i,j,1) + hold(i,j+1,1)) + (ea(i,j,1) + ea(i,j+1,1)) + h_neglect - b1(i) = 1.0 / (hval + (eb(i,j,1) + eb(i,j+1,1))) - d1(I) = hval * b1(I) - v(i,J,1) = b1(i) * (hval * v(i,J,1)) + ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt enddo - do k=2,nz ; do i=is,ie - if (associated(ADp%dv_dt_dia)) ADp%dv_dt_dia(i,J,k) = v(i,J,k) - c1(i,k) = (eb(i,j,k-1)+eb(i,j+1,k-1)) * b1(i) - eaval = ea(i,j,k) + ea(i,j+1,k) - hval = hold(i,j,k) + hold(i,j+1,k) + h_neglect - b1(i) = 1.0 / ((eb(i,j,k) + eb(i,j+1,k)) + (hval + d1(i)*eaval)) - d1(i) = (hval + d1(i)*eaval) * b1(i) - v(i,J,k) = (hval*v(i,J,k) + eaval*v(i,J,k-1))*b1(i) - enddo ; enddo - do k=nz-1,1,-1 ; do i=is,ie - v(i,J,k) = v(i,J,k) + c1(i,k+1)*v(i,J,k+1) - if (associated(ADp%dv_dt_dia)) & - ADp%dv_dt_dia(i,J,k) = (v(i,J,k) - ADp%dv_dt_dia(i,J,k)) * Idt - enddo ; enddo - if (associated(ADp%dv_dt_dia)) then - do i=is,ie - ADp%dv_dt_dia(i,J,nz) = (v(i,J,nz)-ADp%dv_dt_dia(i,J,nz)) * Idt - enddo - endif - enddo - call cpu_clock_end(id_clock_tridiag) - if (CS%debug) then - call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) endif - endif ! useALEalgorithm + enddo + call cpu_clock_end(id_clock_tridiag) + if (CS%debug) then + call MOM_state_chksum("after u/v tridiag ", u, v, h, G, GV, haloshift=0) + endif call disable_averaging(CS%diag) - ! Frazil formation keeps temperature above the freezing point. - ! make_frazil is deliberately called at both the beginning and at - ! the end of the diabatic processes. - if (associated(tv%T) .AND. associated(tv%frazil)) then - call enable_averaging(0.5*dt, Time_end, CS%diag) - if (CS%frazil_tendency_diag) then - do k=1,nz ; do j=js,je ; do i=is,ie - temp_diag(i,j,k) = tv%T(i,j,k) - enddo ; enddo ; enddo - endif - - if (associated(fluxes%p_surf_full)) then - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp, fluxes%p_surf_full) - else - call make_frazil(h, tv, G, GV, CS%diabatic_aux_CSp) - endif - - if (CS%frazil_tendency_diag) then - call diagnose_frazil_tendency(tv, h, temp_diag, 0.5*dt, G, GV, CS) - if (CS%id_frazil_h > 0 ) call post_data(CS%id_frazil_h, h, CS%diag) - endif - - if (showCallTree) call callTree_waypoint("done with 2nd make_frazil (diabatic)") - if (CS%debugConservation) call MOM_state_stats('2nd make_frazil', u, v, h, tv%T, tv%S, G) - call disable_averaging(CS%diag) - - endif ! endif for frazil - ! Diagnose the diapycnal diffusivities and other related quantities. call enable_averaging(dt, Time_end, CS%diag) @@ -2365,39 +2851,21 @@ subroutine legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_en if (CS%id_dvdt_dia > 0) call post_data(CS%id_dvdt_dia, ADp%dv_dt_dia, CS%diag) if (CS%id_wd > 0) call post_data(CS%id_wd, CDp%diapyc_vel, CS%diag) - if (CS%id_MLD_003 > 0 .or. CS%id_subMLN2 > 0 .or. CS%id_mlotstsq > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_003, h, tv, 0.03, G, GV, US, CS%diag, & - id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq, dz_subML=CS%dz_subML_N2) - endif - if (CS%id_MLD_0125 > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, US, CS%diag) - endif - if (CS%id_MLD_user > 0) then - call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, US, CS%diag) - endif - if (CS%id_Tdif > 0) call post_data(CS%id_Tdif, Tdif_flx, CS%diag) if (CS%id_Tadv > 0) call post_data(CS%id_Tadv, Tadv_flx, CS%diag) if (CS%id_Sdif > 0) call post_data(CS%id_Sdif, Sdif_flx, CS%diag) if (CS%id_Sadv > 0) call post_data(CS%id_Sadv, Sadv_flx, CS%diag) - if (CS%use_int_tides) then - if (CS%id_cg1 > 0) call post_data(CS%id_cg1, cn(:,:,1),CS%diag) - do m=1,CS%nMode - if (CS%id_cn(m) > 0) call post_data(CS%id_cn(m),cn(:,:,m),CS%diag) - enddo - endif call disable_averaging(CS%diag) - if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) - if (showCallTree) call callTree_leave("diabatic()") + if (showCallTree) call callTree_leave("layered_diabatic()") -end subroutine legacy_diabatic +end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & - evap_CFL_limit, minimum_forcing_depth) + evap_CFL_limit, minimum_forcing_depth, diabatic_aux_CSp) type(diabatic_CS), intent(in ) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure @@ -2406,10 +2874,13 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, & !! evaporated in one time-step [nondim]. real, optional, intent( out) :: minimum_forcing_depth !< The smallest depth over which heat !! and freshwater fluxes are applied [m]. + type(diabatic_aux_CS), optional, pointer :: diabatic_aux_CSp !< A pointer to be set to the diabatic_aux + !! control structure ! Pointers to control structures if (present(opacity_CSp)) opacity_CSp => CS%opacity_CSp if (present(optics_CSp)) optics_CSp => CS%optics + if (present(diabatic_aux_CSp)) diabatic_aux_CSp => CS%diabatic_aux_CSp ! Constants within diabatic_CS if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit @@ -2757,6 +3228,10 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Set default, read and log parameters call log_version(param_file, mdl, version, & "The following parameters are used for diabatic processes.") + call get_param(param_file, mdl, "USE_LEGACY_DIABATIC_DRIVER", CS%use_legacy_diabatic, & + "If true, use a legacy version of the diabatic subroutine. "//& + "This is temporary and is needed to avoid change in answers.", & + default=.true.) call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. "//& "The exact location and properties of those sponges are "//& @@ -2811,33 +3286,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "equations for the internal tide energy density.", default=.false.) CS%nMode = 1 if (CS%use_int_tides) then - ! SET NUMBER OF MODES TO CONSIDER call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", CS%nMode, & "The number of distinct internal tide modes "//& "that will be calculated.", default=1, do_not_log=.true.) - - ! The following parameters are used in testing the internal tide code. - ! GET LOCATION AND DURATION OF ENERGY POINT SOURCE FOR TESTING (BDM) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & - "If true, apply an arbitrary generation site for internal tide testing", & - default=.false.) - if (CS%int_tide_source_test)then - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & - "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & - "Y Location of generation site for internal tide", default=1.) - call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", CS%tlen_days, & - "Time interval from start of experiment for adding wave source", & - units="days", default=0) - CS%time_max_source = increment_time(Time,0,days=CS%tlen_days) - endif - ! GET UNIFORM MODE VELOCITY FOR TESTING (BDM) - call get_param(param_file, mdl, "UNIFORM_CG", CS%uniform_cg, & - "If true, set cg = cg_test everywhere for test case", default=.false.) - if (CS%uniform_cg)then - call get_param(param_file, mdl, "CG_TEST", CS%cg_test, & - "Uniform group velocity of internal tide for test case", default=1.) - endif + call get_param(param_file, mdl, "UNIFORM_TEST_CG", CS%uniform_test_cg, & + "If positive, a uniform group velocity of internal tide for test case", & + default=-1., units="m s-1") endif call get_param(param_file, mdl, "MASSLESS_MATCH_TARGETS", & @@ -2874,12 +3328,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "KD_MIN_TR", CS%Kd_min_tr, & "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& - "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m_to_Z**2) + "The default is 0.1*KD.", units="m2 s-1", default=0.1*Kd, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//& - "over the same distance.", units="m2 s-1", default=0., scale=US%m_to_Z**2) + "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T) endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -2962,7 +3416,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%id_MLD_0125 = register_diag_field('ocean_model','MLD_0125',diag%axesT1,Time, & 'Mixed layer depth (delta rho = 0.125)', 'm', conversion=US%Z_to_m) CS%id_subMLN2 = register_diag_field('ocean_model','subML_N2',diag%axesT1,Time, & - 'Squared buoyancy frequency below mixed layer', 's-2') + 'Squared buoyancy frequency below mixed layer', 's-2', conversion=US%s_to_T**2) CS%id_MLD_user = register_diag_field('ocean_model','MLD_user',diag%axesT1,Time, & 'Mixed layer depth (used defined)', 'm', conversion=US%Z_to_m) endif @@ -3001,16 +3455,16 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z_to_m**2) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z_to_m**2, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') @@ -3272,11 +3726,9 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call get_param(param_file, mdl, "PEN_SW_NBANDS", nbands, default=1) if (nbands > 0) then allocate(CS%optics) - call opacity_init(Time, G, param_file, diag, CS%tracer_flow_CSp, CS%opacity_CSp, CS%optics) + call opacity_init(Time, G, GV, US, param_file, diag, CS%opacity_CSp, CS%optics) endif endif - CS%nsw = 0 - if (associated(CS%optics)) CS%nsw = CS%optics%nbands ! Initialize the diagnostic grid storage call diag_grid_storage_init(CS%diag_grids_prev, G, diag) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 3d9fb3c6c7..cd7723f4fa 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -55,17 +55,17 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. !! Absent fields have NULL ptrs. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 s-1 ~> m2 s-1]. + optional, intent(in) :: Kd_int !< Interface diffusivities [Z2 T-1 ~> m2 s-1]. ! Local variables real, dimension(GV%ke) :: & T0, S0, & ! T0 & S0 are columns of initial temperatures and salinities [degC] and g/kg. h_col ! h_col is a column of thicknesses h at tracer points [H ~> m or kg m-2]. real, dimension(GV%ke+1) :: & - Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 s-1 ~> m2 s-1]. + Kd, & ! A column of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1]. h_top, h_bot ! Distances from the top or bottom [H ~> m or kg m-2]. real :: ustar, absf, htot real :: energy_Kd ! The energy used by diapycnal mixing [W m-2]. @@ -94,8 +94,8 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) h_bot(K) = h_bot(K+1) + h_col(k) enddo - ustar = 0.01*US%m_to_Z ! Change this to being an input parameter? - absf = 0.25*US%s_to_T*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & + ustar = 0.01*US%m_to_Z*US%T_to_s ! Change this to being an input parameter? + absf = 0.25*((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J)))) Kd(1) = 0.0 ; Kd(nz+1) = 0.0 do K=2,nz @@ -127,8 +127,8 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures [degC]. real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities [ppt]. real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities - !! [Z2 s-1 ~> m2 s-1]. - real, intent(in) :: dt !< The amount of time covered by this call [s]. + !! [Z2 T-1 ~> m2 s-1]. + real, intent(in) :: dt !< The amount of time covered by this call [T ~> s]. real, intent(out) :: energy_Kd !< The column-integrated rate of energy !! consumption by diapycnal diffusion [W m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any @@ -199,7 +199,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. z_Int, & ! Interface heights relative to the surface [H ~> m or kg m-2]. - N2, & ! An estimate of the buoyancy frequency [s-2]. + N2, & ! An estimate of the buoyancy frequency [T-2 ~> s-2]. Kddt_h, & ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. Kddt_h_a, & ! The value of Kddt_h for layers above the central point in the @@ -941,7 +941,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(T0(k-1) + T0(k)), 0.5*(S0(k-1) + S0(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (T0(k-1) - T0(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (S0(k-1) - S0(k)) ) enddo @@ -952,7 +952,7 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do K=2,nz call calculate_density(0.5*(Tf(k-1) + Tf(k)), 0.5*(Sf(k-1) + Sf(k)), & pres(K), rho_here, tv%eqn_of_state) - N2(K) = ((GV%g_Earth*US%m_to_Z**2) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & + N2(K) = ((US%L_to_Z**2*GV%LZT_g_Earth) * rho_here / (0.5*GV%H_to_Z*(h_tr(k-1) + h_tr(k)))) * & ( 0.5*(dSV_dT(k-1) + dSV_dT(k)) * (Tf(k-1) - Tf(k)) + & 0.5*(dSV_dS(k-1) + dSV_dS(k)) * (Sf(k-1) - Sf(k)) ) enddo @@ -1334,9 +1334,9 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) CS%id_Sf = register_diag_field('ocean_model', 'EnReqTest_Sf', diag%axesZL, Time, & "Salinity after mixing", "g kg-1") CS%id_N2_0 = register_diag_field('ocean_model', 'EnReqTest_N2_0', diag%axesZi, Time, & - "Squared buoyancy frequency before mixing", "second-2") + "Squared buoyancy frequency before mixing", "second-2", conversion=US%s_to_T**2) CS%id_N2_f = register_diag_field('ocean_model', 'EnReqTest_N2_f', diag%axesZi, Time, & - "Squared buoyancy frequency after mixing", "second-2") + "Squared buoyancy frequency after mixing", "second-2", conversion=US%s_to_T**2) end subroutine diapyc_energy_req_init diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index e4b294d3d8..64d90e02ff 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -7,10 +7,11 @@ module MOM_energetic_PBL use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_alloc use MOM_diag_mediator, only : time_type, diag_ctrl use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_error_handler, only : MOM_error, FATAL, WARNING +use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -32,41 +33,38 @@ module MOM_energetic_PBL !> This control structure holds parameters for the MOM_energetic_PBL module type, public :: energetic_PBL_CS ; private - real :: mstar !< The ratio of the friction velocity cubed to the TKE available to - !! drive entrainment, nondimensional. This quantity is the vertically - !! integrated shear production minus the vertically integrated - !! dissipation of TKE produced by shear. + + !/ Constants + real :: VonKar = 0.41 !< The von Karman coefficient. This should be runtime, but because + !! it is runtime in KPP and set to 0.4 it might change answers. + real :: omega !< The Earth's rotation rate [T-1]. + real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of + !! the absolute rotation rate blended with the local value of f, as + !! sqrt((1-of)*f^2 + of*4*omega^2) [nondim]. + + !/ Convection related terms real :: nstar !< The fraction of the TKE input to the mixed layer available to drive !! entrainment [nondim]. This quantity is the vertically integrated !! buoyancy production minus the vertically integrated dissipation of !! TKE produced by buoyancy. + + !/ Mixing Length terms + logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. + logical :: Orig_MLD_iteration=.false. !< False to use old MLD value + logical :: MLD_iteration_guess=.false. !< False to default to guessing half the + !! ocean depth for the iteration. + integer :: max_MLD_its !< The maximum number of iterations that can be used to find a + !! self-consistent mixed layer depth with Use_MLD_iteration. real :: MixLenExponent !< Exponent in the mixing length shape-function. !! 1 is law-of-the-wall at top and bottom, !! 2 is more KPP like. - real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. real :: MKE_to_TKE_effic !< The efficiency with which mean kinetic energy released by !! mechanically forced entrainment of the mixed layer is converted to !! TKE [nondim]. -! real :: Hmix_min !< The minimum mixed layer thickness in m. - real :: ustar_min !< A minimum value of ustar to avoid numerical problems [m s-1]. + real :: ustar_min !< A minimum value of ustar to avoid numerical problems [Z T-1 ~> m s-1]. !! If the value is small enough, this should not affect the solution. - real :: omega !< The Earth's rotation rate [s-1]. - real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of - !! the absolute rotation rate blended with the local value of f, as - !! sqrt((1-of)*f^2 + of*4*omega^2). - real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released - !! energy is converted to a turbulent velocity, relative to - !! mechanically forced turbulent kinetic energy [nondim]. - !! Making this larger increases the diffusivity. - integer :: vstar_mode !< An integer marking the chosen method for finding vstar. - !! vstar = 0 is the original (TKE_remaining)^1/3 - !! vstar = 1 is the version described by Reichl and Hallberg, 2018 - real :: vstar_surf_fac !< If (vstar == 1) this is the proportionality coefficient between - !! ustar and the surface mechanical contribution to vstar - real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit - !! conversion factor. Making this larger increases the diffusivity. real :: Ekman_scale_coef !< A nondimensional scaling factor controlling the inhibition of the - !! diffusive length scale by rotation. Making this larger decreases + !! diffusive length scale by rotation. Making this larger decreases !! the diffusivity in the planetary boundary layer. real :: transLay_scale !< A scale for the mixing length in the transition layer !! at the edge of the boundary layer as a fraction of the @@ -76,60 +74,69 @@ module MOM_energetic_PBL !! Use_MLD_iteration is true [Z ~> m]. real :: min_mix_len !< The minimum mixing length scale that will be used by ePBL [Z ~> m]. !! The default (0) does not set a minimum. - real :: N2_Dissipation_Scale_Neg !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of negative (unstable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. - real :: N2_Dissipation_Scale_Pos !< A nondimensional scaling factor controlling the loss of TKE - !! due to enhanced dissipation in the presence of positive (stable) - !! local stratification. This dissipation is applied to the available - !! TKE which includes both that generated at the surface and that - !! generated at depth. - !MSTAR related options - real :: MSTAR_CAP !< Since MSTAR is restoring undissipated energy to mixing, + + !/ Velocity scale terms + integer :: wT_scheme !< An enumerated value indicating the method for finding the turbulent + !! velocity scale. There are currently two options: + !! wT_mwT_from_cRoot_TKE is the original (TKE_remaining)^1/3 + !! wT_from_RH18 is the version described by Reichl and Hallberg, 2018 + real :: wstar_ustar_coef !< A ratio relating the efficiency with which convectively released + !! energy is converted to a turbulent velocity, relative to + !! mechanically forced turbulent kinetic energy [nondim]. + !! Making this larger increases the diffusivity. + real :: vstar_surf_fac !< If (wT_scheme == wT_from_RH18) this is the proportionality coefficient between + !! ustar and the surface mechanical contribution to vstar [nondim] + real :: vstar_scale_fac !< An overall nondimensional scaling factor for vstar times a unit + !! conversion factor [Z s T-1 m-1 ~> nondim]. Making this larger increases + !! the diffusivity. + + !mstar related options + integer :: mstar_scheme !< An encoded integer to determine which formula is used to set mstar + logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. + real :: mstar_cap !< Since MSTAR is restoring undissipated energy to mixing, !! there must be a cap on how large it can be. This !! is definitely a function of latitude (Ekman limit), !! but will be taken as constant for now. - real :: MSTAR_SLOPE !< Slope of the function which relates the shear production to the - !< mixing layer depth, Ekman depth, and Monin-Obukhov depth. - real :: MSTAR_XINT !< Value where MSTAR function transitions from linear - !! to decay toward MSTAR->0 at fully developed Ekman depth. - real :: MSTAR_XINT_UP !< Similar but for transition to asymptotic cap. - real :: MSTAR_AT_XINT !< Intercept value of MSTAR at value where function - !! changes to linear transition. - real :: RH18_mst_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). + + !/ vertical decay related options + real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE decay scale [nondim]. + + !/ mstar_scheme == 0 + real :: fixed_mstar !< Mstar is the ratio of the friction velocity cubed to the TKE available to + !! drive entrainment, nondimensional. This quantity is the vertically + !! integrated shear production minus the vertically integrated + !! dissipation of TKE produced by shear. This value is used if the option + !! for using a fixed mstar is used. + + !/ mstar_scheme == 2 + real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_scheme=OM4 + real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_scheme=OM4 + + !/ mstar_scheme == 3 + real :: RH18_mstar_cN1 !< MSTAR_N coefficient 1 (outter-most coefficient for fit). !! Value of 0.275 in RH18. Increasing this !! coefficient increases mechanical mixing for all values of Hf/ust, !! but is most effective at low values (weakly developed OSBLs). - real :: RH18_mst_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). + real :: RH18_mstar_cN2 !< MSTAR_N coefficient 2 (coefficient outside of exponential decay). !! Value of 8.0 in RH18. Increasing this coefficient increases MSTAR !! for all values of HF/ust, with a consistent affect across !! a wide range of Hf/ust. - real :: RH18_mst_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of + real :: RH18_mstar_cN3 !< MSTAR_N coefficient 3 (exponential decay coefficient). Value of !! -5.0 in RH18. Increasing this increases how quickly the value !! of MSTAR decreases as Hf/ust increases. - real :: RH18_mst_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. + real :: RH18_mstar_cS1 !< MSTAR_S coefficient for RH18 in stabilizing limit. !! Value of 0.2 in RH18. - real :: RH18_mst_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. + real :: RH18_mstar_cS2 !< MSTAR_S exponent for RH18 in stabilizing limit. !! Value of 0.4 in RH18. - real :: MSTAR_N = -2. !< Exponent in decay at negative and positive limits of MLD_over_STAB - real :: MSTAR_A !< Coefficients of expressions for mstar in asymptotic limits, computed - !! to match the function value and slope at both ends of the linear fit - !! within the well constrained region. - real :: MSTAR_A2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B !< Coefficients of expressions for mstar in asymptotic limits. - real :: MSTAR_B2 !< Coefficients of expressions for mstar in asymptotic limits. - real :: C_EK = 0.17 !< MSTAR Coefficient in rotation limit for mstar_mode=2 - real :: MSTAR_COEF = 0.3 !< MSTAR coefficient in rotation/stabilizing balance for mstar_mode=2 - !Langmuir turbulence related parameters + + !/ Coefficient for shear/convective turbulence interaction + real :: mstar_convect_coef !< Factor to reduce mstar when statically unstable. + + !/ Langmuir turbulence related parameters + logical :: Use_LT = .false. !< Flag for using LT in Energy calculation integer :: LT_ENHANCE_FORM !< Integer for Enhancement functional form (various options) real :: LT_ENHANCE_COEF !< Coefficient in fit for Langmuir Enhancment real :: LT_ENHANCE_EXP !< Exponent in fit for Langmuir Enhancement - logical :: LT_ENH_K_R16 !< Logical to toggle enhanced local mixing coefficient due to Langmuir - !! following Reichl et al., 2016. This setting is unverified - !! outside of strongly shear-forced shear turbulence and therefore - !! it is not recommended to employ this option for general use. real :: LaC_MLDoEK !< Coefficient for Langmuir number modification based on the ratio of !! the mixed layer depth over the Ekman depth. real :: LaC_MLDoOB_stab !< Coefficient for Langmuir number modification based on the ratio of @@ -141,69 +148,90 @@ module MOM_energetic_PBL real :: LaC_EKoOB_un !< Coefficient for Langmuir number modification based on the ratio of !! the Ekman depth over the Obukov depth with destablizing forcing. real :: Max_Enhance_M = 5. !< The maximum allowed LT enhancement to the mixing. - real :: CNV_MST_FAC !< Factor to reduce mstar when statically unstable. + + !/ Others type(time_type), pointer :: Time=>NULL() !< A pointer to the ocean model's clock. - integer :: MSTAR_MODE = 0 !< An coded integer to determine which formula is used to set mstar - integer :: CONST_MSTAR=0 !< The value of MSTAR_MODE to use a constant mstar - integer :: MLD_o_OBUKHOV=1 !< The value of MSTAR_MODE to base mstar on the ratio of the mixed - !! layer depth to the Obukhov depth - integer :: EKMAN_o_OBUKHOV=2 !< The value of MSTAR_MODE to base mstar on the ratio of the Ekman - !! layer depth to the Obukhov depth - integer :: MSTAR_RH18 = 3 !< The value of MSTAR_MODE to base mstar off of RH18 - logical :: MSTAR_FLATCAP=.true. !< Set false to use asymptotic mstar cap. logical :: TKE_diagnostics = .false. !< If true, diagnostics of the TKE budget are being calculated. - logical :: Use_LT = .false. !< Flag for using LT in Energy calculation - logical :: orig_PE_calc = .true. !< If true, the ePBL code uses the original form of the + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + logical :: orig_PE_calc !< If true, the ePBL code uses the original form of the !! potential energy change code. Otherwise, it uses a newer version !! that can work with successive increments to the diffusivity in !! upward or downward passes. - logical :: Use_MLD_iteration=.false. !< False to use old ePBL method. - logical :: Orig_MLD_iteration=.false. !< False to use old MLD value - logical :: MLD_iteration_guess=.false. !< False to default to guessing half the - !! ocean depth for the iteration. - logical :: Mixing_Diagnostics = .false. !< Will be true when outputting mixing - !! length and velocity scales - logical :: MSTAR_Diagnostics=.false. !< If true, utput diagnostics of the mstar calculation. type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - ! These are terms in the mixed layer TKE budget, all in [J m-2] = [kg s-2]. real, allocatable, dimension(:,:) :: & - diag_TKE_wind, & !< The wind source of TKE [J m-2]. - diag_TKE_MKE, & !< The resolved KE source of TKE [J m-2]. - diag_TKE_conv, & !< The convective source of TKE [J m-2]. - diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating [J m-2]. - diag_TKE_mech_decay, & !< The decay of mechanical TKE [J m-2]. - diag_TKE_conv_decay, & !< The decay of convective TKE [J m-2]. - diag_TKE_mixing,& !< The work done by TKE to deepen the mixed layer [J m-2]. - ! Additional output parameters also 2d - ML_depth, & !< The mixed layer depth [Z ~> m]. (result after iteration step) - ML_depth2, & !< The mixed layer depth [Z ~> m]. (guess for iteration step) - Enhance_M, & !< The enhancement to the turbulent velocity scale [nondim] + ML_depth !< The mixed layer depth determined by active mixing in ePBL [Z ~> m]. + + ! These are terms in the mixed layer TKE budget, all in [kg m-3 Z3 T-2 ~> J m-2] = [kg s-2]. + real, allocatable, dimension(:,:) :: & + diag_TKE_wind, & !< The wind source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_MKE, & !< The resolved KE source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv, & !< The convective source of TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_forcing, & !< The TKE sink required to mix surface penetrating shortwave heating + !! [kg m-3 Z3 T-2 ~> W m-2]. + diag_TKE_mech_decay, & !< The decay of mechanical TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_conv_decay, & !< The decay of convective TKE [kg m-3 Z3 T-3 ~> W m-2]. + diag_TKE_mixing, & !< The work done by TKE to deepen the mixed layer [kg m-3 Z3 T-3 ~> W m-2]. + ! These additional diagnostics are also 2d. MSTAR_MIX, & !< Mstar used in EPBL [nondim] - MSTAR_LT, & !< Mstar for Langmuir turbulence [nondim] - MLD_EKMAN, & !< MLD over Ekman length [nondim] - MLD_OBUKHOV, & !< MLD over Obukhov length [nondim] - EKMAN_OBUKHOV, & !< Ekman over Obukhov length [nondim] + MSTAR_LT, & !< Mstar due to Langmuir turbulence [nondim] LA, & !< Langmuir number [nondim] LA_MOD !< Modified Langmuir number [nondim] real, allocatable, dimension(:,:,:) :: & - Velocity_Scale, & !< The velocity scale used in getting Kd [Z s-1 ~> m s-1] + Velocity_Scale, & !< The velocity scale used in getting Kd [Z T-1 ~> m s-1] Mixing_Length !< The length scale used in getting Kd [Z ~> m] !>@{ Diagnostic IDs integer :: id_ML_depth = -1, id_TKE_wind = -1, id_TKE_mixing = -1 integer :: id_TKE_MKE = -1, id_TKE_conv = -1, id_TKE_forcing = -1 integer :: id_TKE_mech_decay = -1, id_TKE_conv_decay = -1 - integer :: id_Hsfc_used = -1 integer :: id_Mixing_Length = -1, id_Velocity_Scale = -1 - integer :: id_OSBL = -1, id_LT_Enhancement = -1, id_MSTAR_mix = -1 - integer :: id_mld_ekman = -1, id_mld_obukhov = -1, id_ekman_obukhov = -1 - integer :: id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 + integer :: id_MSTAR_mix = -1, id_LA_mod = -1, id_LA = -1, id_MSTAR_LT = -1 !!@} end type energetic_PBL_CS +!>@{ Enumeration values for mstar_Scheme +integer, parameter :: Use_Fixed_MStar = 0 !< The value of mstar_scheme to use a constant mstar +integer, parameter :: MStar_from_Ekman = 2 !< The value of mstar_scheme to base mstar on the ratio + !! of the Ekman layer depth to the Obukhov depth +integer, parameter :: MStar_from_RH18 = 3 !< The value of mstar_scheme to base mstar of of RH18 +integer, parameter :: No_Langmuir = 0 !< The value of LT_ENHANCE_FORM not use Langmuir turbolence. +integer, parameter :: Langmuir_rescale = 2 !< The value of LT_ENHANCE_FORM to use a multiplicative + !! rescaling of mstar to account for Langmuir turbulence. +integer, parameter :: Langmuir_add = 3 !< The value of LT_ENHANCE_FORM to add a contribution to + !! mstar from Langmuir turblence to other contributions. +integer, parameter :: wT_from_cRoot_TKE = 0 !< Use a constant times the cube root of remaining TKE + !! to calculate the turbulent velocity. +integer, parameter :: wT_from_RH18 = 1 !< Use a scheme based on a combination of w* and v* as + !! documented in Reichl & Hallberg (2018) to calculate + !! the turbulent velocity. +character*(20), parameter :: CONSTANT_STRING = "CONSTANT" +character*(20), parameter :: OM4_STRING = "OM4" +character*(20), parameter :: RH18_STRING = "REICHL_H18" +character*(20), parameter :: ROOT_TKE_STRING = "CUBE_ROOT_TKE" +character*(20), parameter :: NONE_STRING = "NONE" +character*(20), parameter :: RESCALED_STRING = "RESCALE" +character*(20), parameter :: ADDITIVE_STRING = "ADDITIVE" +!!@} + +!> A type for conveniently passing around ePBL diagnostics for a column. +type, public :: ePBL_column_diags ; private + !>@{ Local column copies of energy change diagnostics, all in [kg m-3 Z3 T-3 ~> W m-2]. + real :: dTKE_conv, dTKE_forcing, dTKE_wind, dTKE_mixing + real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay + !!@} + real :: LA !< The value of the Langmuir number [nondim] + real :: LAmod !< The modified Langmuir number by convection [nondim] + real :: mstar !< The value of mstar used in ePBL [nondim] + real :: mstar_LT !< The portion of mstar due to Langmuir turbulence [nondim] + real, allocatable, dimension(:) :: dT_expect !< Expected temperature changes [degC] + real, allocatable, dimension(:) :: dS_expect !< Expected salinity changes [ppt] +end type ePBL_column_diags + contains !> This subroutine determines the diffusivities from the integrated energetics @@ -211,8 +239,8 @@ module MOM_energetic_PBL !! have already been applied. All calculations are done implicitly, and there !! is no stability limit on the time step. subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS, & - dSV_dT, dSV_dS, TKE_forced, Buoy_Flux, dt_diag, last_call, & - dT_expected, dS_expected, waves ) + dSV_dT, dSV_dS, TKE_forced, buoy_flux, dt_diag, last_call, & + dT_expected, dS_expected, Waves ) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -234,24 +262,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: TKE_forced !< The forcing requirements to homogenize the !! forcing that has been applied to each layer - !! through each layer [J m-2]. + !! [kg m-3 Z3 T-2 ~> J m-2]. type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields have !! NULL ptrs. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces !! [Z2 s-1 ~> m2 s-1]. type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous !! call to mixedlayer_init. real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: Buoy_Flux !< The surface buoyancy flux [Z2 s-3 ~> m2 s-3]. + intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less - !! than dt if there are two callse to - !! mixedlayer [s]. + !! than dt if there are two calls to mixedlayer [T ~> s]. logical, optional, intent(in) :: last_call !< If true, this is the last call to !! mixedlayer in the current time step, so !! diagnostics will be written. The default @@ -281,63 +308,336 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing. ! ! The key parameters for the mixed layer are found in the control structure. -! These include mstar, nstar, TKE_decay, and conv_decay. For the Oberhuber (1993) mixed layer, -! the values of these are: +! To use the classic constant mstar mixied layers choose MSTAR_SCHEME=CONSTANT. +! The key parameters then include mstar, nstar, TKE_decay, and conv_decay. +! For the Oberhuber (1993) mixed layer,the values of these are: ! mstar = 1.25, nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 -! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while -! conv_decay is 1/mu. -! For a traditional Kraus-Turner mixed layer, the values are: +! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. +! For a traditional Kraus-Turner mixed layer, the values are: ! mstar = 1.25, nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & - h, & ! The layer thickness [H ~> m or kg m-2]. - T, & ! The layer temperatures [degC]. - S, & ! The layer salinities [ppt]. - u, & ! The zonal velocity [m s-1]. - v ! The meridional velocity [m s-1]. + h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. + T_2d, & ! A 2-d slice of the layer temperatures [degC]. + S_2d, & ! A 2-d slice of the layer salinities [ppt]. + TKE_forced_2d, & ! A 2-d slice of TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. + dSV_dT_2d, & ! A 2-d slice of dSV_dT [m3 kg-1 degC-1]. + dSV_dS_2d, & ! A 2-d slice of dSV_dS [m3 kg-1 ppt-1]. + u_2d, & ! A 2-d slice of the zonal velocity [m s-1]. + v_2d ! A 2-d slice of the meridional velocity [m s-1]. real, dimension(SZI_(G),SZK_(GV)+1) :: & - Kd, & ! The diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - pres, & ! Interface pressures [Pa]. + Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real, dimension(SZK_(GV)) :: & + h, & ! The layer thickness [H ~> m or kg m-2]. + T0, & ! The initial layer temperatures [degC]. + S0, & ! The initial layer salinities [ppt]. + dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [m3 kg-1 degC-1]. + dSV_dS_1d, & ! The partial derivatives of specific volume with salinity [m3 kg-1 ppt-1]. + TKE_forcing, & ! Forcing of the TKE in the layer coming from TKE_forced [kg m-3 Z3 T-2 ~> J m-2]. + u, & ! The zonal velocity [m s-1]. + v ! The meridional velocity [m s-1]. + real, dimension(SZK_(GV)+1) :: & + Kd, & ! The diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + mixvel, & ! A turbulent mixing veloxity [Z T-1 ~> m s-1]. + mixlen ! A turbulent mixing length [Z ~> m]. + 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 :: absf ! The absolute value of f [T-1]. + real :: U_star ! The surface friction velocity [Z T-1 ~> m s-1]. + real :: U_Star_Mean ! The surface friction without gustiness [Z T-1 ~> m s-1]. + real :: B_Flux ! The surface buoyancy flux [Z2 T-3 ~> m2 s-3] + real :: MLD_io ! The mixed layer depth found by ePBL_column [Z ~> m]. + +! The following are only used for diagnostics. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T ~> s]. + logical :: write_diags ! If true, write out diagnostics with this step. + logical :: reset_diags ! If true, zero out the accumulated diagnostics. + + logical :: debug=.false. ! Change this hard-coded value for debugging. + type(ePBL_column_diags) :: eCD ! A container for passing around diagnostics. + + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& + "Module must be initialized before it is used.") + + if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & + "energetic_PBL: Temperature, salinity and an equation of state "//& + "must now be used.") + if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & + "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") + debug = .false. ; if (present(dT_expected) .or. present(dS_expected)) debug = .true. + + if (debug) allocate(eCD%dT_expect(nz), eCD%dS_expect(nz)) + + h_neglect = GV%H_subroundoff + + dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag + write_diags = .true. ; if (present(last_call)) write_diags = last_call + + + ! Determine whether to zero out diagnostics before accumulation. + reset_diags = .true. + if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & + reset_diags = .false. ! This is the second call to mixedlayer. + + if (reset_diags) then + if (CS%TKE_diagnostics) then +!!OMP parallel do default(none) shared(is,ie,js,je,CS) + do j=js,je ; do i=is,ie + CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 + CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 + CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 + CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced(i,j) = 0.0 + enddo ; enddo + endif + endif + ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 + ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 + +!!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & +!!OMP CS,G,GV,US,fluxes,debug, & +!!OMP TKE_forced,dSV_dT,dSV_dS,Kd_int) + do j=js,je + ! Copy the thicknesses and other fields to 2-d arrays. + do k=1,nz ; do i=is,ie + h_2d(i,k) = h_3d(i,j,k) ; u_2d(i,k) = u_3d(i,j,k) ; v_2d(i,k) = v_3d(i,j,k) + T_2d(i,k) = tv%T(i,j,k) ; S_2d(i,k) = tv%S(i,j,k) + TKE_forced_2d(i,k) = TKE_forced(i,j,k) + dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) + enddo ; enddo + + ! Determine the initial mech_TKE and conv_PErel, including the energy required + ! to mix surface heating through the topmost cell, the energy released by mixing + ! surface cooling & brine rejection down through the topmost cell, and + ! homogenizing the shortwave heating within that cell. This sets the energy + ! and ustar and wstar available to drive mixing at the first interior + ! interface. + do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + + ! Copy the thicknesses and other fields to 1-d arrays. + do k=1,nz + h(k) = h_2d(i,k) + GV%H_subroundoff ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) + T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k) + dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k) + enddo + do K=1,nz+1 ; Kd(K) = 0.0 ; enddo + + ! Make local copies of surface forcing and process them. + u_star = fluxes%ustar(i,j) + u_star_Mean = fluxes%ustar_gustless(i,j) + B_flux = buoy_flux(i,j) + if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then + if (fluxes%frac_shelf_h(i,j) > 0.0) & + u_star = (1.0 - fluxes%frac_shelf_h(i,j)) * u_star + & + fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) + endif + if (u_star < CS%ustar_min) u_star = CS%ustar_min + if (CS%omega_frac >= 1.0) then + absf = 2.0*CS%omega + else + absf = 0.25*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & + (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) + if (CS%omega_frac > 0.0) & + absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) + endif + + ! Perhaps provide a first guess for MLD based on a stored previous value. + MLD_io = -1.0 + if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) + + call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & + US, CS, eCD, dt_diag=dt_diag, Waves=Waves, G=G, i=i, j=j) + + + ! Copy the diffusivities to a 2-d array. + do K=1,nz+1 + Kd_2d(i,K) = Kd(K) + enddo + CS%ML_depth(i,j) = MLD_io + + if (present(dT_expected)) then + do k=1,nz ; dT_expected(i,j,k) = eCD%dT_expect(k) ; enddo + endif + if (present(dS_expected)) then + do k=1,nz ; dS_expected(i,j,k) = eCD%dS_expect(k) ; enddo + endif + + if (CS%TKE_diagnostics) then + CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + eCD%dTKE_MKE + CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + eCD%dTKE_conv + CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + eCD%dTKE_forcing + CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + eCD%dTKE_wind + CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + eCD%dTKE_mixing + CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + eCD%dTKE_mech_decay + CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + eCD%dTKE_conv_decay + ! CS%diag_TKE_unbalanced(i,j) = CS%diag_TKE_unbalanced(i,j) + eCD%dTKE_unbalanced + endif + ! Write to 3-D for outputing Mixing length and velocity scale. + if (CS%id_Mixing_Length>0) then ; do k=1,nz + CS%Mixing_Length(i,j,k) = mixlen(k) + enddo ; endif + if (CS%id_Velocity_Scale>0) then ; do k=1,nz + CS%Velocity_Scale(i,j,k) = mixvel(k) + enddo ; endif + if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = eCD%mstar + if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = eCD%mstar_LT + if (allocated(CS%La)) CS%La(i,j) = eCD%LA + if (allocated(CS%La_mod)) CS%La_mod(i,j) = eCD%LAmod + else ! End of the ocean-point part of the i-loop + ! For masked points, Kd_int must still be set (to 0) because it has intent out. + do K=1,nz+1 ; Kd_2d(i,K) = 0. ; enddo + CS%ML_depth(i,j) = 0.0 + + if (present(dT_expected)) then + do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo + endif + if (present(dS_expected)) then + do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo + endif + endif ; enddo ! Close of i-loop - Note unusual loop order! + + do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo + + enddo ! j-loop + + if (write_diags) then + if (CS%id_ML_depth > 0) call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) + if (CS%id_TKE_wind > 0) call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) + if (CS%id_TKE_MKE > 0) call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) + if (CS%id_TKE_conv > 0) call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) + if (CS%id_TKE_forcing > 0) call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) + if (CS%id_TKE_mixing > 0) call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) + if (CS%id_TKE_mech_decay > 0) & + call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) + if (CS%id_TKE_conv_decay > 0) & + call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) + if (CS%id_Mixing_Length > 0) call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) + if (CS%id_Velocity_Scale >0) call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) + if (CS%id_MSTAR_MIX > 0) call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) + if (CS%id_LA > 0) call post_data(CS%id_LA, CS%LA, CS%diag) + if (CS%id_LA_MOD > 0) call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) + if (CS%id_MSTAR_LT > 0) call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + endif + + if (debug) deallocate(eCD%dT_expect, eCD%dS_expect) + +end subroutine energetic_PBL + + + +!> This subroutine determines the diffusivities from the integrated energetics +!! mixed layer model for a single column of water. +subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & + u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & + dt_diag, Waves, G, i, j) + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points + !! [m s-1]. + real, dimension(SZK_(GV)), intent(in) :: T0 !< The initial layer temperatures [degC]. + real, dimension(SZK_(GV)), intent(in) :: S0 !< The initial layer salinities [ppt]. + + real, dimension(SZK_(GV)), intent(in) :: dSV_dT !< The partial derivative of in-situ specific + !! volume with potential temperature + !! [m3 kg-1 degC-1]. + real, dimension(SZK_(GV)), intent(in) :: dSV_dS !< The partial derivative of in-situ specific + !! volume with salinity [m3 kg-1 ppt-1]. + real, dimension(SZK_(GV)), intent(in) :: TKE_forcing !< The forcing requirements to homogenize the + !! forcing that has been applied to each layer + !! [kg m-3 Z3 T-2 ~> J m-2]. + real, intent(in) :: B_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: absf !< The absolute value of the Coriolis parameter [T-1]. + real, intent(in) :: u_star !< The surface friction velocity [Z T-1 ~> m s-1]. + real, intent(in) :: u_star_mean !< The surface friction velocity without any + !! contribution from unresolved gustiness [Z T-1 ~> m s-1]. + real, intent(inout) :: MLD_io !< A first guess at the mixed layer depth on input, and + !! the calculated mixed layer depth on output [Z ~> m]. + real, intent(in) :: dt !< Time increment [T ~> s]. + real, dimension(SZK_(GV)+1), & + intent(out) :: Kd !< The diagnosed diffusivities at interfaces + !! [Z2 T-1 ~> m2 s-1]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixvel !< The mixing velocity scale used in Kd + !! [Z T-1 ~> m s-1]. + real, dimension(SZK_(GV)+1), & + intent(out) :: mixlen !< The mixing length scale used in Kd [Z ~> m]. + type(energetic_PBL_CS), pointer :: CS !< The control structure returned by a previous + !! call to mixedlayer_init. + type(ePBL_column_diags), intent(inout) :: eCD !< A container for passing around diagnostics. + real, optional, intent(in) :: dt_diag !< The diagnostic time step, which may be less + !! than dt if there are two calls to mixedlayer [T ~> s]. + type(wave_parameters_CS), & + optional, pointer :: Waves !< Wave CS for Langmuir turbulence + type(ocean_grid_type), & + optional, intent(inout) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: i !< The i-index to work on (used for Waves) + integer, optional, intent(in) :: j !< The i-index to work on (used for Waves) + +! This subroutine determines the diffusivities in a single column from the integrated energetics +! planetary boundary layer (ePBL) model. It assumes that heating, cooling and freshwater fluxes +! have already been applied. All calculations are done implicitly, and there +! is no stability limit on the time step. +! +! For each interior interface, first discard the TKE to account for mixing +! of shortwave radiation through the next denser cell. Next drive mixing based +! on the local? values of ustar + wstar, subject to available energy. This +! step sets the value of Kd(K). Any remaining energy is then subject to decay +! before being handed off to the next interface. mech_TKE and conv_PErel are treated +! separately for the purposes of decay, but are used proportionately to drive +! mixing. + + ! Local variables + real, dimension(SZK_(GV)+1) :: & pres_Z, & ! Interface pressures with a rescaling factor to convert interface height - ! movements into changes in column potential energy [J m-2 Z-1 ~> J m-3]. + ! movements into changes in column potential energy [kg m-3 Z2 T-2 ~> kg m-1 s-2]. hb_hs ! The distance from the bottom over the thickness of the ! water column [nondim]. - real, dimension(SZI_(G)) :: & - mech_TKE, & ! The mechanically generated turbulent kinetic energy - ! available for mixing over a time step [J m-2 = kg s-2]. - conv_PErel, & ! The potential energy that has been convectively released - ! during this timestep [J m-2 = kg s-2]. A portion nstar_FC + real :: mech_TKE ! The mechanically generated turbulent kinetic energy + ! available for mixing over a time step [kg m-3 Z3 T-2 ~> J m-2]. + real :: conv_PErel ! The potential energy that has been convectively released + ! during this timestep [kg m-3 Z3 T-2 ~> J m-2]. A portion nstar_FC ! of conv_PErel is available to drive mixing. - htot, & ! The total depth of the layers above an interface [H ~> m or kg m-2]. - uhtot, & ! The depth integrated zonal and meridional velocities in the - vhtot, & ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. - mech_TKE_top, & ! The value of mech_TKE at the top of the column [J m-2]. - conv_PErel_top, & ! The value of conv_PErel at the top of the column [J m-2]. - - Idecay_len_TKE, & ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. - h_sum, & ! The total thickness of the water column [H ~> m or kg m-2]. - absf ! The absolute value of f [s-1]. + real :: htot ! The total depth of the layers above an interface [H ~> m or kg m-2]. + real :: uhtot ! The depth integrated zonal and meridional velocities in the + real :: vhtot ! layers above [H m s-1 ~> m2 s-1 or kg m-1 s-1]. + real :: Idecay_len_TKE ! The inverse of a turbulence decay length scale [H-1 ~> m-1 or m2 kg-1]. + real :: h_sum ! The total thickness of the water column [H ~> m or kg m-2]. - - real, dimension(SZI_(G),SZK_(GV)) :: & - dT_to_dColHt, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt, & ! and salinity changes within a layer [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE, & ! and salinity changes within a layer, in [J m-2 degC-1] and [J m-2 ppt-1]. - dT_to_dColHt_a, & ! Partial derivatives of the total column height with the temperature - dS_to_dColHt_a, & ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water colun [Z degC-1 ~> m degC-1] and [Z ppt-1 ~> m ppt-1]. - dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature - dS_to_dPE_a ! and salinity changes within a layer, including the implicit effects - ! of mixing with layers higher in the water column, in - ! units of [J m-2 degC-1] and [J m-2 ppt-1]. real, dimension(SZK_(GV)) :: & - T0, S0, & ! Initial values of T and S in the column, in [degC] and [ppt]. - Te, Se, & ! Estimated final values of T and S in the column, in [degC] and [ppt]. + dT_to_dColHt, & ! Partial derivative of the total column height with the temperature changes + ! within a layer [Z degC-1 ~> m degC-1]. + dS_to_dColHt, & ! Partial derivative of the total column height with the salinity changes + ! within a layer [Z ppt-1 ~> m ppt-1]. + dT_to_dPE, & ! Partial derivatives of column potential energy with the temperature + ! changes within a layer, in [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE, & ! Partial derivatives of column potential energy with the salinity changes + ! within a layer, in [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. + dT_to_dColHt_a, & ! Partial derivative of the total column height with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z degC-1 ~> m degC-1]. + dS_to_dColHt_a, & ! Partial derivative of the total column height with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [Z ppt-1 ~> m ppt-1]. + dT_to_dPE_a, & ! Partial derivatives of column potential energy with the temperature changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. + dS_to_dPE_a, & ! Partial derivative of column potential energy with the salinity changes + ! within a layer, including the implicit effects of mixing with layers higher + ! in the water column [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. c1, & ! c1 is used by the tridiagonal solver [nondim]. - dTe, dSe ! Running (1-way) estimates of temperature and salinity change. - real, dimension(SZK_(GV)) :: & + Te, & ! Estimated final values of T in the column [degC]. + Se, & ! Estimated final values of S in the column [ppt]. + dTe, & ! Running (1-way) estimates of temperature change [degC]. + dSe, & ! Running (1-way) estimates of salinity change [ppt]. Th_a, & ! An effective temperature times a thickness in the layer above, including implicit ! mixing effects with other yet higher layers [degC H ~> degC m or degC kg m-2]. Sh_a, & ! An effective salinity times a thickness in the layer above, including implicit @@ -346,10 +646,6 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! mixing effects with other yet lower layers [degC H ~> degC m or degC kg m-2]. Sh_b ! An effective salinity times a thickness in the layer below, including implicit ! mixing effects with other yet lower layers [ppt H ~> ppt m or ppt kg m-2]. - real, dimension(SZI_(G)) :: & - hp_a ! An effective pivot thickness of the layer including the effects - ! of coupling with layers above [H ~> m or kg m-2]. This is the first term - ! in the denominator of b1 in a downward-oriented tridiagonal solver. real, dimension(SZK_(GV)+1) :: & MixLen_shape, & ! A nondimensional shape factor for the mixing length that ! gives it an appropriate assymptotic value at the bottom of @@ -357,20 +653,23 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kddt_h ! The diapycnal diffusivity times a timestep divided by the ! average thicknesses around a layer [H ~> m or kg m-2]. real :: b1 ! b1 is inverse of the pivot used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. + real :: hp_a ! An effective pivot thickness of the layer including the effects + ! of coupling with layers above [H ~> m or kg m-2]. This is the first term + ! in the denominator of b1 in a downward-oriented tridiagonal solver. 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 :: dMass ! The mass per unit area within a layer [kg m-2]. - real :: dPres ! The hydrostatic pressure change across a layer [Pa]. + real :: dMass ! The mass per unit area within a layer [Z kg m-3 ~> kg m-2]. + real :: dPres ! The hydrostatic pressure change across a layer [kg m-3 Z2 T-2 ~> kg m-1 s-2 = Pa]. real :: dMKE_max ! The maximum amount of mean kinetic energy that could be ! converted to turbulent kinetic energy if the velocity in ! the layer below an interface were homogenized with all of - ! the water above the interface [J m-2 = kg s-2]. + ! the water above the interface [kg m-3 Z3 T-2 ~> J m-2]. real :: MKE2_Hharm ! Twice the inverse of the harmonic mean of the thickness ! of a layer and the thickness of the water above, used in ! the MKE conversion equation [H-1 ~> m-1 or m2 kg-1]. real :: dt_h ! The timestep divided by the averages of the thicknesses around - ! a layer, times a thickness conversion factor [H s m-2 ~> s m-1 or kg s m-4]. + ! a layer, times a thickness conversion factor [H T m-2 ~> s m-1 or kg s m-4]. real :: h_bot ! The distance from the bottom [H ~> m or kg m-2]. real :: h_rsum ! The running sum of h from the top [Z ~> m]. real :: I_hs ! The inverse of h_sum [H-1 ~> m-1 or m2 kg-1]. @@ -381,22 +680,21 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: h_tt_min ! A surface roughness length [H ~> m or kg m-2]. real :: C1_3 ! = 1/3. - real :: vonKar ! The vonKarman constant. - real :: I_dtrho ! 1.0 / (dt * Rho0) in [m3 kg-1 s-1]. This is - ! used convert TKE back into ustar^3. - real :: U_star ! The surface friction velocity [Z s-1 ~> m s-1]. - real :: U_Star_Mean ! The surface friction without gustiness [Z s-1 ~> m s-1]. - real :: vstar ! An in-situ turbulent velocity [m s-1]. - real :: Enhance_M ! An enhancement factor for vstar, based here on Langmuir impact. - real :: LA ! The Langmuir number [nondim] - real :: LAmod ! A modified Langmuir number accounting for other parameters. + real :: I_dtrho ! 1.0 / (dt * Rho0) times conversion factors in [m6 Z-3 kg-1 T2 s-3 ~> m3 kg-1 s-1]. + ! This is used convert TKE back into ustar^3. + real :: vstar ! An in-situ turbulent velocity [Z T-1 ~> m s-1]. + real :: mstar_total ! The value of mstar used in ePBL [nondim] + real :: mstar_LT ! An addition to mstar due to Langmuir turbulence [nondim] (output for diagnostic) + real :: MLD_output ! The mixed layer depth output from this routine [Z ~> m]. + real :: LA ! The value of the Langmuir number [nondim] + real :: LAmod ! The modified Langmuir number by convection [nondim] real :: hbs_here ! The local minimum of hb_hs and MixLen_shape, times a ! conversion factor from H to Z [Z H-1 ~> 1 or m3 kg-1]. real :: nstar_FC ! The fraction of conv_PErel that can be converted to mixing [nondim]. real :: TKE_reduc ! The fraction by which TKE and other energy fields are ! reduced to support mixing [nondim]. between 0 and 1. - real :: tot_TKE ! The total TKE available to support mixing at interface K [J m-2]. - real :: TKE_here ! The total TKE at this point in the algorithm [J m-2]. + real :: tot_TKE ! The total TKE available to support mixing at interface K [kg m-3 Z3 T-2 ~> J m-2]. + real :: TKE_here ! The total TKE at this point in the algorithm [kg m-3 Z3 T-2 ~> J m-2]. real :: dT_km1_t2 ! A diffusivity-independent term related to the temperature ! change in the layer above the interface [degC]. real :: dS_km1_t2 ! A diffusivity-independent term related to the salinity @@ -407,24 +705,24 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! change in the layer above the interface [ppt H ~> ppt m or ppt kg m-2]. real :: dTe_t2 ! A part of dTe_term [degC H ~> degC m or degC kg m-2]. real :: dSe_t2 ! A part of dSe_term [ppt H ~> ppt m or ppt kg m-2]. - real :: dPE_conv ! The convective change in column potential energy [J m-2]. - real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [J m-2]. - real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [J m-2] + real :: dPE_conv ! The convective change in column potential energy [kg m-3 Z3 T-2 ~> J m-2]. + real :: MKE_src ! The mean kinetic energy source of TKE due to Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. + real :: dMKE_src_dK ! The partial derivative of MKE_src with Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. + real :: Kd_guess0 ! A first guess of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: PE_chg_g0 ! The potential energy change when Kd is Kd_guess0 [kg m-3 Z3 T-2 ~> J m-2] real :: dPEa_dKd_g0 real :: Kddt_h_g0 ! The first guess diapycnal diffusivity times a timestep divided ! by the average thicknesses around a layer [H ~> m or kg m-2]. - real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K). + real :: PE_chg_max ! The maximum PE change for very large values of Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. real :: dPEc_dKd_Kd0 ! The partial derivative of PE change with Kddt_h(K) - ! for very small values of Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. + ! for very small values of Kddt_h(K) [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real :: PE_chg ! The change in potential energy due to mixing at an - ! interface [J m-2], positive for the column increasing + ! interface [kg m-3 Z3 T-2 ~> J m-2], positive for the column increasing ! in potential energy (i.e., consuming TKE). real :: TKE_left ! The amount of turbulent kinetic energy left for the most - ! recent guess at Kddt_h(K) [J m-2]. + ! recent guess at Kddt_h(K) [kg m-3 Z3 T-2 ~> J m-2]. real :: dPEc_dKd ! The partial derivative of PE_chg with Kddt_h(K) [J m-2 H-1 ~> J m-3 or J kg-1]. - real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [J m-2]. + real :: TKE_left_min, TKE_left_max ! Maximum and minimum values of TKE_left [kg m-3 Z3 T-2 ~> J m-2]. real :: Kddt_h_max, Kddt_h_min ! Maximum and minimum values of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_guess ! A guess at the value of Kddt_h(K) [H ~> m or kg m-2]. real :: Kddt_h_next ! The next guess at the value of Kddt_h(K) [H ~> m or kg m-2]. @@ -432,1187 +730,731 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real :: dKddt_h_Newt ! The change between guesses at Kddt_h(K) with Newton's method [H ~> m or kg m-2]. real :: Kddt_h_newt ! The Newton's method next guess for Kddt_h(K) [H ~> m or kg m-2]. real :: exp_kh ! The nondimensional decay of TKE across a layer [nondim]. + real :: vstar_unit_scale ! A unit converion factor for turbulent velocities [Z T-1 s m-1 ~> 1] logical :: use_Newt ! Use Newton's method for the next guess at Kddt_h(K). - logical :: convectively_stable - logical, dimension(SZI_(G)) :: & - sfc_connected ! If true the ocean is actively turbulent from the present + logical :: convectively_stable ! If true the water column is convectively stable at this interface. + logical :: sfc_connected ! If true the ocean is actively turbulent from the present ! interface all the way up to the surface. logical :: sfc_disconnect ! If true, any turbulence has become disconnected ! from the surface. -! The following is only used as a diagnostic. - real :: dt__diag ! A copy of dt_diag (if present) or dt [s]. - real :: IdtdR0 ! = 1.0 / (dt__diag * Rho0) [m3 kg-1 s-1]. - real, dimension(SZI_(G),SZJ_(G)) :: & - Hsfc_used ! The thickness of the surface region [Z ~> m]. - logical :: write_diags ! If true, write out diagnostics with this step. - logical :: reset_diags ! If true, zero out the accumulated diagnostics. - ! Local column copies of energy change diagnostics, all [J m-2]. - real :: dTKE_conv, dTKE_forcing, dTKE_mixing - real :: dTKE_MKE, dTKE_mech_decay, dTKE_conv_decay +! The following are only used for diagnostics. + real :: dt__diag ! A copy of dt_diag (if present) or dt [T]. + real :: I_dtdiag ! = 1.0 / dt__diag [T-1 ~> s-1]. + !---------------------------------------------------------------------- !/BGR added Aug24,2016 for adding iteration to get boundary layer depth ! - needed to compute new mixing length. real :: MLD_guess, MLD_found ! Mixing Layer depth guessed/found for iteration [Z ~> m]. - real :: max_MLD, min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step - ! - These are initialized based on surface/bottom - ! 1. The iteration guesses a value (possibly from - ! prev step or neighbor). - ! 2. The iteration checks if value is converged, - ! too shallow, or too deep. - ! 3. Based on result adjusts the Max/Min - ! and searches through the water column. - ! - If using an accurate guess the iteration - ! is very quick (e.g. if MLD doesn't change - ! over timestep). Otherwise it takes 5-10 - ! passes, but has a high convergence rate. - ! Other iteration may be tried, but this - ! method seems to rarely fail and the added - ! cost is likely not significant. Additionally, - ! when it fails it does so in a reasonable - ! manner giving a usable guess. When it - ! does fail, it is due to convection within - ! the boundary. Likely, a new method e.g. - ! surface_disconnect, can improve this. + real :: min_MLD ! Iteration bounds [Z ~> m], which are adjusted at each step + real :: max_MLD ! - These are initialized based on surface/bottom + ! 1. The iteration guesses a value (possibly from prev step or neighbor). + ! 2. The iteration checks if value is converged, too shallow, or too deep. + ! 3. Based on result adjusts the Max/Min and searches through the water column. + ! - If using an accurate guess the iteration is very quick (e.g. if MLD doesn't + ! change over timestep). Otherwise it takes 5-10 passes, but has a high + ! convergence rate. Other iteration may be tried, but this method seems to + ! fail very rarely and the added cost is likely not significant. + ! Additionally, when it fails to converge it does so in a reasonable + ! manner giving a usable guess. When it does fail, it is due to convection + ! within the boundary layer. Likely, a new method e.g. surface_disconnect, + ! can improve this. logical :: FIRST_OBL ! Flag for computing "found" Mixing layer depth - logical :: OBL_CONVERGED ! Flag for convergence of MLD - integer :: OBL_IT ! Iteration counter -!### These need to be made into run-time parameters. - integer :: MAX_OBL_IT=20 ! Set maximum number of iterations. Probably - ! best as an input parameter, but then may want - ! to use allocatable arrays if storing - ! guess/found (as diagnostic); skipping for now. - ! In reality, the maximum number of guesses - ! needed is set by: - ! DEPTH/2^M < DZ - ! where M is the number of guesses - ! e.g. M=12 for DEPTH=4000m and DZ=1m - real, dimension(SZK_(GV)+1) :: Vstar_Used, & ! 1D arrays used to store - Mixing_Length_Used ! Vstar and Mixing_Length - !/BGR - remaining variables are related to tracking iteration statistics. - logical :: OBL_IT_STATS=.false. ! Flag for computing OBL iteration statistics - REAL :: ITguess(20), ITresult(20),ITmax(20),ITmin(20) ! Flag for storing guess/result - ! should have dim=MAX_OBL_IT - integer, save :: MAXIT=0 ! Stores maximum number of iterations - integer, save :: MINIT=1e8 ! Stores minimum number of iterations - integer, save :: SUMIT=0 ! Stores total iterations (summed over all) - integer, save :: NUMIT=0 ! Stores number of times iterated - !e.g. Average iterations = SUMIT/NUMIT - integer, save :: CONVERGED! - integer, save :: NOTCONVERGED! - !-End BGR iteration parameters----------------------------------------- - real :: N2_dissipation - real :: Bf_STABLE ! Buoyancy flux, capped at 0 (negative only) - real :: Bf_UNSTABLE ! Buoyancy flux, floored at 0 (positive only) - real :: Stab_Scale ! Composite of stabilizing Ekman scale and Monin-Obukhov length scales [Z ~> m]. - real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. - real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. - real :: MLD_o_Ekman ! > - real :: MLD_o_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_stab ! > - real :: MLD_o_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth - real :: Ekman_o_Obukhov_un ! > - - real :: C_MO = 1. ! Constant in Stab_Scale for Monin-Obukhov - real :: C_EK = 2. ! Constant in Stab_Scale for Ekman length - real :: MLD_over_STAB ! Mixing layer depth divided by Stab_Scale - real :: MSTAR_MIX ! The value of mstar (Proportionality of TKE to drive mixing to ustar - ! cubed) which is computed as a function of latitude, boundary layer depth, - ! and the Monin-Obukhov depth. - real :: MSTAR_LT ! The added mstar contribution due to Langmuir turbulence - real :: MSTAR_Conv_Adj ! Adjustment made to mstar due to convection reducing mechanical mixing. - real :: MSTAR_STAB, MSTAR_ROT ! Mstar in each limit, max is used. + logical :: OBL_converged ! Flag for convergence of MLD + integer :: OBL_it ! Iteration counter + real :: Surface_Scale ! Surface decay scale for vstar - real :: K_Enhancement ! A local enhancement of K, perhaps due to Langmuir turbulence - ! For LT_ENH_K_R16 - real :: Shape_Function ! The shape function of the enhancement - real, parameter :: Max_Shape_Function = 0.148148 ! The max value of the shape function of the enhancement - real, parameter :: Max_K_Enhancement = 2.25 ! The max value of the enhancement - !-End for LT_ENH_K_R16 + logical :: debug=.false. ! Change this hard-coded value for debugging. ! The following arrays are used only for debugging purposes. real :: dPE_debug, mixing_debug, taux2, tauy2 real, dimension(20) :: TKE_left_itt, PE_chg_itt, Kddt_h_itt, dPEa_dKd_itt, MKE_src_itt - real, dimension(SZI_(G),SZK_(GV)) :: & - mech_TKE_k, conv_PErel_k - real, dimension(SZK_(GV)) :: nstar_k + real, dimension(SZK_(GV)) :: mech_TKE_k, conv_PErel_k, nstar_k integer, dimension(SZK_(GV)) :: num_itts - integer :: i, j, k, is, ie, js, je, nz, itt, max_itt + integer :: k, nz, itt, max_itt - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "energetic_PBL: "//& "Module must be initialized before it is used.") - if (.not. associated(tv%eqn_of_state)) call MOM_error(FATAL, & - "energetic_PBL: Temperature, salinity and an equation of state "//& - "must now be used.") - if (.NOT. associated(fluxes%ustar)) call MOM_error(FATAL, & - "energetic_PBL: No surface TKE fluxes (ustar) defined in mixedlayer!") - if (present(dT_expected) .or. present(dS_expected)) debug = .true. + debug = .false. ; if (allocated(eCD%dT_expect) .or. allocated(eCD%dS_expect)) debug = .true. h_neglect = GV%H_subroundoff - if (.not.CS%Use_MLD_Iteration) MAX_OBL_IT=1 C1_3 = 1.0 / 3.0 dt__diag = dt ; if (present(dt_diag)) dt__diag = dt_diag - IdtdR0 = 1.0 / (dt__diag * GV%Rho0) - write_diags = .true. ; if (present(last_call)) write_diags = last_call + I_dtdiag = 1.0 / dt__diag max_itt = 20 h_tt_min = 0.0 - vonKar = 0.41 - mstar_mix=CS%MSTAR!Initialize to mstar - I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = 1.0 / (dt*GV%Rho0) + I_dtrho = 0.0 ; if (dt*GV%Rho0 > 0.0) I_dtrho = (US%Z_to_m**3*US%s_to_T**3) / (dt*GV%Rho0) + vstar_unit_scale = US%m_to_Z * US%T_to_s + + MLD_guess = MLD_io + +! Determine the initial mech_TKE and conv_PErel, including the energy required +! to mix surface heating through the topmost cell, the energy released by mixing +! surface cooling & brine rejection down through the topmost cell, and +! homogenizing the shortwave heating within that cell. This sets the energy +! and ustar and wstar available to drive mixing at the first interior +! interface. + + do K=1,nz+1 ; Kd(K) = 0.0 ; enddo + + pres_Z(1) = 0.0 + do k=1,nz + dMass = US%m_to_Z * GV%H_to_kg_m2 * h(k) + dPres = US%L_to_Z**2 * GV%LZT_g_Earth * dMass ! Equivalent to GV%H_to_Pa * h(k) with rescaling + dT_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dT(k) + dS_to_dPE(k) = (dMass * (pres_Z(K) + 0.5*dPres)) * dSV_dS(k) + dT_to_dColHt(k) = dMass * dSV_dT(k) + dS_to_dColHt(k) = dMass * dSV_dS(k) + + pres_Z(K+1) = pres_Z(K) + dPres + enddo - ! Determine whether to zero out diagnostics before accumulation. - reset_diags = .true. - if (present(dt_diag) .and. write_diags .and. (dt__diag > dt)) & - reset_diags = .false. ! This is the second call to mixedlayer. + ! Determine the total thickness (h_sum) and the fractional distance from the bottom (hb_hs). + h_sum = H_neglect ; do k=1,nz ; h_sum = h_sum + h(k) ; enddo + I_hs = 0.0 ; if (h_sum > 0.0) I_hs = 1.0 / h_sum + h_bot = 0.0 + hb_hs(nz+1) = 0.0 + do k=nz,1,-1 + h_bot = h_bot + h(k) + hb_hs(K) = h_bot * I_hs + enddo - if (reset_diags) then - if (CS%TKE_diagnostics) then -!!OMP parallel do default(none) shared(is,ie,js,je,CS) - do j=js,je ; do i=is,ie - CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 - CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 - CS%diag_TKE_mixing(i,j) = 0.0 ; CS%diag_TKE_mech_decay(i,j) = 0.0 - CS%diag_TKE_conv_decay(i,j) = 0.0 !; CS%diag_TKE_unbalanced_forcing(i,j) = 0.0 - enddo ; enddo - endif -!!OMP parallel do default(none) shared(CS) - if (CS%Mixing_Diagnostics) then - CS%Mixing_Length(:,:,:) = 0.0 - CS%Velocity_Scale(:,:,:) = 0.0 - endif - endif + MLD_output = h(1)*GV%H_to_Z + !/The following lines are for the iteration over MLD + ! max_MLD will initialized as ocean bottom depth + max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(k)*GV%H_to_Z ; enddo + !min_MLD will initialize as 0. + min_MLD = 0.0 -!!OMP parallel do default(none) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,IdtdR0, & -!!OMP TKE_forced,debug,H_neglect,dSV_dT, & -!!OMP dSV_dS,I_dtrho,C1_3,h_tt_min,vonKar, & -!!OMP max_itt,Kd_int) & -!!OMP private(i,j,k,h,u,v,T,S,Kd,mech_TKE_k,conv_PErel_k, & -!!OMP U_Star,absf,mech_TKE,conv_PErel,nstar_k, & -!!OMP h_sum,I_hs,h_bot,hb_hs,T0,S0,num_itts, & -!!OMP pres,pres_Z,dMass,dPres,dT_to_dPE,dS_to_dPE, & -!!OMP dT_to_dColHt,dS_to_dColHt,Kddt_h,hp_a, & -!!OMP Th_a,Sh_a,Th_b,Sh_b,dT_to_dPE_a,htot, & -!!OMP dT_to_dColHt_a,dS_to_dColHt_a,uhtot,vhtot, & -!!OMP Idecay_len_TKE,exp_kh,nstar_FC,tot_TKE, & -!!OMP TKE_reduc,dTe_t2,dSe_t2,dTe,dSe,dt_h, & -!!OMP Convectively_stable,sfc_disconnect,b1, & -!!OMP c1,dT_km1_t2,dS_km1_t2,dTe_term, & -!!OMP dSe_term,MKE2_Hharm,vstar,h_tt,h_rsum, & -!!OMP Kd_guess0,Kddt_h_g0,dPEc_dKd_Kd0, & -!!OMP PE_chg_max,dPEa_dKd_g0,PE_chg_g0, & -!!OMP MKE_src,dPE_conv,Kddt_h_max,Kddt_h_min, & -!!OMP dTKE_conv, dTKE_forcing, dTKE_mixing, & -!!OMP dTKE_MKE,dTKE_mech_decay,dTKE_conv_decay,& -!!OMP TKE_left_max,TKE_left_min,Kddt_h_guess, & -!!OMP TKE_left_itt,dPEa_dKd_itt,PE_chg_itt, & -!!OMP MKE_src_itt,Kddt_h_itt,dPEc_dKd,PE_chg, & -!!OMP dMKE_src_dK,TKE_left,use_Newt, & -!!OMP dKddt_h_Newt,Kddt_h_Newt,Kddt_h_next, & -!!OMP dKddt_h,Te,Se,Hsfc_used,dS_to_dPE_a, & -!!OMP dMKE_max,sfc_connected,TKE_here) - do j=js,je - ! Copy the thicknesses and other fields to 2-d arrays. - do k=1,nz ; do i=is,ie - h(i,k) = h_3d(i,j,k) + h_neglect ; u(i,k) = u_3d(i,j,k) ; v(i,k) = v_3d(i,j,k) - T(i,k) = tv%T(i,j,k) ; S(i,k) = tv%S(i,j,k) - Kd(i,K) = 0.0 - enddo ; enddo - do i=is,ie - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z - sfc_connected(i) = .true. - enddo - - if (debug) then - mech_TKE_k(:,:) = 0.0 ; conv_PErel_k(:,:) = 0.0 - endif + ! If no first guess is provided for MLD, try the middle of the water column + if (MLD_guess <= min_MLD) MLD_guess = 0.5 * (min_MLD + max_MLD) - ! Determine the initial mech_TKE and conv_PErel, including the energy required - ! to mix surface heating through the topmost cell, the energy released by mixing - ! surface cooling & brine rejection down through the topmost cell, and - ! homogenizing the shortwave heating within that cell. This sets the energy - ! and ustar and wstar available to drive mixing at the first interior - ! interface. - do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + ! Iterate to determine a converged EPBL depth. + OBL_converged = .false. + do OBL_it=1,CS%Max_MLD_Its - U_star = fluxes%ustar(i,j) - U_Star_Mean = fluxes%ustar_gustless(i,j) - if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then - if (fluxes%frac_shelf_h(i,j) > 0.0) & - U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & - fluxes%frac_shelf_h(i,j) * fluxes%ustar_shelf(i,j) - endif - if (U_Star < CS%ustar_min) U_Star = CS%ustar_min + if (.not. OBL_converged) then + ! If not using MLD_Iteration flag loop to only execute once. + if (.not.CS%Use_MLD_iteration) OBL_converged = .true. + + if (debug) then ; mech_TKE_k(:) = 0.0 ; conv_PErel_k(:) = 0.0 ; endif - ! Computing Bf w/ limiters. - Bf_Stable = max(0.0, buoy_Flux(i,j)) ! Positive for stable - Bf_Unstable = min(0.0, buoy_flux(i,j)) ! Negative for unstable - if (CS%omega_frac >= 1.0) then ; absf(i) = 2.0*CS%omega + ! Reset ML_depth + MLD_output = h(1)*GV%H_to_Z + sfc_connected = .true. + + !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 + if (CS%Use_LT) then + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & + H=h, U_H=u, V_H=v, Waves=Waves) + call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_Guess, absf, & + MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& + mstar_LT=mstar_LT) else - absf(i) = 0.25*US%s_to_T*((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & - (abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I-1,J)))) - if (CS%omega_frac > 0.0) & - absf(i) = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf(i)**2) + call find_mstar(CS, US, B_flux, u_star, u_star_mean, MLD_guess, absf, mstar_total) endif - ! Computing stability scale which correlates with TKE for mixing, where - ! TKE for mixing = TKE production minus TKE dissipation - Stab_Scale = U_star**2 / ( VonKar * ( C_MO * BF_Stable / U_star - C_EK * U_star * absf(i))) - ! Inverse of Ekman and Obukhov - iL_Ekman = absf(i) / U_star - iL_Obukhov = buoy_flux(i,j)*vonkar / (U_star**3) - if (CS%USE_LT) then - Ekman_o_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - Ekman_o_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) - !### Consider recoding this as... - ! Max_ratio = 1.0e16 - ! Ekman_Obukhov = Max_ratio - ! if (abs(buoy_flux(i,j)*vonkar) < Max_ratio*(absf(i) * U_star**2)) & - ! Ekman_Obukhov = buoy_flux(i,j)*vonkar / (absf(i) * U_star**2) - ! if (buoy_flux(i,j) > 0.0) then - ! Ekman_o_Obukhov_stab = Ekman_Obukhov ; Ekman_o_Obukhov_un = 0.0 - ! else - ! Ekman_o_Obukhov_un = Ekman_Obukhov ; Ekman_o_Obukhov_stab = 0.0 - ! endif + + !/ Apply MStar to get mech_TKE + if ((CS%answers_2018) .and. (CS%mstar_scheme==Use_Fixed_MStar)) then + mech_TKE = (dt*MSTAR_total*GV%Rho0) * u_star**3 + else + mech_TKE = MSTAR_total * (dt*GV%Rho0* u_star**3) endif - if (CS%Mstar_Mode == CS%CONST_MSTAR) then - mech_TKE(i) = (dt*CS%mstar*GV%Rho0) * US%Z_to_m**3 * U_star**3 - conv_PErel(i) = 0.0 - - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = 0.0 ; eCD%dTKE_mixing = 0.0 + eCD%dTKE_MKE = 0.0 ; eCD%dTKE_mech_decay = 0.0 ; eCD%dTKE_conv_decay = 0.0 - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 + eCD%dTKE_wind = mech_TKE * I_dtdiag + if (TKE_forcing(1) <= 0.0) then + eCD%dTKE_forcing = max(-mech_TKE, TKE_forcing(1)) * I_dtdiag + ! eCD%dTKE_unbalanced = min(0.0, TKE_forcing(1) + mech_TKE) * I_dtdiag else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) + eCD%dTKE_forcing = CS%nstar*TKE_forcing(1) * I_dtdiag + ! eCD%dTKE_unbalanced = 0.0 endif + endif + if (TKE_forcing(1) <= 0.0) then + mech_TKE = mech_TKE + TKE_forcing(1) + if (mech_TKE < 0.0) mech_TKE = 0.0 + conv_PErel = 0.0 + else + conv_PErel = TKE_forcing(1) endif -! endif ; enddo -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then + ! Store in 1D arrays for output. + do K=1,nz+1 ; mixvel(K) = 0.0 ; mixlen(K) = 0.0 ; enddo - h_sum(i) = H_neglect ; do k=1,nz ; h_sum(i) = h_sum(i) + h(i,k) ; enddo - I_hs = 0.0 ; if (h_sum(i) > 0.0) I_hs = 1.0 / h_sum(i) + ! Determine the mixing shape function MixLen_shape. + if ((.not.CS%Use_MLD_iteration) .or. & + (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then + do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo + elseif (MLD_guess <= 0.0) then + if (CS%transLay_scale > 0.0) then ; do K=1,nz+1 + MixLen_shape(K) = CS%transLay_scale + enddo ; else ; do K=1,nz+1 + MixLen_shape(K) = 1.0 + enddo ; endif + else + ! Reduce the mixing length based on MLD, with a quadratic + ! expression that follows KPP. + I_MLD = 1.0 / MLD_guess + h_rsum = 0.0 + MixLen_shape(1) = 1.0 + do K=2,nz+1 + h_rsum = h_rsum + h(k-1)*GV%H_to_Z + if (CS%MixLenExponent==2.0) then + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2 ! CS%MixLenExponent + else + MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & + (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent + endif + enddo + endif - h_bot = 0.0 ; hb_hs(i,nz+1) = 0.0 - do k=nz,1,-1 - h_bot = h_bot + h(i,k) - hb_hs(i,K) = h_bot * I_hs - enddo + Kd(1) = 0.0 ; Kddt_h(1) = 0.0 + hp_a = h(1) + dT_to_dPE_a(1) = dT_to_dPE(1) ; dT_to_dColHt_a(1) = dT_to_dColHt(1) + dS_to_dPE_a(1) = dS_to_dPE(1) ; dS_to_dColHt_a(1) = dS_to_dColHt(1) - pres(i,1) = 0.0 ; pres_Z(i,1) = 0.0 - do k=1,nz - dMass = GV%H_to_kg_m2 * h(i,k) - dPres = (GV%g_Earth*US%m_to_Z) * dMass ! This is equivalent to GV%H_to_Pa * h(i,k) - dT_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dT(i,j,k) - dS_to_dPE(i,k) = (dMass * (pres(i,K) + 0.5*dPres)) * dSV_dS(i,j,k) - dT_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dT(i,j,k) - dS_to_dColHt(i,k) = dMass * US%m_to_Z * dSV_dS(i,j,k) - - pres(i,K+1) = pres(i,K) + dPres - pres_Z(i,K+1) = US%Z_to_m * pres(i,K+1) - enddo + htot = h(1) ; uhtot = u(1)*h(1) ; vhtot = v(1)*h(1) -! endif ; enddo - - ! Note the outer i-loop and inner k-loop loop order!!! -! do i=is,ie ; if (G%mask2dT(i,j) > 0.5) then - do k=1,nz ; T0(k) = T(i,k) ; S0(k) = S(i,k) ; enddo - - ! Store the initial mechanical TKE and convectively released PE to - ! enable multiple iterations. - mech_TKE_top(i) = mech_TKE(i) ; conv_PErel_top(i) = conv_PErel(i) - - !/The following lines are for the iteration over MLD - !{ - ! max_MLD will initialized as ocean bottom depth - max_MLD = 0.0 ; do k=1,nz ; max_MLD = max_MLD + h(i,k)*GV%H_to_Z ; enddo - min_MLD = 0.0 !min_MLD will initialize as 0. - !/BGR: May add user-input bounds for max/min MLD - - !/BGR: Add MLD_guess based on stored previous value. - ! note that this is different from ML_Depth already - ! computed by EPBL, need to figure out why. - if (CS%MLD_iteration_guess .and. (CS%ML_Depth2(i,j) > 1.0*US%m_to_Z)) then - !If prev value is present use for guess. - MLD_guess = CS%ML_Depth2(i,j) - else - !Otherwise guess middle of water column (or Stab_Scale if smaller). - MLD_guess = 0.5 * (min_MLD+max_MLD) + if (debug) then + mech_TKE_k(1) = mech_TKE ; conv_PErel_k(1) = conv_PErel + nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 endif - ! Iterate up to MAX_OBL_IT times to determine a converged EPBL depth. - OBL_CONVERGED = .false. - - ! Initialize ENHANCE_M to 1 and mstar_lt to 0 - ENHANCE_M=1.e0 - MSTAR_LT = 0.0 - do OBL_IT=1,MAX_OBL_IT ; if (.not. OBL_CONVERGED) then - - ! Reset ML_depth - CS%ML_depth(i,j) = h(i,1)*GV%H_to_Z - !CS%ML_depth2(i,j) = h(i,1)*GV%H_to_Z - - sfc_connected(i) = .true. - - if (CS%Mstar_Mode > 0) then - ! Note the value of mech_TKE(i) now must be iterated over, so it is moved here - ! First solve for the TKE to PE length scale - if (CS%MSTAR_MODE == CS%MLD_o_OBUKHOV) then - MLD_over_Stab = MLD_guess / Stab_Scale - CS%MSTAR_XINT - !### MLD_over_Stab = (MLD_guess * (VonKar * (C_MO*BF_Stable - C_EK*U_star**2*absf(i)))) / & - !### U_star**3 - CS%MSTAR_XINT - if ((MLD_over_Stab) <= 0.0) then - !Asymptote to 0 as MLD_over_Stab -> -infinity (always) - MSTAR_mix = (CS%MSTAR_B*(MLD_over_Stab)+CS%MSTAR_A)**(CS%MSTAR_N) - else - if (CS%MSTAR_CAP>=0.) then - if (CS%MSTAR_FLATCAP .OR. (MLD_over_Stab <= CS%MSTAR_XINT_UP)) then - !If using flat cap (or if using asymptotic cap - ! but within linear regime we can make use of same code) - MSTAR_mix = min(CS%MSTAR_CAP, & - CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT) - else - !Asymptote to MSTAR_CAP as MLD_over_Stab -> infinity - MSTAR_mix = CS%MSTAR_CAP - & - (CS%MSTAR_B2*(MLD_over_Stab-CS%MSTAR_XINT_UP)& - +CS%MSTAR_A2)**(CS%MSTAR_N) - endif - else - !No cap if negative cap value given. - MSTAR_mix = CS%MSTAR_SLOPE*(MLD_over_Stab)+CS%MSTAR_AT_XINT - endif - endif - elseif (CS%MSTAR_MODE == CS%EKMAN_o_OBUKHOV) then - !### Please refrain from using the construct A / B / C in place of A/(B*C). - ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) - mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / U_star**2 / (absf(i)+1.e-10)) - !### Should be mstar_STAB = CS%MSTAR_COEF*sqrt(Bf_Stable / (U_star**2 * (absf(i)+1.e-10))) - ! The limit for rotation (Ekman length) limited mixin - mstar_ROT = CS%C_EK * log(max(1., U_star / (absf(i)+1.e-10) / MLD_guess)) - !### Consider rewriting the expression for mstar_ROT as: - ! mstar_Rot = 0.0 - ! if (Ustar > absf(i) * MLD_guess) & - ! mstar_ROT = CS%C_EK * log(U_star / (absf(i) * MLD_guess)) - ! Here 1.25 is .5/von Karman, which gives the Obukhov limit. - MSTAR_MIX = max(mstar_STAB, min(1.25, mstar_ROT)) - if (CS%MSTAR_CAP > 0.0) MSTAR_MIX = min(CS%MSTAR_CAP, MSTAR_MIX) - elseif (CS%MSTAR_MODE.eq.CS%MSTAR_RH18) then - MSTAR_ROT = CS%RH18_MST_CN1 * ( 1.0 - ( 1.+CS%RH18_MST_CN2 * & - exp( CS%RH18_MST_CN3 * MLD_GUESS * absf(i) / u_star) )**-1.0 ) - MSTAR_STAB = CS%RH18_MST_CS1 * (bf_stable**2*MLD_GUESS & - / ( u_star**5 * absf(i) ) ) **CS%RH18_MST_CS2 - MSTAR_MIX = MSTAR_ROT + MSTAR_STAB - endif!mstar_mode==1 or ==2 or ==3 - ! Adjustment for unstable buoyancy flux. - ! Convection reduces mechanical mixing because there - ! is less density gradient to mix. (Statically unstable near surface) - MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * (-BF_Unstable + 1.e-10*US%m_to_Z**2) / & - ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2) + & - 2.0 *MSTAR_MIX * U_star**3 / MLD_guess ) - ! MSTAR_Conv_Adj = 1. - CS%CNV_MST_FAC * ((-BF_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess) / & - ! ( (-Bf_Unstable + 1.e-10*US%m_to_Z**2)*MLD_guess + & - ! 2.0*MSTAR_MIX * U_star**3 ) - if (CS%USE_LT) then - call get_Langmuir_Number( LA, G, GV, US, abs(MLD_guess), u_star_mean, i, j, & - H=H(i,:), U_H=U(i,:), V_H=V(i,:), WAVES=WAVES) - ! 2. Get parameters for modified LA - MLD_o_Ekman = abs(MLD_guess * iL_Ekman) - MLD_o_Obukhov_stab = abs(max(0., MLD_guess*iL_Obukhov)) - MLD_o_Obukhov_un = abs(min(0., MLD_guess*iL_Obukhov)) - ! 3. Adjust LA based on various parameters. - ! Assumes linear factors based on length scale ratios to adjust LA - ! Note when these coefficients are set to 0 recovers simple LA. - LAmod = LA * (1.0 + max(-0.5,CS%LaC_MLDoEK * MLD_o_Ekman) + & - CS%LaC_EKoOB_stab * Ekman_o_Obukhov_stab + & - CS%LaC_EKoOB_un * Ekman_o_Obukhov_un + & - CS%LaC_MLDoOB_stab * MLD_o_Obukhov_stab + & - CS%LaC_MLDoOB_un * MLD_o_Obukhov_un ) - if (CS%LT_Enhance_Form==1) then - !Original w'/ust scaling w/ Van Roekel et al. 2012 scaling - ! NOTE we know now that this is not the right way to scale M. - ENHANCE_M = (1. + (1.4*LA)**(-2) + (5.4*LA)**(-4))**(1.5) - elseif (CS%LT_Enhance_Form==2) then - ! Enhancement is multiplied (added mst_lt set to 0) - ENHANCE_M = min(CS%Max_Enhance_M, (1. + CS%LT_ENHANCE_COEF*LAmod**CS%LT_ENHANCE_EXP)) - MSTAR_LT = 0.0 - elseif (CS%LT_ENHANCE_Form == 3) then - ! or Enhancement is additive (multiplied enhance_m set to 1) - MSTAR_LT = CS%LT_ENHANCE_COEF * LAmod**CS%LT_ENHANCE_EXP - ENHANCE_M = 1.0 - endif - endif - !Reset mech_tke and conv_perel values (based on new mstar) - mech_TKE(i) = ( MSTAR_mix * MSTAR_conv_adj * ENHANCE_M + MSTAR_LT) * & - US%Z_to_m**3 * (dt*GV%Rho0*U_star**3) - conv_PErel(i) = 0.0 - if (CS%TKE_diagnostics) then - CS%diag_TKE_wind(i,j) = CS%diag_TKE_wind(i,j) + mech_TKE(i) * IdtdR0 - if (TKE_forced(i,j,1) <= 0.0) then - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + & - max(-mech_TKE(i), TKE_forced(i,j,1)) * IdtdR0 - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + & - ! min(0.0, TKE_forced(i,j,1) + mech_TKE(i)) * IdtdR0 - else - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + CS%nstar*TKE_forced(i,j,1) * IdtdR0 - endif - endif - - if (TKE_forced(i,j,1) <= 0.0) then - mech_TKE(i) = mech_TKE(i) + TKE_forced(i,j,1) - if (mech_TKE(i) < 0.0) mech_TKE(i) = 0.0 - else - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,1) - endif - else - mech_TKE(i) = mech_TKE_top(i)*ENHANCE_M ; conv_PErel(i) = conv_PErel_top(i) + do K=2,nz + ! Apply dissipation to the TKE, here applied as an exponential decay + ! due to 3-d turbulent energy being lost to inefficient rotational modes. + + ! There should be several different "flavors" of TKE that decay at + ! different rates. The following form is often used for mechanical + ! stirring from the surface, perhaps due to breaking surface gravity + ! waves and wind-driven turbulence. + Idecay_len_TKE = (CS%TKE_decay * absf / u_star) * GV%H_to_Z + exp_kh = 1.0 + if (Idecay_len_TKE > 0.0) exp_kh = exp(-h(k-1)*Idecay_len_TKE) + if (CS%TKE_diagnostics) & + eCD%dTKE_mech_decay = eCD%dTKE_mech_decay + (exp_kh-1.0) * mech_TKE * I_dtdiag + mech_TKE = mech_TKE * exp_kh + + ! Accumulate any convectively released potential energy to contribute + ! to wstar and to drive penetrating convection. + if (TKE_forcing(k) > 0.0) then + conv_PErel = conv_PErel + TKE_forcing(k) + if (CS%TKE_diagnostics) & + eCD%dTKE_forcing = eCD%dTKE_forcing + CS%nstar*TKE_forcing(k) * I_dtdiag endif - if (CS%TKE_diagnostics) then - dTKE_conv = 0.0 ; dTKE_forcing = 0.0 ; dTKE_mixing = 0.0 - dTKE_MKE = 0.0 ; dTKE_mech_decay = 0.0 ; dTKE_conv_decay = 0.0 + if (debug) then + mech_TKE_k(K) = mech_TKE ; conv_PErel_k(K) = conv_PErel endif - ! Store in 1D arrays cleared out each iteration. Only write in - ! 3D arrays after convergence. - do k=1,nz - Vstar_Used(k) = 0.0 ; Mixing_Length_Used(k) = 0.0 - enddo - if (.not.CS%Use_MLD_Iteration) OBL_CONVERGED = .true. - - if ((.not.CS%Use_MLD_Iteration) .or. & - (CS%transLay_scale >= 1.0) .or. (CS%transLay_scale < 0.0) ) then - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - elseif (MLD_guess <= 0.0) then - if (CS%transLay_scale > 0.0) then - do K=1,nz+1 ; MixLen_shape(K) = CS%transLay_scale ; enddo - else - do K=1,nz+1 ; MixLen_shape(K) = 1.0 ; enddo - endif - else - ! Reduce the mixing length based on MLD, with a quadratic - ! expression that follows KPP. - I_MLD = 1.0 / MLD_guess ; h_rsum = 0.0 - MixLen_shape(1) = 1.0 - do K=2,nz+1 - h_rsum = h_rsum + h(i,k-1)*GV%H_to_Z - if (CS%MixLenExponent==2.0)then - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**2!CS%MixLenExponent - else - MixLen_shape(K) = CS%transLay_scale + (1.0 - CS%transLay_scale) * & - (max(0.0, (MLD_guess - h_rsum)*I_MLD) )**CS%MixLenExponent - endif - enddo + ! Determine the total energy + nstar_FC = CS%nstar + if (CS%nstar * conv_PErel > 0.0) then + ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based + ! on a curve fit from the data of Wang (GRL, 2003). + ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot)**3 / conv_PErel) + nstar_FC = CS%nstar * conv_PErel / (conv_PErel + 0.2 * & + sqrt(0.5 * dt * GV%Rho0 * (absf*(htot*GV%H_to_Z))**3 * conv_PErel)) endif + if (debug) nstar_k(K) = nstar_FC - Kd(i,1) = 0.0 ; Kddt_h(1) = 0.0 - hp_a(i) = h(i,1) - dT_to_dPE_a(i,1) = dT_to_dPE(i,1) ; dT_to_dColHt_a(i,1) = dT_to_dColHt(i,1) - dS_to_dPE_a(i,1) = dS_to_dPE(i,1) ; dS_to_dColHt_a(i,1) = dS_to_dColHt(i,1) + tot_TKE = mech_TKE + nstar_FC * conv_PErel - htot(i) = h(i,1) ; uhtot(i) = u(i,1)*h(i,1) ; vhtot(i) = v(i,1)*h(i,1) + ! For each interior interface, first discard the TKE to account for + ! mixing of shortwave radiation through the next denser cell. + if (TKE_forcing(k) < 0.0) then + if (TKE_forcing(k) + tot_TKE < 0.0) then + ! The shortwave requirements deplete all the energy in this layer. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing + tot_TKE * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing - tot_TKE * I_dtdiag + ! eCD%dTKE_unbalanced = eCD%dTKE_unbalanced + (TKE_forcing(k) + tot_TKE) * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + else + ! Reduce the mechanical and convective TKE proportionately. + TKE_reduc = (tot_TKE + TKE_forcing(k)) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - TKE_forcing(k) * I_dtdiag + eCD%dTKE_forcing = eCD%dTKE_forcing + TKE_forcing(k) * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forcing(k) + mech_TKE = TKE_reduc*mech_TKE + conv_PErel = TKE_reduc*conv_PErel + endif + endif - if (debug) then - mech_TKE_k(i,1) = mech_TKE(i) ; conv_PErel_k(i,1) = conv_PErel(i) - nstar_k(:) = 0.0 ; nstar_k(1) = CS%nstar ; num_itts(:) = -1 + ! Precalculate some temporary expressions that are independent of Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dTe_t2 = 0.0 ; dSe_t2 = 0.0 + else + dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif endif - do K=2,nz - ! Apply dissipation to the TKE, here applied as an exponential decay - ! due to 3-d turbulent energy being lost to inefficient rotational modes. - - ! There should be several different "flavors" of TKE that decay at - ! different rates. The following form is often used for mechanical - ! stirring from the surface, perhaps due to breaking surface gravity - ! waves and wind-driven turbulence. - Idecay_len_TKE(i) = (CS%TKE_decay * absf(i) / U_star) * GV%H_to_Z - exp_kh = 1.0 - if (Idecay_len_TKE(i) > 0.0) exp_kh = exp(-h(i,k-1)*Idecay_len_TKE(i)) - if (CS%TKE_diagnostics) & - dTKE_mech_decay = dTKE_mech_decay + (exp_kh-1.0) * mech_TKE(i) * IdtdR0 - mech_TKE(i) = mech_TKE(i) * exp_kh - - ! Accumulate any convectively released potential energy to contribute - ! to wstar and to drive penetrating convection. - if (TKE_forced(i,j,k) > 0.0) then - conv_PErel(i) = conv_PErel(i) + TKE_forced(i,j,k) - if (CS%TKE_diagnostics) & - dTKE_forcing = dTKE_forcing + CS%nstar*TKE_forced(i,j,k) * IdtdR0 + dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(k-1)+h(k)), 1e-15*h_sum) + + ! This tests whether the layers above and below this interface are in + ! a convetively stable configuration, without considering any effects of + ! mixing at higher interfaces. It is an approximation to the more + ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of + ! mixing across interface K-1. The dT_to_dColHt here are effectively + ! mass-weigted estimates of dSV_dT. + Convectively_stable = ( 0.0 <= & + ( (dT_to_dColHt(k) + dT_to_dColHt(k-1) ) * (T0(k-1)-T0(k)) + & + (dS_to_dColHt(k) + dS_to_dColHt(k-1) ) * (S0(k-1)-S0(k)) ) ) + + if ((mech_TKE + conv_PErel) <= 0.0 .and. Convectively_stable) then + ! Energy is already exhausted, so set Kd = 0 and cycle or exit? + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + sfc_disconnect = .true. + ! if (.not.debug) exit + + ! The estimated properties for layer k-1 can be calculated, using + ! greatly simplified expressions when Kddt_h = 0. This enables the + ! tridiagonal solver for the whole column to be completed for debugging + ! purposes, and also allows for something akin to convective adjustment + ! in unstable interior regions? + b1 = 1.0 / hp_a + c1(K) = 0.0 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( dTe_t2 ) + dSe(k-1) = b1 * ( dSe_t2 ) endif - if (debug) then - mech_TKE_k(i,K) = mech_TKE(i) ; conv_PErel_k(i,K) = conv_PErel(i) + hp_a = h(k) + dT_to_dPE_a(k) = dT_to_dPE(k) + dS_to_dPE_a(k) = dS_to_dPE(k) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + + else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. + sfc_disconnect = .false. + + ! Precalculate some more temporary expressions that are independent of + ! Kddt_h(K). + if (CS%orig_PE_calc) then + if (K==2) then + dT_km1_t2 = (T0(k)-T0(k-1)) + dS_km1_t2 = (S0(k)-S0(k-1)) + else + dT_km1_t2 = (T0(k)-T0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) + dS_km1_t2 = (S0(k)-S0(k-1)) - & + (Kddt_h(K-1) / hp_a) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + endif + dTe_term = dTe_t2 + hp_a * (T0(k-1)-T0(k)) + dSe_term = dSe_t2 + hp_a * (S0(k-1)-S0(k)) + else + if (K<=2) then + Th_a(k-1) = h(k-1) * T0(k-1) ; Sh_a(k-1) = h(k-1) * S0(k-1) + else + Th_a(k-1) = h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) + Sh_a(k-1) = h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) + endif + Th_b(k) = h(k) * T0(k) ; Sh_b(k) = h(k) * S0(k) endif - ! Determine the total energy - nstar_FC = CS%nstar - if (CS%nstar * conv_PErel(i) > 0.0) then - ! Here nstar is a function of the natural Rossby number 0.2/(1+0.2/Ro), based - ! on a curve fit from the data of Wang (GRL, 2003). - ! Note: Ro = 1.0 / sqrt(0.5 * dt * Rho0 * (absf*htot(i))**3 / conv_PErel(i)) - nstar_FC = CS%nstar * conv_PErel(i) / (conv_PErel(i) + 0.2 * & - sqrt(0.5 * dt * GV%Rho0 * (absf(i)*(htot(i)*GV%H_to_m))**3 * conv_PErel(i))) + ! Using Pr=1 and the diffusivity at the bottom interface (once it is + ! known), determine how much resolved mean kinetic energy (MKE) will be + ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of + ! this to the mTKE budget available for mixing in the next layer. + + if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot*h(k) > 0.0)) then + ! This is the energy that would be available from homogenizing the + ! velocities between layer k and the layers above. + dMKE_max = (US%m_to_Z**3*US%T_to_s**2)*(GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & + (h(k) / ((htot + h(k))*htot)) * & + ((uhtot-u(k)*htot)**2 + (vhtot-v(k)*htot)**2) + ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be + ! extracted by mixing with a finite viscosity. + MKE2_Hharm = (htot + h(k) + 2.0*h_neglect) / & + ((htot+h_neglect) * (h(k)+h_neglect)) + else + dMKE_max = 0.0 + MKE2_Hharm = 0.0 endif - if (debug) nstar_k(K) = nstar_FC - - tot_TKE = mech_TKE(i) + nstar_FC * conv_PErel(i) - - ! For each interior interface, first discard the TKE to account for - ! mixing of shortwave radiation through the next denser cell. - if (TKE_forced(i,j,k) < 0.0) then - if (TKE_forced(i,j,k) + tot_TKE < 0.0) then - ! The shortwave requirements deplete all the energy in this layer. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing + tot_TKE * IdtdR0 - dTKE_forcing = dTKE_forcing - tot_TKE * IdtdR0 - ! dTKE_unbalanced_forcing = dTKE_unbalanced_forcing + & - ! (TKE_forced(i,j,k) + tot_TKE) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 + ! At this point, Kddt_h(K) will be unknown because its value may depend + ! on how much energy is available. mech_TKE might be negative due to + ! contributions from TKE_forced. + h_tt = htot + h_tt_min + TKE_here = mech_TKE + CS%wstar_ustar_coef*conv_PErel + if (TKE_here > 0.0) then + if (CS%wT_scheme==wT_from_cRoot_TKE) then + vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_scheme==wT_from_RH18) then + Surface_Scale = max(0.05, 1.0 - htot/MLD_guess) + vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & + vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) + endif + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) + mixlen(K) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) + !Note setting Kd_guess0 to vstar * CS%vonKar * mixlen(K) here will + ! change the answers. Therefore, skipping that. + if (.not.CS%Use_MLD_iteration) then + Kd_guess0 = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) else - ! Reduce the mechanical and convective TKE proportionately. - TKE_reduc = (tot_TKE + TKE_forced(i,j,k)) / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - TKE_forced(i,j,k) * IdtdR0 - dTKE_forcing = dTKE_forcing + TKE_forced(i,j,k) * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 - endif - tot_TKE = TKE_reduc*tot_TKE ! = tot_TKE + TKE_forced(i,j,k) - mech_TKE(i) = TKE_reduc*mech_TKE(i) - conv_PErel(i) = TKE_reduc*conv_PErel(i) + Kd_guess0 = vstar * CS%vonKar * mixlen(K) endif + else + vstar = 0.0 ; Kd_guess0 = 0.0 endif + mixvel(K) = vstar ! Track vstar + Kddt_h_g0 = Kd_guess0 * dt_h - ! Precalculate some temporary expressions that are independent of Kddt_h(K). if (CS%orig_PE_calc) then - if (K==2) then - dTe_t2 = 0.0 ; dSe_t2 = 0.0 - else - dTe_t2 = Kddt_h(K-1) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dSe_t2 = Kddt_h(K-1) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) - endif + call find_PE_chg_orig(Kddt_h_g0, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) + else + call find_PE_chg(0.0, Kddt_h_g0, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & + dPEc_dKd_0=dPEc_dKd_Kd0 ) endif - dt_h = (GV%Z_to_H**2*dt) / max(0.5*(h(i,k-1)+h(i,k)), 1e-15*h_sum(i)) - - ! This tests whether the layers above and below this interface are in - ! a convetively stable configuration, without considering any effects of - ! mixing at higher interfaces. It is an approximation to the more - ! complete test dPEc_dKd_Kd0 >= 0.0, that would include the effects of - ! mixing across interface K-1. The dT_to_dColHt here are effectively - ! mass-weigted estimates of dSV_dT. - Convectively_stable = ( 0.0 <= & - ( (dT_to_dColHt(i,k) + dT_to_dColHt(i,k-1) ) * (T0(k-1)-T0(k)) + & - (dS_to_dColHt(i,k) + dS_to_dColHt(i,k-1) ) * (S0(k-1)-S0(k)) ) ) - - if ((mech_TKE(i) + conv_PErel(i)) <= 0.0 .and. Convectively_stable) then - ! Energy is already exhausted, so set Kd = 0 and cycle or exit? - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - Kd(i,K) = 0.0 ; Kddt_h(K) = 0.0 - sfc_disconnect = .true. - ! if (.not.debug) exit - - ! The estimated properties for layer k-1 can be calculated, using - ! greatly simplified expressions when Kddt_h = 0. This enables the - ! tridiagonal solver for the whole column to be completed for debugging - ! purposes, and also allows for something akin to convective adjustment - ! in unstable interior regions? - b1 = 1.0 / hp_a(i) - c1(K) = 0.0 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( dTe_t2 ) - dSe(k-1) = b1 * ( dSe_t2 ) - endif - hp_a(i) = h(i,k) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) - - else ! tot_TKE > 0.0 or this is a potentially convectively unstable profile. - sfc_disconnect = .false. - - ! Precalculate some more temporary expressions that are independent of - ! Kddt_h(K). - if (CS%orig_PE_calc) then - if (K==2) then - dT_km1_t2 = (T0(k)-T0(k-1)) - dS_km1_t2 = (S0(k)-S0(k-1)) + MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) + + ! This block checks out different cases to determine Kd at the present interface. + if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then + ! This column is convectively unstable. + if (PE_chg_max <= 0.0) then + ! Does MKE_src need to be included in the calculation of vstar here? + TKE_here = mech_TKE + CS%wstar_ustar_coef*(conv_PErel-PE_chg_max) + if (TKE_here > 0.0) then + if (CS%wT_scheme==wT_from_cRoot_TKE) then + vstar = CS%vstar_scale_fac * vstar_unit_scale * (I_dtrho*TKE_here)**C1_3 + elseif (CS%wT_scheme==wT_from_RH18) then + Surface_Scale = max(0.05, 1. - htot/MLD_guess) + vstar = CS%vstar_scale_fac * Surface_Scale * (CS%vstar_surf_fac*u_star + & + vstar_unit_scale * (CS%wstar_ustar_coef*conv_PErel*I_dtrho)**C1_3) + endif + hbs_here = GV%H_to_Z * min(hb_hs(K), MixLen_shape(K)) + mixlen(K) = max(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar)) + if (.not.CS%Use_MLD_iteration) then + ! Note again (as prev) that using mixlen here + ! instead of redoing the computation will change answers... + Kd(K) = vstar * CS%vonKar * ((h_tt*hbs_here)*vstar) / & + ((CS%Ekman_scale_coef * absf) * (h_tt*hbs_here) + vstar) + else + Kd(K) = vstar * CS%vonKar * mixlen(K) + endif else - dT_km1_t2 = (T0(k)-T0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((T0(k-2) - T0(k-1)) + dTe(k-2)) - dS_km1_t2 = (S0(k)-S0(k-1)) - & - (Kddt_h(K-1) / hp_a(i)) * ((S0(k-2) - S0(k-1)) + dSe(k-2)) + vstar = 0.0 ; Kd(K) = 0.0 endif - dTe_term = dTe_t2 + hp_a(i) * (T0(k-1)-T0(k)) - dSe_term = dSe_t2 + hp_a(i) * (S0(k-1)-S0(k)) - else - if (K<=2) then - Th_a(k-1) = h(i,k-1) * T0(k-1) ; Sh_a(k-1) = h(i,k-1) * S0(k-1) + mixvel(K) = vstar + + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kd(K)*dt_h, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=dPE_conv) else - Th_a(k-1) = h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2) - Sh_a(k-1) = h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2) - endif - Th_b(k) = h(i,k) * T0(k) ; Sh_b(k) = h(i,k) * S0(k) - endif - - ! Using Pr=1 and the diffusivity at the bottom interface (once it is - ! known), determine how much resolved mean kinetic energy (MKE) will be - ! extracted within a timestep and add a fraction CS%MKE_to_TKE_effic of - ! this to the mTKE budget available for mixing in the next layer. - - if ((CS%MKE_to_TKE_effic > 0.0) .and. (htot(i)*h(i,k) > 0.0)) then - ! This is the energy that would be available from homogenizing the - ! velocities between layer k and the layers above. - dMKE_max = (GV%H_to_kg_m2 * CS%MKE_to_TKE_effic) * 0.5 * & - (h(i,k) / ((htot(i) + h(i,k))*htot(i))) * & - ((uhtot(i)-u(i,k)*htot(i))**2 + (vhtot(i)-v(i,k)*htot(i))**2) - ! A fraction (1-exp(Kddt_h*MKE2_Hharm)) of this energy would be - ! extracted by mixing with a finite viscosity. - MKE2_Hharm = (htot(i) + h(i,k) + 2.0*h_neglect) / & - ((htot(i)+h_neglect) * (h(i,k)+h_neglect)) - else - dMKE_max = 0.0 ; MKE2_Hharm = 0.0 - endif - - ! At this point, Kddt_h(K) will be unknown because its value may depend - ! on how much energy is available. mech_TKE might be negative due to - ! contributions from TKE_forced. - h_tt = htot(i) + h_tt_min - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*conv_PErel(i) - if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = CS%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale + call find_PE_chg(0.0, Kd(K)*dt_h, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = MAX(CS%min_mix_len, ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - !Note setting Kd_guess0 to Mixing_Length_Used(K) here will - ! change the answers. Therefore, skipping that. - if (.not.CS%Use_MLD_Iteration) then - Kd_guess0 = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) + ! Should this be iterated to convergence for Kd? + if (dPE_conv > 0.0) then + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 else - Kd_guess0 = vstar * vonKar * Mixing_Length_Used(k) + MKE_src = dMKE_max*(1.0 - exp(-(Kd(K)*dt_h) * MKE2_Hharm)) endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd_guess0 = Kd_guess0 * Shape_Function / Max_Shape_Function - endif - else - vstar = 0.0 ; Kd_guess0 = 0.0 - endif - Vstar_Used(k) = vstar ! Track vstar - Kddt_h_g0 = Kd_guess0*dt_h - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_g0, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) else - call find_PE_chg(0.0, Kddt_h_g0, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=PE_chg_g0, dPEc_dKd=dPEa_dKd_g0, dPE_max=PE_chg_max, & - dPEc_dKd_0=dPEc_dKd_Kd0 ) + ! The energy change does not vary monotonically with Kddt_h. Find the maximum? + Kd(K) = Kd_guess0 ; dPE_conv = PE_chg_g0 endif - MKE_src = dMKE_max*(1.0 - exp(-Kddt_h_g0 * MKE2_Hharm)) + conv_PErel = conv_PErel - dPE_conv + mech_TKE = mech_TKE + MKE_src + if (CS%TKE_diagnostics) then + eCD%dTKE_conv = eCD%dTKE_conv - CS%nstar*dPE_conv * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + endif + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) + endif - if (pe_chg_g0 > 0.0) then - !Negative buoyancy (increases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_NEG - else - !Positive buoyancy (decreases PE) - N2_dissipation = 1.+CS%N2_DISSIPATION_SCALE_POS + Kddt_h(K) = Kd(K) * dt_h + elseif (tot_TKE + (MKE_src - PE_chg_g0) >= 0.0) then + ! This column is convctively stable and there is energy to support the suggested + ! mixing. Keep that estimate. + Kd(K) = Kd_guess0 + Kddt_h(K) = Kddt_h_g0 + + ! Reduce the mechanical and convective TKE proportionately. + tot_TKE = tot_TKE + MKE_src + TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. + if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - PE_chg_g0) / tot_TKE + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - PE_chg_g0 * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel * I_dtdiag + endif + tot_TKE = TKE_reduc*tot_TKE + mech_TKE = TKE_reduc*(mech_TKE + MKE_src) + conv_PErel = TKE_reduc*conv_PErel + if (sfc_connected) then + MLD_output = MLD_output + GV%H_to_Z * h(k) endif - if ((PE_chg_g0 < 0.0) .or. ((vstar == 0.0) .and. (dPEc_dKd_Kd0 < 0.0))) then - ! This column is convectively unstable. - if (PE_chg_max <= 0.0) then - ! Does MKE_src need to be included in the calculation of vstar here? - TKE_here = mech_TKE(i) + CS%wstar_ustar_coef*(conv_PErel(i)-PE_chg_max) - if (TKE_here > 0.0) then - if (CS%vstar_mode==0) then - vstar = CS%vstar_scale_fac * (I_dtrho*TKE_here)**C1_3 - elseif (CS%vstar_mode==1) then - Surface_Scale = max(0.05,1.-htot(i)/MLD_guess) - vstar = cs%vstar_scale_fac * (CS%vstar_surf_fac*U_Star + & - (CS%wstar_ustar_coef*conv_PErel(i)*I_dtrho)**C1_3)* & - Surface_Scale - endif - hbs_here = GV%H_to_Z * min(hb_hs(i,K), MixLen_shape(K)) - Mixing_Length_Used(k) = max(CS%min_mix_len,((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar)) - if (.not.CS%Use_MLD_Iteration) then - ! Note again (as prev) that using Mixing_Length_Used here - ! instead of redoing the computation will change answers... - Kd(i,k) = vstar * vonKar * ((h_tt*hbs_here)*vstar) / & - ((CS%Ekman_scale_coef * absf(i)) * (h_tt*hbs_here) + vstar) - else - Kd(i,k) = vstar * vonKar * Mixing_Length_Used(k) - endif - ! Compute the local enhnacement of K (perhaps due to Langmuir) - if (CS%LT_ENH_K_R16) then - Shape_Function = htot(i)/MLD_guess*(1.-htot(i)/MLD_guess)**2 - K_Enhancement = ( min( Max_K_Enhancement,1.+1./La ) - 1. ) - Kd(i,k) = Kd(i,K) * Shape_Function / Max_Shape_Function - endif - else - vstar = 0.0 ; Kd(i,k) = 0.0 - endif - Vstar_Used(k) = vstar - - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kd(i,k)*dt_h, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=dPE_conv) - else - call find_PE_chg(0.0, Kd(i,k)*dt_h, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) - endif - ! Should this be iterated to convergence for Kd? - if (dPE_conv > 0.0) then - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - else - MKE_src = dMKE_max*(1.0 - exp(-(Kd(i,k)*dt_h) * MKE2_Hharm)) - endif + elseif (tot_TKE == 0.0) then + ! This can arise if nstar_FC = 0, but it is not common. + Kd(K) = 0.0 ; Kddt_h(K) = 0.0 + tot_TKE = 0.0 ; conv_PErel = 0.0 ; mech_TKE = 0.0 + sfc_disconnect = .true. + else + ! There is not enough energy to support the mixing, so reduce the + ! diffusivity to what can be supported. + Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 + TKE_left_max = tot_TKE + (MKE_src - PE_chg_g0) + TKE_left_min = tot_TKE + + ! As a starting guess, take the minimum of a false position estimate + ! and a Newton's method estimate starting from Kddt_h = 0.0. + Kddt_h_guess = tot_TKE * Kddt_h_max / max( PE_chg_g0 - MKE_src, & + Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + ! The above expression is mathematically the same as the following + ! except it is not susceptible to division by zero when + ! dPEc_dKd_Kd0 = dMKE_max = 0 . + ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & + ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) + if (debug) then + TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 + MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 + endif + do itt=1,max_itt + if (CS%orig_PE_calc) then + call find_PE_chg_orig(Kddt_h_guess, h(k), hp_a, dTe_term, dSe_term, & + dT_km1_t2, dS_km1_t2, dT_to_dPE(k), dS_to_dPE(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), & + pres_Z(K), dT_to_dColHt(k), dS_to_dColHt(k), & + dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) else - ! The energy change does not vary monotonically with Kddt_h. Find the maximum? - Kd(i,k) = Kd_guess0 ; dPE_conv = PE_chg_g0 - endif - conv_PErel(i) = conv_PErel(i) - dPE_conv - mech_TKE(i) = mech_TKE(i) + MKE_src - if (CS%TKE_diagnostics) then - dTKE_conv = dTKE_conv - CS%nstar*dPE_conv * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - endif - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,j) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) - endif - - Kddt_h(K) = Kd(i,k)*dt_h - elseif (tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) >= 0.0) then - ! There is energy to support the suggested mixing. Keep that estimate. - Kd(i,k) = Kd_guess0 - Kddt_h(K) = Kddt_h_g0 - - ! Reduce the mechanical and convective TKE proportionately. - tot_TKE = tot_TKE + MKE_src - TKE_reduc = 0.0 ! tot_TKE could be 0 if Convectively_stable is false. - if (tot_TKE > 0.0) TKE_reduc = (tot_TKE - N2_DISSIPATION*PE_chg_g0) & - / tot_TKE - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - PE_chg_g0 * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (1.0-TKE_reduc)*(CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + call find_PE_chg(0.0, Kddt_h_guess, hp_a, h(k), & + Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & + dT_to_dPE_a(k-1), dS_to_dPE_a(k-1), dT_to_dPE(k), dS_to_dPE(k), & + pres_Z(K), dT_to_dColHt_a(k-1), dS_to_dColHt_a(k-1), & + dT_to_dColHt(k), dS_to_dColHt(k), & + PE_chg=dPE_conv) endif - tot_TKE = TKE_reduc*tot_TKE - mech_TKE(i) = TKE_reduc*(mech_TKE(i) + MKE_src) - conv_PErel(i) = TKE_reduc*conv_PErel(i) - if (sfc_connected(i)) then - CS%ML_depth(i,J) = CS%ML_depth(i,J) + GV%H_to_Z * h(i,k) - ! CS%ML_depth2(i,J) = CS%ML_depth2(i,J) + GV%H_to_Z * h(i,k) + MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) + dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) + + TKE_left = tot_TKE + (MKE_src - PE_chg) + if (debug .and. itt<=20) then + Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src + PE_chg_itt(itt) = PE_chg ; dPEa_dKd_itt(itt) = dPEc_dKd + TKE_left_itt(itt) = TKE_left endif - elseif (tot_TKE == 0.0) then - ! This can arise if nstar_FC = 0. - Kd(i,k) = 0.0 ; Kddt_h(K) = 0.0 - tot_TKE = 0.0 ; conv_PErel(i) = 0.0 ; mech_TKE(i) = 0.0 - sfc_disconnect = .true. - else - ! There is not enough energy to support the mixing, so reduce the - ! diffusivity to what can be supported. - Kddt_h_max = Kddt_h_g0 ; Kddt_h_min = 0.0 - TKE_left_max = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg_g0) - TKE_left_min = tot_TKE - - ! As a starting guess, take the minimum of a false position estimate - ! and a Newton's method estimate starting from Kddt_h = 0.0. - Kddt_h_guess = tot_TKE * Kddt_h_max / max( N2_DISSIPATION*PE_chg_g0 & - - MKE_src, Kddt_h_max * (dPEc_dKd_Kd0 - dMKE_max * & - MKE2_Hharm) ) - ! The above expression is mathematically the same as the following - ! except it is not susceptible to division by zero when - ! dPEc_dKd_Kd0 = dMKE_max = 0 . - ! Kddt_h_guess = tot_TKE * min( Kddt_h_max / (PE_chg_g0 - MKE_src), & - ! 1.0 / (dPEc_dKd_Kd0 - dMKE_max * MKE2_Hharm) ) - if (debug) then - TKE_left_itt(:) = 0.0 ; dPEa_dKd_itt(:) = 0.0 ; PE_chg_itt(:) = 0.0 - MKE_src_itt(:) = 0.0 ; Kddt_h_itt(:) = 0.0 + ! Store the new bounding values, bearing in mind that min and max + ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: + if (TKE_left >= 0.0) then + Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left + else + Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left endif - do itt=1,max_itt - if (CS%orig_PE_calc) then - call find_PE_chg_orig(Kddt_h_guess, h(i,k), hp_a(i), dTe_term, dSe_term, & - dT_km1_t2, dS_km1_t2, dT_to_dPE(i,k), dS_to_dPE(i,k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), & - pres_Z(i,K), dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - PE_chg=PE_chg, dPEc_dKd=dPEc_dKd ) - else - call find_PE_chg(0.0, Kddt_h_guess, hp_a(i), h(i,k), & - Th_a(k-1), Sh_a(k-1), Th_b(k), Sh_b(k), & - dT_to_dPE_a(i,k-1), dS_to_dPE_a(i,k-1), dT_to_dPE(i,k), dS_to_dPE(i,k), & - pres_Z(i,K), dT_to_dColHt_a(i,k-1), dS_to_dColHt_a(i,k-1), & - dT_to_dColHt(i,k), dS_to_dColHt(i,k), & - PE_chg=dPE_conv) - endif - MKE_src = dMKE_max * (1.0 - exp(-MKE2_Hharm * Kddt_h_guess)) - dMKE_src_dK = dMKE_max * MKE2_Hharm * exp(-MKE2_Hharm * Kddt_h_guess) - - TKE_left = tot_TKE + (MKE_src - N2_DISSIPATION*PE_chg) - if (debug) then - Kddt_h_itt(itt) = Kddt_h_guess ; MKE_src_itt(itt) = MKE_src - PE_chg_itt(itt) = N2_DISSIPATION*PE_chg - TKE_left_itt(itt) = TKE_left - dPEa_dKd_itt(itt) = dPEc_dKd - endif - ! Store the new bounding values, bearing in mind that min and max - ! here refer to Kddt_h and dTKE_left/dKddt_h < 0: - if (TKE_left >= 0.0) then - Kddt_h_min = Kddt_h_guess ; TKE_left_min = TKE_left - else - Kddt_h_max = Kddt_h_guess ; TKE_left_max = TKE_left - endif - ! Try to use Newton's method, but if it would go outside the bracketed - ! values use the false-position method instead. - use_Newt = .true. - if (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK <= 0.0) then + ! Try to use Newton's method, but if it would go outside the bracketed + ! values use the false-position method instead. + use_Newt = .true. + if (dPEc_dKd - dMKE_src_dK <= 0.0) then + use_Newt = .false. + else + dKddt_h_Newt = TKE_left / (dPEc_dKd - dMKE_src_dK) + Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt + if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & use_Newt = .false. - else - dKddt_h_Newt = TKE_left / (dPEc_dKd*N2_DISSIPATION - dMKE_src_dK) - Kddt_h_Newt = Kddt_h_guess + dKddt_h_Newt - if ((Kddt_h_Newt > Kddt_h_max) .or. (Kddt_h_Newt < Kddt_h_min)) & - use_Newt = .false. - endif - - if (use_Newt) then - Kddt_h_next = Kddt_h_guess + dKddt_h_Newt - dKddt_h = dKddt_h_Newt - else - Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & - (TKE_left_max - TKE_left_min) - dKddt_h = Kddt_h_next - Kddt_h_guess - endif + endif - if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then - ! Use the old value so that the energy calculation does not need to be repeated. - if (debug) num_itts(K) = itt - exit - else - Kddt_h_guess = Kddt_h_next - endif - enddo - Kd(i,K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(i,K)*dt_h - - ! All TKE should have been consumed. - if (CS%TKE_diagnostics) then - dTKE_mixing = dTKE_mixing - (tot_TKE + MKE_src) * IdtdR0 - dTKE_MKE = dTKE_MKE + MKE_src * IdtdR0 - dTKE_conv_decay = dTKE_conv_decay + & - (CS%nstar-nstar_FC) * conv_PErel(i) * IdtdR0 + if (use_Newt) then + Kddt_h_next = Kddt_h_guess + dKddt_h_Newt + dKddt_h = dKddt_h_Newt + else + Kddt_h_next = (TKE_left_max * Kddt_h_min - Kddt_h_max * TKE_left_min) / & + (TKE_left_max - TKE_left_min) + dKddt_h = Kddt_h_next - Kddt_h_guess endif - if (sfc_connected(i)) CS%ML_depth(i,J) = CS%ML_depth(i,J) + & - (PE_chg / PE_chg_g0) * GV%H_to_Z * h(i,k) - tot_TKE = 0.0 ; mech_TKE(i) = 0.0 ; conv_PErel(i) = 0.0 - sfc_disconnect = .true. + if ((abs(dKddt_h) < 1e-9*Kddt_h_guess) .or. (itt==max_itt)) then + ! Use the old value so that the energy calculation does not need to be repeated. + if (debug) num_itts(K) = itt + exit + else + Kddt_h_guess = Kddt_h_next + endif + enddo ! Inner iteration loop on itt. + Kd(K) = Kddt_h_guess / dt_h ; Kddt_h(K) = Kd(K) * dt_h + + ! All TKE should have been consumed. + if (CS%TKE_diagnostics) then + eCD%dTKE_mixing = eCD%dTKE_mixing - (tot_TKE + MKE_src) * I_dtdiag + eCD%dTKE_MKE = eCD%dTKE_MKE + MKE_src * I_dtdiag + eCD%dTKE_conv_decay = eCD%dTKE_conv_decay + & + (CS%nstar-nstar_FC) * conv_PErel * I_dtdiag endif - Kddt_h(K) = Kd(i,K)*dt_h - ! At this point, the final value of Kddt_h(K) is known, so the - ! estimated properties for layer k-1 can be calculated. - b1 = 1.0 / (hp_a(i) + Kddt_h(K)) - c1(K) = Kddt_h(K) * b1 - if (CS%orig_PE_calc) then - dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) - dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) - endif + if (sfc_connected) MLD_output = MLD_output + & + (PE_chg / (PE_chg_g0)) * GV%H_to_Z * h(k) - hp_a(i) = h(i,k) + (hp_a(i) * b1) * Kddt_h(K) - dT_to_dPE_a(i,k) = dT_to_dPE(i,k) + c1(K)*dT_to_dPE_a(i,k-1) - dS_to_dPE_a(i,k) = dS_to_dPE(i,k) + c1(K)*dS_to_dPE_a(i,k-1) - dT_to_dColHt_a(i,k) = dT_to_dColHt(i,k) + c1(K)*dT_to_dColHt_a(i,k-1) - dS_to_dColHt_a(i,k) = dS_to_dColHt(i,k) + c1(K)*dS_to_dColHt_a(i,k-1) - - endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. - - ! Store integrated velocities and thicknesses for MKE conversion calculations. - if (sfc_disconnect) then - ! There is no turbulence at this interface, so zero out the running sums. - uhtot(i) = u(i,k)*h(i,k) - vhtot(i) = v(i,k)*h(i,k) - htot(i) = h(i,k) - sfc_connected(i) = .false. - else - uhtot(i) = uhtot(i) + u(i,k)*h(i,k) - vhtot(i) = vhtot(i) + v(i,k)*h(i,k) - htot(i) = htot(i) + h(i,k) - endif + tot_TKE = 0.0 ; mech_TKE = 0.0 ; conv_PErel = 0.0 + sfc_disconnect = .true. + endif ! End of convective or forced mixing cases to determine Kd. - if (debug) then - if (k==2) then - Te(1) = b1*(h(i,1)*T0(1)) - Se(1) = b1*(h(i,1)*S0(1)) - else - Te(k-1) = b1 * (h(i,k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) - Se(k-1) = b1 * (h(i,k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) - endif + Kddt_h(K) = Kd(K) * dt_h + ! At this point, the final value of Kddt_h(K) is known, so the + ! estimated properties for layer k-1 can be calculated. + b1 = 1.0 / (hp_a + Kddt_h(K)) + c1(K) = Kddt_h(K) * b1 + if (CS%orig_PE_calc) then + dTe(k-1) = b1 * ( Kddt_h(K)*(T0(k)-T0(k-1)) + dTe_t2 ) + dSe(k-1) = b1 * ( Kddt_h(K)*(S0(k)-S0(k-1)) + dSe_t2 ) endif - enddo - Kd(i,nz+1) = 0.0 - if (debug) then - ! Complete the tridiagonal solve for Te. - b1 = 1.0 / hp_a(i) - Te(nz) = b1 * (h(i,nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) - Se(nz) = b1 * (h(i,nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) - do k=nz-1,1,-1 - Te(k) = Te(k) + c1(K+1)*Te(k+1) - Se(k) = Se(k) + c1(K+1)*Se(k+1) - enddo - endif - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = Te(k) - T0(k) ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = Se(k) - S0(k) ; enddo + hp_a = h(k) + (hp_a * b1) * Kddt_h(K) + dT_to_dPE_a(k) = dT_to_dPE(k) + c1(K)*dT_to_dPE_a(k-1) + dS_to_dPE_a(k) = dS_to_dPE(k) + c1(K)*dS_to_dPE_a(k-1) + dT_to_dColHt_a(k) = dT_to_dColHt(k) + c1(K)*dT_to_dColHt_a(k-1) + dS_to_dColHt_a(k) = dS_to_dColHt(k) + c1(K)*dS_to_dColHt_a(k-1) + + endif ! tot_TKT > 0.0 branch. Kddt_h(K) has been set. + + ! Store integrated velocities and thicknesses for MKE conversion calculations. + if (sfc_disconnect) then + ! There is no turbulence at this interface, so zero out the running sums. + uhtot = u(k)*h(k) + vhtot = v(k)*h(k) + htot = h(k) + sfc_connected = .false. + else + uhtot = uhtot + u(k)*h(k) + vhtot = vhtot + v(k)*h(k) + htot = htot + h(k) endif + if (debug) then - dPE_debug = 0.0 - do k=1,nz - dPE_debug = dPE_debug + (dT_to_dPE(i,k) * (Te(k) - T0(k)) + & - dS_to_dPE(i,k) * (Se(k) - S0(k))) - enddo - mixing_debug = dPE_debug * IdtdR0 - endif - k = nz ! This is here to allow a breakpoint to be set. - !/BGR - ! The following lines are used for the iteration - ! note the iteration has been altered to use the value predicted by - ! the TKE threshold (ML_DEPTH). This is because the MSTAR - ! is now dependent on the ML, and therefore the ML needs to be estimated - ! more precisely than the grid spacing. - !/ - ITmax(obl_it) = max_MLD ! Track max } - ITmin(obl_it) = min_MLD ! Track min } For debug purpose - ITguess(obl_it) = MLD_guess ! Track guess } - !/ - MLD_found = 0.0 ; FIRST_OBL = .true. - if (CS%Orig_MLD_iteration) then - !This is how the iteration was original conducted - do k=2,nz - if (FIRST_OBL) then !Breaks when OBL found - if ((Vstar_Used(k) > 1.e-10*US%m_to_Z) .and. k < nz) then - MLD_found = MLD_found + h(i,k-1)*GV%H_to_Z - else - FIRST_OBL = .false. - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol,h(i,k-1)*GV%H_to_Z)) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess - else - max_MLD = MLD_guess !We know this guess was too deep - endif - endif - endif - enddo - else - !New method uses ML_DEPTH as computed in ePBL routine - MLD_found = CS%ML_Depth(i,j) - if (MLD_found - CS%MLD_tol > MLD_guess) then - min_MLD = MLD_guess - elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then - OBL_CONVERGED = .true.!Break convergence loop - if (OBL_IT_STATS) then !Compute iteration statistics - MAXIT = max(MAXIT,obl_it) - MINIT = min(MINIT,obl_it) - SUMIT = SUMIT+obl_it - NUMIT = NUMIT+1 - print*,MAXIT,MINIT,SUMIT/NUMIT - endif - CS%ML_Depth2(i,j) = MLD_guess + if (k==2) then + Te(1) = b1*(h(1)*T0(1)) + Se(1) = b1*(h(1)*S0(1)) else - max_MLD = MLD_guess !We know this guess was too deep + Te(k-1) = b1 * (h(k-1) * T0(k-1) + Kddt_h(K-1) * Te(k-2)) + Se(k-1) = b1 * (h(k-1) * S0(k-1) + Kddt_h(K-1) * Se(k-2)) endif endif - ! For next pass, guess average of minimum and maximum values. - MLD_guess = 0.5*(min_MLD + max_MLD) - ITresult(obl_it) = MLD_found - endif ; enddo ! Iteration loop for converged boundary layer thickness. - if (.not.OBL_CONVERGED) then - !/Temp output, warn that EPBL didn't converge - !/Print guess/found for every iteration step - !print*,'EPBL MLD DID NOT CONVERGE' - NOTCONVERGED=NOTCONVERGED+1 - !do obl_it=1,max_obl_it - ! print*,ITmin(obl_it),ITmax(obl_it) - ! print*,obl_it,ITguess(obl_it),ITresult(obl_it) - !enddo - !Activate to print out some output when not converged - !{ - !print*,'Min/Max: ',ITmin(50),ITmax(50) - !print*,'Guess/result: ',ITguess(50),ITresult(50) - !print*,'Stats on CPU: ',CONVERGED,NOTCONVERGED,& - ! real(NOTCONVERGED)/real(CONVERGED) - !} - !stop !Kill if not converged during testing. - else - CONVERGED=CONVERGED+1 - endif + enddo + Kd(nz+1) = 0.0 + + if (debug) then + ! Complete the tridiagonal solve for Te. + b1 = 1.0 / hp_a + Te(nz) = b1 * (h(nz) * T0(nz) + Kddt_h(nz) * Te(nz-1)) + Se(nz) = b1 * (h(nz) * S0(nz) + Kddt_h(nz) * Se(nz-1)) + eCD%dT_expect(nz) = Te(nz) - T0(nz) ; eCD%dS_expect(nz) = Se(nz) - S0(nz) + do k=nz-1,1,-1 + Te(k) = Te(k) + c1(K+1)*Te(k+1) + Se(k) = Se(k) + c1(K+1)*Se(k+1) + eCD%dT_expect(k) = Te(k) - T0(k) ; eCD%dS_expect(k) = Se(k) - S0(k) + enddo - if (CS%TKE_diagnostics) then - CS%diag_TKE_MKE(i,j) = CS%diag_TKE_MKE(i,j) + dTKE_MKE - CS%diag_TKE_conv(i,j) = CS%diag_TKE_conv(i,j) + dTKE_conv - CS%diag_TKE_forcing(i,j) = CS%diag_TKE_forcing(i,j) + dTKE_forcing - CS%diag_TKE_mixing(i,j) = CS%diag_TKE_mixing(i,j) + dTKE_mixing - CS%diag_TKE_mech_decay(i,j) = CS%diag_TKE_mech_decay(i,j) + dTKE_mech_decay - CS%diag_TKE_conv_decay(i,j) = CS%diag_TKE_conv_decay(i,j) + dTKE_conv_decay - ! CS%diag_TKE_unbalanced_forcing(i,j) = CS%diag_TKE_unbalanced_forcing(i,j) + dTKE_unbalanced - endif - if (CS%Mixing_Diagnostics) then - !Write to 3-D for outputing Mixing length and - ! velocity scale. + dPE_debug = 0.0 do k=1,nz - CS%Mixing_Length(i,j,k) = Mixing_Length_Used(k) - CS%Velocity_Scale(i,j,k) = Vstar_Used(k) + dPE_debug = dPE_debug + (dT_to_dPE(k) * (Te(k) - T0(k)) + & + dS_to_dPE(k) * (Se(k) - S0(k))) enddo + mixing_debug = dPE_debug * I_dtdiag endif - if (allocated(CS%Enhance_M)) CS%Enhance_M(i,j) = Enhance_M - if (allocated(CS%mstar_mix)) CS%mstar_mix(i,j) = MSTAR_MIX - if (allocated(CS%mstar_lt)) CS%mstar_lt(i,j) = MSTAR_LT - if (allocated(CS%MLD_Obukhov)) CS%MLD_Obukhov(i,j) = MLD_guess * iL_Obukhov - if (allocated(CS%MLD_Ekman)) CS%MLD_Ekman(i,j) = MLD_guess * iL_Ekman - if (allocated(CS%Ekman_Obukhov)) CS%Ekman_Obukhov(i,j) = iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m) - if (allocated(CS%La)) CS%La(i,j) = LA - if (allocated(CS%La_mod)) CS%La_mod(i,j) = LAmod - else ! End of the ocean-point part of the i-loop - ! For masked points, Kd_int must still be set (to 0) because it has intent out. - do K=1,nz+1 - Kd(i,K) = 0. - enddo - if (present(dT_expected)) then - do k=1,nz ; dT_expected(i,j,k) = 0.0 ; enddo - endif - if (present(dS_expected)) then - do k=1,nz ; dS_expected(i,j,k) = 0.0 ; enddo + k = nz ! This is here to allow a breakpoint to be set. + !/BGR + ! The following lines are used for the iteration + ! note the iteration has been altered to use the value predicted by + ! the TKE threshold (ML_DEPTH). This is because the MSTAR + ! is now dependent on the ML, and therefore the ML needs to be estimated + ! more precisely than the grid spacing. + if (CS%Orig_MLD_iteration) then + ! This is how the iteration was originally conducted + MLD_found = 0.0 ; FIRST_OBL = .true. + do k=2,nz + if (FIRST_OBL) then ! Breaks when OBL found + if ((mixvel(K) > 1.e-10*US%m_to_Z*US%T_to_s) .and. k < nz) then + MLD_found = MLD_found + h(k-1)*GV%H_to_Z + else + FIRST_OBL = .false. + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif ((MLD_guess - MLD_found) < max(CS%MLD_tol, h(k-1)*GV%H_to_Z)) then + OBL_converged = .true. ! Break convergence loop + else + max_MLD = MLD_guess ! We know this guess was too deep + endif + endif + endif + enddo + else + !New method uses ML_DEPTH as computed in ePBL routine + MLD_found = MLD_output + if (MLD_found - CS%MLD_tol > MLD_guess) then + min_MLD = MLD_guess + elseif (abs(MLD_guess - MLD_found) < CS%MLD_tol) then + OBL_converged = .true. ! Break convergence loop + else + max_MLD = MLD_guess ! We know this guess was too deep + endif endif - endif ; enddo ! Close of i-loop - Note unusual loop order! - - if (CS%id_Hsfc_used > 0) then - do i=is,ie ; Hsfc_used(i,j) = h(i,1)*GV%H_to_Z ; enddo - do k=2,nz ; do i=is,ie - if (Kd(i,K) > 0.0) Hsfc_used(i,j) = Hsfc_used(i,j) + h(i,k)*GV%H_to_Z - enddo ; enddo + ! For next pass, guess average of minimum and maximum values. + !### We should try using the false position method instead of simple bisection. + MLD_guess = 0.5*(min_MLD + max_MLD) endif - - do K=1,nz+1 ; do i=is,ie - Kd_int(i,j,K) = Kd(i,K) - enddo ; enddo - - enddo ! j-loop - - if (write_diags) then - if (CS%id_ML_depth > 0) & - call post_data(CS%id_ML_depth, CS%ML_depth, CS%diag) - if (CS%id_TKE_wind > 0) & - call post_data(CS%id_TKE_wind, CS%diag_TKE_wind, CS%diag) - if (CS%id_TKE_MKE > 0) & - call post_data(CS%id_TKE_MKE, CS%diag_TKE_MKE, CS%diag) - if (CS%id_TKE_conv > 0) & - call post_data(CS%id_TKE_conv, CS%diag_TKE_conv, CS%diag) - if (CS%id_TKE_forcing > 0) & - call post_data(CS%id_TKE_forcing, CS%diag_TKE_forcing, CS%diag) - if (CS%id_TKE_mixing > 0) & - call post_data(CS%id_TKE_mixing, CS%diag_TKE_mixing, CS%diag) - if (CS%id_TKE_mech_decay > 0) & - call post_data(CS%id_TKE_mech_decay, CS%diag_TKE_mech_decay, CS%diag) - if (CS%id_TKE_conv_decay > 0) & - call post_data(CS%id_TKE_conv_decay, CS%diag_TKE_conv_decay, CS%diag) - if (CS%id_Hsfc_used > 0) & - call post_data(CS%id_Hsfc_used, Hsfc_used, CS%diag) - if (CS%id_Mixing_Length > 0) & - call post_data(CS%id_Mixing_Length, CS%Mixing_Length, CS%diag) - if (CS%id_Velocity_Scale >0) & - call post_data(CS%id_Velocity_Scale, CS%Velocity_Scale, CS%diag) - if (CS%id_OSBL >0) & - call post_data(CS%id_OSBL, CS%ML_Depth2, CS%diag) - if (CS%id_LT_Enhancement >0) & - call post_data(CS%id_LT_Enhancement, CS%Enhance_M, CS%diag) - if (CS%id_MSTAR_MIX >0) & - call post_data(CS%id_MSTAR_MIX, CS%MSTAR_MIX, CS%diag) - if (CS%id_MLD_OBUKHOV >0) & - call post_data(CS%id_MLD_Obukhov, CS%MLD_OBUKHOV, CS%diag) - if (CS%id_MLD_EKMAN >0) & - call post_data(CS%id_MLD_Ekman, CS%MLD_EKMAN, CS%diag) - if (CS%id_Ekman_Obukhov >0) & - call post_data(CS%id_Ekman_Obukhov, CS%Ekman_Obukhov, CS%diag) - if (CS%id_LA >0) & - call post_data(CS%id_LA, CS%LA, CS%diag) - if (CS%id_LA_MOD >0) & - call post_data(CS%id_LA_MOD, CS%LA_MOD, CS%diag) - if (CS%id_MSTAR_LT > 0) & - call post_data(CS%id_MSTAR_LT, CS%MSTAR_LT, CS%diag) + enddo ! Iteration loop for converged boundary layer thickness. + if (CS%Use_LT) then + eCD%LA = LA ; eCD%LAmod = LAmod ; eCD%mstar = mstar_total ; eCD%mstar_LT = mstar_LT + else + eCD%LA = 0.0 ; eCD%LAmod = 0.0 ; eCD%mstar = mstar_total ; eCD%mstar_LT = 0.0 endif -end subroutine energetic_PBL + MLD_io = MLD_output + +end subroutine ePBL_column !> This subroutine calculates the change in potential energy and or derivatives !! for several changes in an interfaces's diapycnal diffusivity times a timestep. @@ -1641,27 +1483,27 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! above, including implicit mixing effects with other !! yet higher layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Th_b !< An effective temperature times a thickness in the layer - !! below, including implicit mixing effects with other + !! below, including implicit mixfing effects with other !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: Sh_b !< An effective salinity times a thickness in the layer !! below, including implicit mixing effects with other !! yet lower layers [degC H ~> degC m or degC kg m-2]. real, intent(in) :: dT_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_a !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_b !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: pres_Z !< The rescaled hydrostatic interface pressure, which relates !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. @@ -1683,27 +1525,28 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & !! in the salinities of all the layers below [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h !! [J m-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: ColHt_cor !< The correction to PE_chg that is made due to a net - !! change in the column height [J m-2]. + !! change in the column height [kg m-3 Z3 T-2 ~> J m-2]. real :: hps ! The sum of the two effective pivot thicknesses [H ~> m or kg m-2]. real :: bdt1 ! A product of the two pivot thicknesses plus a diffusive term [H2 ~> m2 or kg2 m-4]. real :: dT_c ! The core term in the expressions for the temperature changes [degC H2 ~> degC m2 or degC kg2 m-4]. real :: dS_c ! The core term in the expressions for the salinity changes [ppt H2 ~> ppt m2 or ppt kg2 m-4]. real :: PEc_core ! The diffusivity-independent core term in the expressions - ! for the potential energy changes [J m-3]. + ! for the potential energy changes [kg m-3 Z2 T-2 ~> J m-3]. real :: ColHt_core ! The diffusivity-independent core term in the expressions - ! for the column height changes [J m-3]. + ! for the column height changes [H Z ~> m2 or kg m-1]. real :: ColHt_chg ! The change in the column height [H ~> m or kg m-2]. - real :: y1 ! A local temporary term, [H-3 ~> m-3 or m6 kg-3] or [H-4 ~> m-4 or m8 kg-4] in various contexts. + real :: y1_3 ! A local temporary term in [H-3 ~> m-3 or m6 kg-3]. + real :: y1_4 ! A local temporary term in [H-4 ~> m-4 or m8 kg-4]. ! The expression for the change in potential energy used here is derived ! from the expression for the final estimates of the changes in temperature @@ -1725,37 +1568,37 @@ subroutine find_PE_chg(Kddt_h0, dKddt_h, hp_a, hp_b, Th_a, Sh_a, Th_b, Sh_b, & if (present(PE_chg)) then ! Find the change in column potential energy due to the change in the ! diffusivity at this interface by dKddt_h. - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - PE_chg = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + PE_chg = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) PE_chg = PE_chg - pres_Z * ColHt_chg if (present(ColHt_cor)) ColHt_cor = -pres_Z * min(ColHt_chg, 0.0) elseif (present(ColHt_cor)) then - y1 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) - ColHt_cor = -pres_Z * min(ColHt_core * y1, 0.0) + y1_3 = dKddt_h / (bdt1 * (bdt1 + dKddt_h * hps)) + ColHt_cor = -pres_Z * min(ColHt_core * y1_3, 0.0) endif if (present(dPEc_dKd)) then ! Find the derivative of the potential energy change with dKddt_h. - y1 = 1.0 / (bdt1 + dKddt_h * hps)**2 - dPEc_dKd = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / (bdt1 + dKddt_h * hps)**2 + dPEc_dKd = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd = dPEc_dKd - pres_Z * ColHt_chg endif if (present(dPE_max)) then ! This expression is the limit of PE_chg for infinite dKddt_h. - y1 = 1.0 / (bdt1 * hps) - dPE_max = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_3 = 1.0 / (bdt1 * hps) + dPE_max = PEc_core * y1_3 + ColHt_chg = ColHt_core * y1_3 if (ColHt_chg < 0.0) dPE_max = dPE_max - pres_Z * ColHt_chg endif if (present(dPEc_dKd_0)) then ! This expression is the limit of dPEc_dKd for dKddt_h = 0. - y1 = 1.0 / bdt1**2 - dPEc_dKd_0 = PEc_core * y1 - ColHt_chg = ColHt_core * y1 + y1_4 = 1.0 / bdt1**2 + dPEc_dKd_0 = PEc_core * y1_4 + ColHt_chg = ColHt_core * y1_4 if (ColHt_chg < 0.0) dPEc_dKd_0 = dPEc_dKd_0 - pres_Z * ColHt_chg endif @@ -1789,25 +1632,25 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! the changes in column thickness to the energy that is radiated !! as gravity waves and unavailable to drive mixing [J m-2 Z-1 ~> J m-3]. real, intent(in) :: dT_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers below [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers below [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPE_k !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers below [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! in the salinities of all the layers below [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dT) relating - !! a layer's temperature change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the temperatures of all the layers above [J m-2 degC-1]. + !! a layer's temperature change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! temperatures of all the layers above [kg m-3 Z3 T-2 degC-1 ~> J m-2 degC-1]. real, intent(in) :: dS_to_dPEa !< A factor (pres_lay*mass_lay*dSpec_vol/dS) relating - !! a layer's salinity change to the change in column - !! potential energy, including all implicit diffusive changes - !! in the salinities of all the layers above [J m-2 ppt-1]. + !! a layer's salinity change to the change in column potential + !! energy, including all implicit diffusive changes in the + !! salinities of all the layers above [kg m-3 Z3 T-2 ppt-1 ~> J m-2 ppt-1]. real, intent(in) :: dT_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dT) relating !! a layer's temperature change to the change in column - !! height, including all implicit diffusive changes - !! in the temperatures of all the layers below [Z degC-1 ~> m degC-1]. + !! height, including all implicit diffusive changes in the + !! temperatures of all the layers below [Z degC-1 ~> m degC-1]. real, intent(in) :: dS_to_dColHt_k !< A factor (mass_lay*dSColHtc_vol/dS) relating !! a layer's salinity change to the change in column !! height, including all implicit diffusive changes @@ -1822,14 +1665,14 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & !! in the salinities of all the layers above [Z ppt-1 ~> m ppt-1]. real, optional, intent(out) :: PE_chg !< The change in column potential energy from applying - !! Kddt_h at the present interface [J m-2]. + !! Kddt_h at the present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd !< The partial derivative of PE_chg with Kddt_h - !! [J m-2 H-1 ~> J m-3 or J kg-1]. + !! [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. real, optional, intent(out) :: dPE_max !< The maximum change in column potential energy that could !! be realizedd by applying a huge value of Kddt_h at the - !! present interface [J m-2]. + !! present interface [kg m-3 Z3 T-2 ~> J m-2]. real, optional, intent(out) :: dPEc_dKd_0 !< The partial derivative of PE_chg with Kddt_h in the - !! limit where Kddt_h = 0 [J m-2 H-1 ~> J m-3 or J kg-1]. + !! limit where Kddt_h = 0 [kg m-3 Z3 T-2 H-1 ~> J m-3 or J kg-1]. ! This subroutine determines the total potential energy change due to mixing ! at an interface, including all of the implicit effects of the prescribed @@ -1916,13 +1759,184 @@ subroutine find_PE_chg_orig(Kddt_h, h_k, b_den_1, dTe_term, dSe_term, & end subroutine find_PE_chg_orig +!> This subroutine finds the Mstar value for ePBL +subroutine find_mstar(CS, US, Buoyancy_Flux, UStar, UStar_Mean,& + BLD, Abs_Coriolis, MStar, Langmuir_Number,& + MStar_LT, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: UStar !< ustar w/ gustiness [Z T-1 ~> m s-1] + real, intent(in) :: UStar_Mean !< ustar w/o gustiness [Z T-1 ~> m s-1] + real, intent(in) :: Abs_Coriolis !< abolute value of the Coriolis parameter [T-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(out) :: Mstar !< Ouput mstar (Mixing/ustar**3) [nondim] + real, optional, intent(in) :: Langmuir_Number !< Langmuir number [nondim] + real, optional, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] + real, optional, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] + + !/ Variables used in computing mstar + real :: MSN_term ! Temporary terms [nondim] + real :: MSCR_term1, MSCR_term2 ! Temporary terms [Z3 T-3 ~> m3 s-3] + real :: MStar_Conv_Red ! Adjustment made to mstar due to convection reducing mechanical mixing [nondim] + real :: MStar_S, MStar_N ! Mstar in (S)tabilizing/(N)ot-stabilizing buoyancy flux [nondim] + + !/ Integer options for how to find mstar + + !/ + + if (CS%mstar_scheme == Use_Fixed_MStar) then + MStar = CS%Fixed_MStar + !/ 1. Get mstar + elseif (CS%mstar_scheme == MStar_from_Ekman) then + + if (CS%answers_2018) then + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) + MStar_S = CS%MStar_coef*sqrt(max(0.0,Buoyancy_Flux) / Ustar**2 / & + (Abs_Coriolis + 1.e-10*US%T_to_s) ) + ! The limit for rotation (Ekman length) limited mixing + MStar_N = CS%C_Ek * log( max( 1., Ustar / (Abs_Coriolis + 1.e-10*US%T_to_s) / BLD ) ) + else + ! The limit for the balance of rotation and stabilizing is f(L_Ekman,L_Obukhov) + mstar_S = CS%MSTAR_COEF*sqrt(max(0.0, Buoyancy_Flux) / (Ustar**2 * max(Abs_Coriolis, 1.e-20*US%T_to_s))) + ! The limit for rotation (Ekman length) limited mixing + mstar_N = 0.0 + if (Ustar > Abs_Coriolis * BLD) mstar_N = CS%C_EK * log(Ustar / (Abs_Coriolis * BLD)) + endif + + ! Here 1.25 is about .5/von Karman, which gives the Obukhov limit. + MStar = max(MStar_S, min(1.25, MStar_N)) + if (CS%MStar_Cap > 0.0) MStar = min( CS%MStar_Cap,MStar ) + elseif ( CS%mstar_scheme == MStar_from_RH18 ) then + if (CS%answers_2018) then + MStar_N = CS%RH18_MStar_cn1 * ( 1.0 - 1.0 / ( 1. + CS%RH18_MStar_cn2 * & + exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / UStar) ) ) + else + MSN_term = CS%RH18_MStar_cn2 * exp( CS%RH18_mstar_CN3 * BLD * Abs_Coriolis / Ustar) + MStar_N = (CS%RH18_MStar_cn1 * MSN_term) / ( 1. + MSN_term) + endif + MStar_S = CS%RH18_MStar_CS1 * ( max(0.0, Buoyancy_Flux)**2 * BLD / & + ( Ustar**5 * max(Abs_Coriolis,1.e-20*US%T_to_s) ) )**CS%RH18_mstar_cs2 + MStar = MStar_N + MStar_S + endif + + !/ 2. Adjust mstar to account for convective turbulence + if (CS%answers_2018) then + MStar_Conv_Red = 1. - CS%MStar_Convect_coef * (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) / & + ( (-min(0.0,Buoyancy_Flux) + 1.e-10*US%T_to_s**3*US%m_to_Z**2) + & + 2.0 *MStar * Ustar**3 / BLD ) + else + MSCR_term1 = -BLD * min(0.0, Buoyancy_Flux) + MSCR_term2 = 2.0*MStar * Ustar**3 + MStar_Conv_Red = ((1.-CS%mstar_convect_coef) * MSCR_term1 + MSCR_term2) / (MSCR_term1 + MSCR_term2) + endif + + !/3. Combine various mstar terms to get final value + MStar = MStar * MStar_Conv_Red + + if (present(Langmuir_Number)) then + !### In this call, ustar was previously ustar_mean. Is this change deliberate? + call mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_number, mstar, & + mstar_LT, Convect_Langmuir_Number) + endif + +end subroutine Find_Mstar + +!> This subroutine modifies the Mstar value if the Langmuir number is present +subroutine Mstar_Langmuir(CS, US, abs_Coriolis, buoyancy_flux, ustar, BLD, Langmuir_Number, & + mstar, mstar_LT, Convect_Langmuir_Number) + type(energetic_PBL_CS), pointer :: CS !< Energetic_PBL control structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, intent(in) :: Abs_Coriolis !< Absolute value of the Coriolis parameter [T-1 ~> s-1] + real, intent(in) :: Buoyancy_Flux !< Buoyancy flux [Z2 T-3 ~> m2 s-3] + real, intent(in) :: UStar !< Surface friction velocity with? gustiness [Z T-1 ~> m s-1] + real, intent(in) :: BLD !< boundary layer depth [Z ~> m] + real, intent(inout) :: Mstar !< Input/output mstar (Mixing/ustar**3) [nondim] + real, intent(in) :: Langmuir_Number !< Langmuir number [nondim] + real, intent(out) :: MStar_LT !< Mstar increase due to Langmuir turbulence [nondim] + real, intent(out) :: Convect_Langmuir_number !< Langmuir number including buoyancy flux [nondim] + + !/ + real, parameter :: Max_ratio = 1.0e16 ! The maximum value of a nondimensional ratio. + real :: enhance_mstar ! A multiplicative scaling of mstar due to Langmuir turbulence. + real :: mstar_LT_add ! A value that is added to mstar due to Langmuir turbulence. + real :: iL_Ekman ! Inverse of Ekman length scale [Z-1 ~> m-1]. + real :: iL_Obukhov ! Inverse of Obukhov length scale [Z-1 ~> m-1]. + real :: I_ustar ! The Adcroft reciprocal of ustar [T Z-1 ~> s m-1] + real :: I_f ! The Adcroft reciprocal of the Coriolis parameter [T ~> s] + real :: MLD_Ekman ! The ratio of the mixed layer depth to the Ekman layer depth [nondim]. + real :: Ekman_Obukhov ! The Ekman layer thickness divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov ! The mixed layer depth divided by the Obukhov depth [nondim]. + real :: MLD_Obukhov_stab ! Ratios of length scales where MLD is boundary layer depth [nondim]. + real :: Ekman_Obukhov_stab ! > + real :: MLD_Obukhov_un ! Ratios of length scales where MLD is boundary layer depth + real :: Ekman_Obukhov_un ! > + + ! Set default values for no Langmuir effects. + enhance_mstar = 1.0 ; mstar_LT_add = 0.0 + + if (CS%LT_Enhance_Form /= No_Langmuir) then + ! a. Get parameters for modified LA + if (CS%answers_2018) then + iL_Ekman = Abs_Coriolis / Ustar + iL_Obukhov = Buoyancy_Flux*CS%vonkar / Ustar**3 + Ekman_Obukhov_stab = abs(max(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + Ekman_Obukhov_un = abs(min(0., iL_Obukhov / (iL_Ekman + 1.e-10*US%Z_to_m))) + MLD_Obukhov_stab = abs(max(0., BLD*iL_Obukhov)) + MLD_Obukhov_un = abs(min(0., BLD*iL_Obukhov)) + MLD_Ekman = abs( BLD*iL_Ekman ) + else + Ekman_Obukhov = Max_ratio ; MLD_Obukhov = Max_ratio ; MLD_Ekman = Max_ratio + I_f = 0.0 ; if (abs(abs_Coriolis) > 0.0) I_f = 1.0 / abs_Coriolis + I_ustar = 0.0 ; if (abs(Ustar) > 0.0) I_ustar = 1.0 / Ustar + if (abs(Buoyancy_Flux*CS%vonkar) < Max_ratio*(abs_Coriolis * Ustar**2)) & + Ekman_Obukhov = abs(Buoyancy_Flux*CS%vonkar) * (I_f * I_Ustar**2) + if (abs(BLD*Buoyancy_Flux*CS%vonkar) < Max_ratio*Ustar**3) & + MLD_Obukhov = abs(BLD*Buoyancy_Flux*CS%vonkar) * I_Ustar**3 + if (BLD*Abs_Coriolis < Max_ratio*Ustar) & + MLD_Ekman = BLD*Abs_Coriolis * I_Ustar + + if (Buoyancy_Flux > 0.0) then + Ekman_Obukhov_stab = Ekman_Obukhov ; Ekman_Obukhov_un = 0.0 + MLD_Obukhov_stab = MLD_Obukhov ; MLD_Obukhov_un = 0.0 + else + Ekman_Obukhov_un = Ekman_Obukhov ; Ekman_Obukhov_stab = 0.0 + MLD_Obukhov_un = MLD_Obukhov ; MLD_Obukhov_stab = 0.0 + endif + endif + + ! b. Adjust LA based on various parameters. + ! Assumes linear factors based on length scale ratios to adjust LA + ! Note when these coefficients are set to 0 recovers simple LA. + Convect_Langmuir_Number = Langmuir_Number * & + ( (1.0 + max(-0.5, CS%LaC_MLDoEK * MLD_Ekman)) + & + ((CS%LaC_EKoOB_stab * Ekman_Obukhov_stab + CS%LaC_EKoOB_un * Ekman_Obukhov_un) + & + (CS%LaC_MLDoOB_stab * MLD_Obukhov_stab + CS%LaC_MLDoOB_un * MLD_Obukhov_un)) ) + + if (CS%LT_Enhance_Form == Langmuir_rescale) then + ! Enhancement is multiplied (added mst_lt set to 0) + Enhance_mstar = min(CS%Max_Enhance_M, & + (1. + CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP) ) + elseif (CS%LT_ENHANCE_Form == Langmuir_add) then + ! or Enhancement is additive (multiplied enhance_m set to 1) + mstar_LT_add = CS%LT_ENHANCE_COEF * Convect_Langmuir_Number**CS%LT_ENHANCE_EXP + endif + endif + + mstar_LT = (enhance_mstar - 1.0)*mstar + mstar_LT_add ! Diagnose the full increase in mstar. + mstar = mstar*enhance_mstar + mstar_LT_add + +end subroutine Mstar_Langmuir + + !> Copies the ePBL active mixed layer depth into MLD subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) type(energetic_PBL_CS), pointer :: CS !< Control structure for ePBL type(ocean_grid_type), intent(in) :: G !< Grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G)), intent(out) :: MLD !< Depth of ePBL active mixing layer [m or other units] - real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the desired units for MLD + real, optional, intent(in) :: m_to_MLD_units !< A conversion factor to the + !! desired units for MLD ! Local variables real :: scale ! A dimensional rescaling factor integer :: i,j @@ -1935,143 +1949,6 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) end subroutine energetic_PBL_get_MLD -!> Computes wind speed from ustar_air based on COARE 3.5 Cd relationship -subroutine ust_2_u10_coare3p5(USTair, U10, GV, US) - real, intent(in) :: USTair !< Ustar in the air [m s-1]. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: U10 !< The 10 m wind speed [m s-1]. - - real, parameter :: vonkar = 0.4 - real, parameter :: nu=1e-6 - real :: z0sm, z0, z0rough, u10a, alpha, CD - integer :: CT - - ! Uses empirical formula for z0 to convert ustar_air to u10 based on the - ! COARE 3.5 paper (Edson et al., 2013) - !alpha=m*U10+b - !Note in Edson et al. 2013, eq. 13 m is given as 0.017. However, - ! m=0.0017 reproduces the curve in their figure 6. - - z0sm = 0.11 * nu / USTair; !Compute z0smooth from ustar guess - u10 = USTair/sqrt(0.001); !Guess for u10 - u10a = 1000 - - CT=0 - do while (abs(u10a/u10-1.)>0.001) - CT=CT+1 - u10a = u10 - alpha = min(0.028,0.0017 * u10 - 0.005) - z0rough = alpha * USTair**2/(GV%g_Earth*US%m_to_Z) ! Compute z0rough from ustar guess - z0=z0sm+z0rough - CD = ( vonkar / log(10/z0) )**2 ! Compute CD from derived roughness - u10 = USTair/sqrt(CD);!Compute new u10 from derived CD, while loop - ! ends and checks for convergence...CT counter - ! makes sure loop doesn't run away if function - ! doesn't converge. This code was produced offline - ! and converged rapidly (e.g. 2 cycles) - ! for ustar=0.0001:0.0001:10. - if (CT>20) then - u10 = USTair/sqrt(0.0015) ! I don't expect to get here, but just - ! in case it will output a reasonable value. - exit - endif - enddo - return -end subroutine ust_2_u10_coare3p5 - -!> This subroutine returns the Langmuir number, given ustar and the boundary -!! layer thickness, inclusion conversion to the 10m wind. -subroutine get_LA_windsea(ustar, hbl, GV, US, LA) - real, intent(in) :: ustar !< The water-side surface friction velocity [m s-1] - real, intent(in) :: hbl !< The ocean boundary layer depth [m] - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, intent(out) :: LA !< The Langmuir number returned from this module -! Original description: -! This function returns the enhancement factor, given the 10-meter -! wind [m s-1], friction velocity [m s-1] and the boundary layer depth [m]. -! Update (Jan/25): -! Converted from function to subroutine, now returns Langmuir number. -! Computes 10m wind internally, so only ustar and hbl need passed to -! subroutine. -! -! Qing Li, 160606 -! BGR port from CVMix to MOM6 Jan/25/2017 -! BGR change output to LA from Efactor -! BGR remove u10 input - -! Input -! Local variables - ! parameters - real, parameter :: & - ! ratio of U19.5 to U10 (Holthuijsen, 2007) - u19p5_to_u10 = 1.075, & - ! ratio of mean frequency to peak frequency for - ! Pierson-Moskowitz spectrum (Webb, 2011) - fm_to_fp = 1.296, & - ! ratio of surface Stokes drift to U10 - us_to_u10 = 0.0162, & - ! loss ratio of Stokes transport - r_loss = 0.667 - real :: uStokes, hm0, fm, fp, vstokes, kphil, kstar - real :: z0, z0i, r1, r2, r3, r4, tmp, us_sl, lasl_sqr_i - real :: pi, u10 - pi = 4.0*atan(1.0) - if (ustar > 0.0) then - ! Computing u10 based on ustar and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar * sqrt(GV%Rho0/1.225), U10, GV, US) - ! surface Stokes drift - uStokes = us_to_u10*u10 - - ! significant wave height from Pierson-Moskowitz spectrum (Bouws, 1998) - hm0 = 0.0246 *u10**2 - - ! peak frequency (PM, Bouws, 1998) - tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp - - ! mean frequency - fm = fm_to_fp * fp - - ! total Stokes transport (a factor r_loss is applied to account - ! for the effect of directional spreading, multidirectional waves - ! and the use of PM peak frequency and PM significant wave height - ! on estimating the Stokes transport) - vstokes = 0.125 * PI * r_loss * fm * hm0**2 - ! - ! the general peak wavenumber for Phillips' spectrum - ! (Breivik et al., 2016) with correction of directional spreading - kphil = 0.176 * uStokes / vstokes - ! - ! surface layer averaged Stokes dirft with Stokes drift profile - ! estimated from Phillips' spectrum (Breivik et al., 2016) - ! the directional spreading effect from Webb and Fox-Kemper, 2015 - ! is also included - kstar = kphil * 2.56 - ! surface layer - !z0 = 0.2 * abs(hbl) - !BGR hbl now adjusted by averaging ratio before function call. - z0 = abs(hbl) - z0i = 1.0 / z0 - ! term 1 to 4 - r1 = ( 0.151 / kphil * z0i -0.84 ) & - * ( 1.0 - exp(-2.0 * kphil * z0) ) - r2 = -( 0.84 + 0.0591 / kphil * z0i ) & - *sqrt( 2.0 * PI * kphil * z0 ) & - *erfc( sqrt( 2.0 * kphil * z0 ) ) - r3 = ( 0.0632 / kstar * z0i + 0.125 ) & - * (1.0 - exp(-2.0 * kstar * z0) ) - r4 = ( 0.125 + 0.0946 / kstar * z0i ) & - *sqrt( 2.0 * PI *kstar * z0) & - *erfc( sqrt( 2.0 * kstar * z0 ) ) - us_sl = uStokes * (0.715 + r1 + r2 + r3 + r4) - ! - LA = sqrt(ustar / us_sl) - else - LA=1.e8 - endif -endsubroutine Get_LA_windsea !> This subroutine initializes the energetic_PBL module subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) @@ -2087,14 +1964,18 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. + character(len=20) :: tmpstr real :: omega_frac_dflt + real :: Z3_T3_to_m3_s3 ! A conversion factor for work diagnostics [m3 T3 Z-3 s-3 ~> nondim] integer :: isd, ied, jsd, jed + integer :: mstar_mode, LT_enhance, wT_mode + logical :: default_2018_answers logical :: use_temperature, use_omega logical :: use_la_windsea isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (associated(CS)) then - call MOM_error(WARNING, "mixedlayer_init called with an associated"// & + call MOM_error(WARNING, "mixedlayer_init called with an associated"//& "associated control structure.") return else ; allocate(CS) ; endif @@ -2105,283 +1986,388 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & - "An integer switch for how to compute MSTAR. \n"//& - " 0 for constant MSTAR\n"//& - " 1 for MSTAR w/ MLD in stabilizing limit\n"//& - " 2 for MSTAR w/ L_E/L_O in stabilizing limit\n"//& - " 3 for MSTAR as in RH18.",& - "units=nondim",default=0) - call get_param(param_file, mdl, "MSTAR", CS%mstar, & - "The ratio of the friction velocity cubed to the TKE "//& - "input to the mixed layer.", "units=nondim", default=1.2) - call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & - "The exponent applied to the ratio of the distance to the MLD "//& - "and the MLD depth which determines the shape of the mixing length.",& - "units=nondim", default=2.0) - call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & - "Maximum value of mstar allowed in model if non-negative "//& - "(used if MSTAR_MODE>0).",& - "units=nondim", default=-1.0) - call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & - "Factor used for reducing mstar during convection "//& - "due to reduction of stable density gradient.",& - "units=nondim", default=0.0) - call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & - "The slope of the linear relationship between mstar "//& - "and the length scale ratio (used if MSTAR_MODE=1).",& - "units=nondim", default=0.85) - call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & - "The value of the length scale ratio where the mstar "//& - "is linear above (used if MSTAR_MODE=1).",& - "units=nondim", default=-0.3) - call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & - "The value of mstar at MSTAR_XINT "//& - "(used if MSTAR_MODE=1).",& - "units=nondim", default=0.095) - call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & - "Set false to use asymptotic cap, defaults to true. "//& - "(used only if MSTAR_MODE=1)"& - ,"units=nondim",default=.true.) - call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & - "Coefficient in computing mstar when rotation and "//& - "stabilizing effects are both important (used if MSTAR_MODE=2)"& - ,"units=nondim",default=0.3) - call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & - "Coefficient in computing mstar when only rotation limits "//& - "the total mixing. (used only if MSTAR_MODE=2)"& - ,"units=nondim",default=0.085) - call get_param(param_file, mdl, "RH18_MST_CN1", CS%RH18_MST_CN1,& - "MSTAR_N coefficient 1 (outter-most coefficient for fit). \n"//& - " The value of 0.275 is given in RH18. Increasing this \n"//& - "coefficient increases MSTAR for all values of Hf/ust, but more \n"//& - "effectively at low values (weakly developed OSBLs).",& - units="nondim", default=0.275) - call get_param(param_file, mdl, "RH18_MST_CN2", CS%RH18_MST_CN2,& - "MSTAR_N coefficient 2 (coefficient outside of exponential decay). \n"//& - "The value of 8.0 is given in RH18. Increasing this coefficient \n"//& - "increases MSTAR for all values of HF/ust, with a much more even \n"//& - "effect across a wide range of Hf/ust than CN1.",& - units="nondim",default=8.0) - call get_param(param_file, mdl, "RH18_MST_CN3", CS%RH18_MST_CN3,& - "MSTAR_N coefficient 3 (exponential decay coefficient). \n"//& - "The value of -5.0 is given in RH18. Increasing this increases how \n"//& - "quickly the value of MSTAR decreases as Hf/ust increases.",& - units="nondim",default=-5.0) - call get_param(param_file, mdl, "RH18_MST_CS1", CS%RH18_MST_CS1,& - "MSTAR_S coefficient for RH18 in stabilizing limit. \n"//& - "The value of 0.2 is given in RH18 and increasing it increases \n"//& - "MSTAR in the presence of a stabilizing surface buoyancy flux.",& - units="nondim",default=0.2) - call get_param(param_file, mdl, "RH18_MST_CS2", CS%RH18_MST_CS2,& - "MSTAR_S exponent for RH18 in stabilizing limit. \n"//& - "The value of 0.4 is given in RH18 and increasing it increases MSTAR \n"//& - "exponentially in the presence of a stabilizing surface buoyancy flux.",& - Units="nondim",default=0.4) - call get_param(param_file, mdl, "NSTAR", CS%nstar, & - "The portion of the buoyant potential energy imparted by "//& - "surface fluxes that is available to drive entrainment "//& - "at the base of mixed layer when that energy is positive.", & - units="nondim", default=0.2) - call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & - "The efficiency with which mean kinetic energy released "//& - "by mechanically forced entrainment of the mixed layer "//& - "is converted to turbulent kinetic energy.", units="nondim", & - default=0.0) - call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & - "TKE_DECAY relates the vertical rate of decay of the "//& - "TKE available for mechanical entrainment to the natural "//& - "Ekman depth.", units="nondim", default=2.5) -! call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & -! "The minimum mixed layer depth if the mixed layer depth "//& -! "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mdl, "OMEGA",CS%omega, & +!/1. General ePBL settings + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) - call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & + default=7.2921e-5, scale=US%T_to_S) + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the "//& - "vertical component of rotation when setting the decay "// & + "vertical component of rotation when setting the decay "//& "scale for turbulence.", default=.false., do_not_log=.true.) omega_frac_dflt = 0.0 if (use_omega) then call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & - "When setting the decay scale for turbulence, use this "// & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & + "When setting the decay scale for turbulence, use this "//& "fraction of the absolute rotation rate blended with the "//& - "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & + "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mdl, "VSTAR_MODE", CS%vstar_mode, & - "An integer switch for how to compute VSTAR. \n"//& - " 0 for old vstar (TKE Remaining)^(1/3)\n"//& - " 1 for vstar from u* and w* (see Reichl & Hallberg 2018).",& - "units=nondim",default=0) - call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & - "A ratio relating the efficiency with which convectively "//& - "released energy is converted to a turbulent velocity, "// & - "relative to mechanically forced TKE. Making this larger "//& - "increases the BL diffusivity", units="nondim", default=1.0) - call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & - "An overall nondimensional scaling factor for v*. "// & - "Making this larger decreases the PBL diffusivity.", & - units="nondim", default=1.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& - "The proportionality times ustar to set vstar to at the surface.",& - "units=nondim", default=1.2) - call get_param(param_file, mdl, "LT_ENHANCE_K_R16",CS%LT_ENH_K_R16, & - "Logical flag to toggle on enhancing mixing coefficient in\n"//& - "boundary layer due to Langmuir turbulence following Reichl\n"//& - "et al., 2016. \n"//& - "This approach is not recommended for use, as it is based\n"//& - "on a hurricane LES configuration and not known if it is general.",& - units="nondim",default=.false.) - call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & - "A nondimensional scaling factor controlling the inhibition "// & + call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & + "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) - call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "EPBL_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=default_2018_answers) + + + call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & + "If true, the ePBL code uses the original form of the "//& + "potential energy change code. Otherwise, the newer "//& + "version that can work with successive increments to the "//& + "diffusivity in upward or downward passes is used.", default=.true.) + + call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & + "The efficiency with which mean kinetic energy released "//& + "by mechanically forced entrainment of the mixed layer "//& + "is converted to turbulent kinetic energy.", units="nondim", & + default=0.0) + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & + "TKE_DECAY relates the vertical rate of decay of the "//& + "TKE available for mechanical entrainment to the natural "//& + "Ekman depth.", units="nondim", default=2.5) + + +!/2. Options related to setting MSTAR + call get_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "MSTAR_MODE", mstar_mode, default=-1) + if (mstar_mode == 0) then + tmpstr = CONSTANT_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = CONSTANT instead of the archaic MSTAR_MODE = 0.") + elseif (mstar_mode == 1) then + call MOM_error(FATAL, "You are using a legacy mstar mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_MSTAR_SCHEME to specify the scheme for mstar.") + elseif (mstar_mode == 2) then + tmpstr = OM4_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = OM4 instead of the archaic MSTAR_MODE = 2.") + elseif (mstar_mode == 3) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_MSTAR_SCHEME = REICHL_H18 instead of the archaic MSTAR_MODE = 3.") + elseif (mstar_mode > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter MSTAR_MODE was specified.") + endif + call log_param(param_file, mdl, "EPBL_MSTAR_SCHEME", tmpstr, & + "EPBL_MSTAR_SCHEME selects the method for setting mstar. Valid values are: \n"//& + "\t CONSTANT - Use a fixed mstar given by MSTAR \n"//& + "\t OM4 - Use L_Ekman/L_Obukhov in the sabilizing limit, as in OM4 \n"//& + "\t REICHL_H18 - Use the scheme documented in Reichl & Hallberg, 2018.", & + default=CONSTANT_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (CONSTANT_STRING) + CS%mstar_Scheme = Use_Fixed_MStar + case (OM4_STRING) + CS%mstar_Scheme = MStar_from_Ekman + case (RH18_STRING) + CS%mstar_Scheme = MStar_from_RH18 + case default + call MOM_mesg('energetic_PBL_init: EPBL_MSTAR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_MSTAR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + + call get_param(param_file, mdl, "MSTAR", CS%fixed_mstar, & + "The ratio of the friction velocity cubed to the TKE input to the "//& + "mixed layer. This option is used if EPBL_MSTAR_SCHEME = CONSTANT.", & + units="nondim", default=1.2, do_not_log=(CS%mstar_scheme/=Use_Fixed_MStar)) + call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & + "If this value is positive, it sets the maximum value of mstar "//& + "allowed in ePBL. (This is not used if EPBL_MSTAR_SCHEME = CONSTANT).", & + units="nondim", default=-1.0, do_not_log=(CS%mstar_scheme==Use_Fixed_MStar)) + ! mstar_scheme==MStar_from_Ekman options + call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & + "Coefficient in computing mstar when rotation and stabilizing "//& + "effects are both important (used if EPBL_MSTAR_SCHEME = OM4).", & + units="nondim", default=0.3, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) + call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & + "Coefficient in computing mstar when only rotation limits "// & + "the total mixing (used if EPBL_MSTAR_SCHEME = OM4)", & + units="nondim", default=0.085, do_not_log=(CS%mstar_scheme/=MStar_from_Ekman)) + ! mstar_scheme==MStar_from_RH18 options + call get_param(param_file, mdl, "RH18_MSTAR_CN1", CS%RH18_mstar_cn1,& + "MSTAR_N coefficient 1 (outter-most coefficient for fit). "//& + "The value of 0.275 is given in RH18. Increasing this "//& + "coefficient increases MSTAR for all values of Hf/ust, but more "//& + "effectively at low values (weakly developed OSBLs).", & + units="nondim", default=0.275, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CN2", CS%RH18_mstar_cn2,& + "MSTAR_N coefficient 2 (coefficient outside of exponential decay). "//& + "The value of 8.0 is given in RH18. Increasing this coefficient "//& + "increases MSTAR for all values of HF/ust, with a much more even "//& + "effect across a wide range of Hf/ust than CN1.", & + units="nondim", default=8.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CN3", CS%RH18_mstar_CN3,& + "MSTAR_N coefficient 3 (exponential decay coefficient). "//& + "The value of -5.0 is given in RH18. Increasing this increases how "//& + "quickly the value of MSTAR decreases as Hf/ust increases.", & + units="nondim", default=-5.0, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CS1", CS%RH18_mstar_cs1,& + "MSTAR_S coefficient for RH18 in stabilizing limit. "//& + "The value of 0.2 is given in RH18 and increasing it increases "//& + "MSTAR in the presence of a stabilizing surface buoyancy flux.", & + units="nondim", default=0.2, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + call get_param(param_file, mdl, "RH18_MSTAR_CS2", CS%RH18_mstar_cs2,& + "MSTAR_S exponent for RH18 in stabilizing limit. "//& + "The value of 0.4 is given in RH18 and increasing it increases MSTAR "//& + "exponentially in the presence of a stabilizing surface buoyancy flux.", & + Units="nondim", default=0.4, do_not_log=(CS%mstar_scheme/=MStar_from_RH18)) + + +!/ Convective turbulence related options + call get_param(param_file, mdl, "NSTAR", CS%nstar, & + "The portion of the buoyant potential energy imparted by "//& + "surface fluxes that is available to drive entrainment "//& + "at the base of mixed layer when that energy is positive.", & + units="nondim", default=0.2) + call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%mstar_convect_coef, & + "Coefficient used for reducing mstar during convection "//& + "due to reduction of stable density gradient.", & + units="nondim", default=0.0) + +!/ Mixing Length Options + !### THIS DEFAULT SHOULD BECOME TRUE. + call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%Use_MLD_iteration, & + "A logical that specifies whether or not to use the "//& "distance to the bottom of the actively turbulent boundary "//& "layer to help set the EPBL length scale.", default=.false.) - call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & - "A logical that specifies whether or not to use the "// & + call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & + "A scale for the mixing length in the transition layer "//& + "at the edge of the boundary layer as a fraction of the "//& + "boundary layer thickness.", units="nondim", default=0.1) + if ( CS%Use_MLD_iteration .and. abs(CS%transLay_scale-0.5) >= 0.5) then + call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "//& + "EPBL_TRANSITION should be greater than 0 and less than 1.") + endif + + !### Two test cases should be changed to allow this to be obsoleted. + call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & + "A logical that specifies whether or not to use the "//& "old method for determining MLD depth in iteration, which "//& "is limited to resolution.", default=.true.) - call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & - "A logical that specifies whether or not to use the "// & - "previous timestep MLD as a first guess in the MLD iteration. "// & +! if (CS%Orig_MLD_Iteration) then +! call MOM_error(FATAL, "Flag ORIG_MLD_ITERATION error: "//& +! "If you need to use this setting please "//& +! "report this error, as the code supporting this option "//& +! "is legacy code that is set to be deleted.") +! endif + call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & + "A logical that specifies whether or not to use the "//& + "previous timestep MLD as a first guess in the MLD iteration. "//& "The default is false to facilitate reproducibility.", default=.false.) - call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & - "The tolerance for the iteratively determined mixed "// & + call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & + "The tolerance for the iteratively determined mixed "//& "layer depth. This is only used with USE_MLD_ITERATION.", & units="meter", default=1.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & + call get_param(param_file, mdl, "EPBL_MLD_MAX_ITS", CS%max_MLD_its, & + "The maximum number of iterations that can be used to find a self-consistent "//& + "mixed layer depth. For now, due to the use of bisection, the maximum number "//& + "iteractions needed is set by Depth/2^MAX_ITS < EPBL_MLD_TOLERANCE.", & + default=20, do_not_log=.not.CS%Use_MLD_iteration) + if (.not.CS%Use_MLD_iteration) CS%Max_MLD_Its = 1 + call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used "//& - "by ePBL. The default (0) does not set a minimum.", & + "by ePBL. The default (0) does not set a minimum.", & units="meter", default=0.0, scale=US%m_to_Z) - call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & - "If true, the ePBL code uses the original form of the "// & - "potential energy change code. Otherwise, the newer "// & - "version that can work with successive increments to the "// & - "diffusivity in upward or downward passes is used.", default=.true.) - call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & - "A scale for the mixing length in the transition layer "// & - "at the edge of the boundary layer as a fraction of the "//& - "boundary layer thickness. The default is 0.1.", & - units="nondim", default=0.1) - if ( CS%USE_MLD_ITERATION .and. abs(CS%transLay_scale-0.5) >= 0.5) then - call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & - "EPBL_TRANSITION should be greater than 0 and less than 1.") + + call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & + "The exponent applied to the ratio of the distance to the MLD "//& + "and the MLD depth which determines the shape of the mixing length. "//& + "This is only used if USE_MLD_ITERATION is True.", & + units="nondim", default=2.0) + +!/ Turbulent velocity scale in mixing coefficient + call get_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_MODE", wT_mode, default=-1) + if (wT_mode == 0) then + tmpstr = ROOT_TKE_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = CUBE_ROOT_TKE instead of the archaic EPBL_VEL_SCALE_MODE = 0.") + elseif (wT_mode == 1) then + tmpstr = RH18_STRING + call MOM_error(WARNING, "Use EPBL_VEL_SCALE_SCHEME = REICHL_H18 instead of the archaic EPBL_VEL_SCALE_MODE = 1.") + elseif (wT_mode >= 2) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter EPBL_VEL_SCALE_MODE was specified.") endif - call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is positive. The default is 0, but should probably be ~0.4.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& - "A scale for the dissipation of TKE due to stratification "// & - "in the boundary layer, applied when local stratification "// & - "is negative. The default is 0, but should probably be ~1.", & - units="nondim", default=0.0) - call get_param(param_file, mdl, "USE_LA_LI2016", USE_LA_Windsea, & + call log_param(param_file, mdl, "EPBL_VEL_SCALE_SCHEME", tmpstr, & + "Selects the method for translating TKE into turbulent velocities. "//& + "Valid values are: \n"//& + "\t CUBE_ROOT_TKE - A constant times the cube root of remaining TKE. \n"//& + "\t REICHL_H18 - Use the scheme based on a combination of w* and v* as \n"//& + "\t documented in Reichl & Hallberg, 2018.", & + default=ROOT_TKE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (ROOT_TKE_STRING) + CS%wT_scheme = wT_from_cRoot_TKE + case (RH18_STRING) + CS%wT_scheme = wT_from_RH18 + case default + call MOM_mesg('energetic_PBL_init: EPBL_VEL_SCALE_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_VEL_SCALE_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & + "A ratio relating the efficiency with which convectively "//& + "released energy is converted to a turbulent velocity, "//& + "relative to mechanically forced TKE. Making this larger "//& + "increases the BL diffusivity", units="nondim", default=1.0) + call get_param(param_file, mdl, "EPBL_VEL_SCALE_FACTOR", CS%vstar_scale_fac, & + "An overall nondimensional scaling factor for wT. "//& + "Making this larger increases the PBL diffusivity.", & + units="nondim", default=1.0) + call get_param(param_file, mdl, "VSTAR_SURF_FAC", CS%vstar_surf_fac,& + "The proportionality times ustar to set vstar at the surface.", & + units="nondim", default=1.2) + + !/ Options related to Langmuir turbulence + call get_param(param_file, mdl, "USE_LA_LI2016", use_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to "//& "determine the Langmuir number.", units="nondim", default=.false.) ! Note this can be activated in other ways, but this preserves the old method. - if (use_la_windsea) then + if (use_LA_windsea) then CS%USE_LT = .true. else call get_param(param_file, mdl, "EPBL_LT", CS%USE_LT, & - "A logical to use a LT parameterization.", & - units="nondim", default=.false.) + "A logical to use a LT parameterization.", & + units="nondim", default=.false.) endif if (CS%USE_LT) then - call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & - "Integer for Langmuir number mode. \n"// & - " *Requires USE_LA_LI2016 to be set to True. \n"// & - "Options: 0 - No Langmuir \n"// & - " 1 - Van Roekel et al. 2014/Li et al., 2016 \n"// & - " 2 - Multiplied w/ adjusted La. \n"// & - " 3 - Added w/ adjusted La.", & - units="nondim", default=0) + call get_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING, do_not_log=.true.) + call get_param(param_file, mdl, "LT_ENHANCE", LT_enhance, default=-1) + if (LT_ENHANCE == 0) then + tmpstr = NONE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = NONE instead of the archaic LT_ENHANCE = 0.") + elseif (LT_ENHANCE == 1) then + call MOM_error(FATAL, "You are using a legacy LT_ENHANCE mode in ePBL that has been phased out. "//& + "If you need to use this setting please report this error. Also use "//& + "EPBL_LANGMUIR_SCHEME to specify the scheme for mstar.") + elseif (LT_ENHANCE == 2) then + tmpstr = RESCALED_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = RESCALE instead of the archaic LT_ENHANCE = 2.") + elseif (LT_ENHANCE == 3) then + tmpstr = ADDITIVE_STRING + call MOM_error(WARNING, "Use EPBL_LANGMUIR_SCHEME = ADDITIVE instead of the archaic LT_ENHANCE = 3.") + elseif (LT_ENHANCE > 3) then + call MOM_error(FATAL, "An unrecognized value of the obsolete parameter LT_ENHANCE was specified.") + endif + call log_param(param_file, mdl, "EPBL_LANGMUIR_SCHEME", tmpstr, & + "EPBL_LANGMUIR_SCHEME selects the method for including Langmuir turbulence. "//& + "Valid values are: \n"//& + "\t NONE - Do not do any extra mixing due to Langmuir turbulence \n"//& + "\t RESCALE - Use a multiplicative rescaling of mstar to account for Langmuir turbulence \n"//& + "\t ADDITIVE - Add a Langmuir turblence contribution to mstar to other contributions", & + default=NONE_STRING) + tmpstr = uppercase(tmpstr) + select case (tmpstr) + case (NONE_STRING) + CS%LT_enhance_form = No_Langmuir + case (RESCALED_STRING) + CS%LT_enhance_form = Langmuir_rescale + case (ADDITIVE_STRING) + CS%LT_enhance_form = Langmuir_add + case default + call MOM_mesg('energetic_PBL_init: EPBL_LANGMUIR_SCHEME ="'//trim(tmpstr)//'"', 0) + call MOM_error(FATAL, "energetic_PBL_init: Unrecognized setting "// & + "EPBL_LANGMUIR_SCHEME = "//trim(tmpstr)//" found in input file.") + end select + call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & - "Coefficient for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=0.447) + "Coefficient for Langmuir enhancement of mstar", & + units="nondim", default=0.447, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & - "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & - units="nondim", default=-1.33) - call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching Ekman depth if LT_ENHANCE=2.", & - units="nondim", default=-0.87) + "Exponent for Langmuir enhancementt of mstar", & + units="nondim", default=-1.33, do_not_log=(CS%LT_enhance_form==No_Langmuir)) + call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching Ekman depth.", & + units="nondim", default=-0.87, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching stable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & - "Coefficient for modification of Langmuir number due to "//& - "MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.0) + "Coefficient for modification of Langmuir number due to "//& + "MLD approaching unstable Obukhov depth.", & + units="nondim", default=0.0, do_not_log=(CS%LT_enhance_form==No_Langmuir)) call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & - units="nondim", default=0.95) - call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & - "Coefficient for modification of Langmuir number due to "// & - "ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& - units="nondim", default=0.95) + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to stable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) + call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & + "Coefficient for modification of Langmuir number due to "//& + "ratio of Ekman to unstable Obukhov depth.", & + units="nondim", default=0.95, do_not_log=(CS%LT_enhance_form==No_Langmuir)) endif + + +!/ Logging parameters ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) - call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m, & + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min*US%Z_to_m*US%s_to_T, & "The (tiny) minimum friction velocity used within the "//& "ePBL code, derived from OMEGA and ANGSTROM.", units="m s-1") + +!/ Checking output flags + Z3_T3_to_m3_s3 = US%Z_to_m**3 * US%s_to_T**3 CS%id_ML_depth = register_diag_field('ocean_model', 'ePBL_h_ML', diag%axesT1, & Time, 'Surface boundary layer depth', 'm', conversion=US%Z_to_m, & cmor_long_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') CS%id_TKE_wind = register_diag_field('ocean_model', 'ePBL_TKE_wind', diag%axesT1, & - Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3') + Time, 'Wind-stirring source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_MKE = register_diag_field('ocean_model', 'ePBL_TKE_MKE', diag%axesT1, & - Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3') + Time, 'Mean kinetic energy source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv = register_diag_field('ocean_model', 'ePBL_TKE_conv', diag%axesT1, & - Time, 'Convective source of mixed layer TKE', 'm3 s-3') + Time, 'Convective source of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_forcing = register_diag_field('ocean_model', 'ePBL_TKE_forcing', diag%axesT1, & Time, 'TKE consumed by mixing surface forcing or penetrative shortwave radation '//& - 'through model layers', 'm3 s-3') + 'through model layers', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mixing = register_diag_field('ocean_model', 'ePBL_TKE_mixing', diag%axesT1, & - Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3') + Time, 'TKE consumed by mixing that deepens the mixed layer', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_mech_decay = register_diag_field('ocean_model', 'ePBL_TKE_mech_decay', diag%axesT1, & - Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3') + Time, 'Mechanical energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_TKE_conv_decay = register_diag_field('ocean_model', 'ePBL_TKE_conv_decay', diag%axesT1, & - Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3') - CS%id_Hsfc_used = register_diag_field('ocean_model', 'ePBL_Hs_used', diag%axesT1, & - Time, 'Surface region thickness that is used', 'm', conversion=US%m_to_Z) + Time, 'Convective energy decay sink of mixed layer TKE', 'm3 s-3', conversion=Z3_T3_to_m3_s3) CS%id_Mixing_Length = register_diag_field('ocean_model', 'Mixing_Length', diag%axesTi, & Time, 'Mixing Length that is used', 'm', conversion=US%Z_to_m) CS%id_Velocity_Scale = register_diag_field('ocean_model', 'Velocity_Scale', diag%axesTi, & - Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m) - CS%id_LT_enhancement = register_diag_field('ocean_model', 'LT_Enhancement', diag%axesT1, & - Time, 'LT enhancement that is used.', 'nondim') + Time, 'Velocity Scale that is used.', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_MSTAR_mix = register_diag_field('ocean_model', 'MSTAR', diag%axesT1, & - Time, 'MSTAR that is used.', 'nondim') - CS%id_OSBL = register_diag_field('ocean_model', 'ePBL_OSBL', diag%axesT1, & - Time, 'ePBL Surface Boundary layer depth.', 'm', conversion=US%m_to_Z) - ! BGR (9/21/2017) Note that ePBL_OSBL is the guess for iteration step while ePBL_h_ML is - ! result from iteration step. - CS%id_mld_ekman = register_diag_field('ocean_model', 'MLD_EKMAN', diag%axesT1, & - Time, 'Boundary layer depth over Ekman length.', 'm') - CS%id_mld_obukhov = register_diag_field('ocean_model', 'MLD_OBUKHOV', diag%axesT1, & - Time, 'Boundary layer depth over Obukhov length.', 'm') - CS%id_ekman_obukhov = register_diag_field('ocean_model', 'EKMAN_OBUKHOV', diag%axesT1, & - Time, 'Ekman length over Obukhov length.', 'm') - CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & - Time, 'Langmuir number.', 'nondim') - CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & - Time, 'Modified Langmuir number.', 'nondim') - CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & - Time, 'MSTAR applied for LT effect.', 'nondim') + Time, 'Total mstar that is used.', 'nondim') + + if (CS%use_LT) then + CS%id_LA = register_diag_field('ocean_model', 'LA', diag%axesT1, & + Time, 'Langmuir number.', 'nondim') + CS%id_LA_mod = register_diag_field('ocean_model', 'LA_MOD', diag%axesT1, & + Time, 'Modified Langmuir number.', 'nondim') + CS%id_MSTAR_LT = register_diag_field('ocean_model', 'MSTAR_LT', diag%axesT1, & + Time, 'Increase in mstar due to Langmuir Turbulence.', 'nondim') + endif call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state "//& @@ -2400,38 +2386,17 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) CS%TKE_diagnostics = .true. endif - if ((CS%id_Mixing_Length>0) .or. (CS%id_Velocity_Scale>0)) then - call safe_alloc_alloc(CS%Velocity_Scale,isd,ied,jsd,jed,GV%ke+1) - call safe_alloc_alloc(CS%Mixing_Length,isd,ied,jsd,jed,GV%ke+1) - CS%Velocity_Scale(:,:,:) = 0.0 - CS%Mixing_Length(:,:,:) = 0.0 - CS%mixing_diagnostics = .true. - endif + if (CS%id_Velocity_Scale>0) call safe_alloc_alloc(CS%Velocity_Scale, isd, ied, jsd, jed, GV%ke+1) + if (CS%id_Mixing_Length>0) call safe_alloc_alloc(CS%Mixing_Length, isd, ied, jsd, jed, GV%ke+1) + call safe_alloc_alloc(CS%ML_depth, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%ML_depth2, isd, ied, jsd, jed) - if (max(CS%id_LT_Enhancement, CS%id_mstar_mix,CS%id_mld_ekman, & - CS%id_ekman_obukhov, CS%id_mld_obukhov, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then + if (max(CS%id_mstar_mix, CS%id_LA, CS%id_LA_mod, CS%id_MSTAR_LT ) >0) then call safe_alloc_alloc(CS%Mstar_mix, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%Enhance_M, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_EKMAN, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%MLD_OBUKHOV, isd, ied, jsd, jed) - call safe_alloc_alloc(CS%EKMAN_OBUKHOV, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA, isd, ied, jsd, jed) call safe_alloc_alloc(CS%LA_MOD, isd, ied, jsd, jed) call safe_alloc_alloc(CS%MSTAR_LT, isd, ied, jsd, jed) endif - !Fitting coefficients to asymptote twoard 0 as MLD -> Ekman depth - CS%MSTAR_A = CS%MSTAR_AT_XINT**(1./CS%MSTAR_N) - CS%MSTAR_B = CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A**(CS%MSTAR_N-1.)) - !Fitting coefficients to asymptote toward MSTAR_CAP - !*Fixed to begin asymptote at MSTAR_CAP-0.5 toward MSTAR_CAP - CS%MSTAR_A2 = 0.5**(1./CS%MSTAR_N) - CS%MSTAR_B2 = -CS%MSTAR_SLOPE / (CS%MSTAR_N*CS%MSTAR_A2**(CS%MSTAR_N-1)) - !Compute value of X (referenced to MSTAR_XINT) where transition - ! to asymptotic regime based on value of X where MSTAR=MSTAR_CAP-0.5 - CS%MSTAR_XINT_UP = (CS%MSTAR_CAP-0.5-CS%MSTAR_AT_XINT)/CS%MSTAR_SLOPE - end subroutine energetic_PBL_init !> Clean up and deallocate memory associated with the energetic_PBL module. @@ -2442,11 +2407,6 @@ subroutine energetic_PBL_end(CS) if (.not.associated(CS)) return if (allocated(CS%ML_depth)) deallocate(CS%ML_depth) - if (allocated(CS%ML_depth2)) deallocate(CS%ML_depth2) - if (allocated(CS%Enhance_M)) deallocate(CS%Enhance_M) - if (allocated(CS%MLD_EKMAN)) deallocate(CS%MLD_EKMAN) - if (allocated(CS%MLD_OBUKHOV)) deallocate(CS%MLD_OBUKHOV) - if (allocated(CS%EKMAN_OBUKHOV)) deallocate(CS%EKMAN_OBUKHOV) if (allocated(CS%LA)) deallocate(CS%LA) if (allocated(CS%LA_MOD)) deallocate(CS%LA_MOD) if (allocated(CS%MSTAR_MIX)) deallocate(CS%MSTAR_MIX) diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 34b48257bb..121191b008 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -48,15 +48,11 @@ module MOM_entrain_diffusive !! the buoyancy flux in a layer and inversely proportional to the density !! differences between layers. The scheme that is used here is described in !! detail in Hallberg, Mon. Wea. Rev. 2000. -subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & +subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & kb_out, Kd_Lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u !< The zonal velocity [m s-1]. - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & - intent(in) :: v !< The meridional velocity [m s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available @@ -64,7 +60,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, !! ptrs. type(forcing), intent(in) :: fluxes !< A structure of surface fluxes that may !! be used. - real, intent(in) :: dt !< The time increment [s]. + real, intent(in) :: dt !< The time increment [T ~> s]. type(entrain_diffusive_CS), pointer :: CS !< The control structure returned by a previous !! call to entrain_diffusive_init. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -113,7 +109,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real, allocatable, dimension(:,:,:) :: & Kd_eff, & ! The effective diffusivity that actually applies to each ! layer after the effects of boundary conditions are - ! considered [Z2 s-1 ~> m2 s-1]. + ! considered [Z2 T-1 ~> m2 s-1]. diff_work ! The work actually done by diffusion across each ! interface [W m-2]. Sum vertically for the total work. @@ -175,7 +171,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: dRHo ! The change in locally referenced potential density between ! the layers above and below an interface [kg m-3]. real :: g_2dt ! 0.5 * G_Earth / dt, times unit conversion factors - ! [m3 H-2 s-3 ~> m s-3 or m7 kg-2 s-3]. + ! [m3 H-2 s-2 T-1 ~> m s-3 or m7 kg-2 s-3]. real, dimension(SZI_(G)) :: & pressure, & ! The pressure at an interface [Pa]. T_eos, S_eos, & ! The potential temperature and salinity at which to @@ -197,7 +193,7 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, real :: ea_cor ! The corrective adjustment to eakb [H ~> m or kg m-2]. real :: h1 ! The layer thickness after entrainment through the ! interface below is taken into account [H ~> m or kg m-2]. - real :: Idt ! The inverse of the time step [s-1]. + real :: Idt ! The inverse of the time step [T-1 ~> s-1]. logical :: do_any logical :: do_i(SZI_(G)), did_i(SZI_(G)), reiterate, correct_density @@ -271,25 +267,23 @@ subroutine entrainment_diffusive(u, v, h, tv, fluxes, dt, G, GV, US, CS, ea, eb, if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_lay(i,j,k))) + dtKd(i,k) = GV%Z_to_H**2 * (dt * Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%s_to_T * Kd_int(i,j,K))) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt & - * (US%s_to_T * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)))) + dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt & - * (US%T_to_s * (Kd_int(i,j,K)+Kd_int(i,j,K+1)))) + dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * (US%T_to_s * Kd_int(i,j,K))) + dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) enddo ; enddo endif @@ -2132,9 +2126,10 @@ subroutine entrain_diffusive_init(Time, G, GV, US, param_file, diag, CS) units="m", default=MAX(100.0*GV%Angstrom_m,1.0e-4*sqrt(dt*Kd)), scale=GV%m_to_H) CS%id_Kd = register_diag_field('ocean_model', 'Kd_effective', diag%axesTL, Time, & - 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z_to_m**2) + 'Diapycnal diffusivity as applied', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_diff_work = register_diag_field('ocean_model', 'diff_work', diag%axesTi, Time, & - 'Work actually done by diapycnal diffusion across each interface', 'W m-2', conversion=US%Z_to_m) + 'Work actually done by diapycnal diffusion across each interface', 'W m-2', & + conversion=US%Z_to_m*US%s_to_T) end subroutine entrain_diffusive_init diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 2ffdbcb775..52156ac337 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -5,7 +5,7 @@ module MOM_int_tide_input use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diag_mediator, only : diag_ctrl, time_type +use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled use MOM_diag_mediator, only : safe_alloc_ptr, post_data, register_diag_field use MOM_debugging, only : hchksum use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE @@ -14,6 +14,7 @@ module MOM_int_tide_input use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, MOM_read_data use MOM_thickness_diffuse, only : vert_fill_TS +use MOM_time_manager, only : time_type, set_time, operator(+), operator(<=) use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d use MOM_verticalGrid, only : verticalGrid_type @@ -37,11 +38,22 @@ module MOM_int_tide_input !! regulate the timing of diagnostic output. real :: TKE_itide_max !< Maximum Internal tide conversion !! available to mix above the BBL [W m-2] + real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values + !! of T & S into thin layers [Z2 T-1 ~> m2 s-1]. real, allocatable, dimension(:,:) :: TKE_itidal_coef !< The time-invariant field that enters the TKE_itidal input calculation [J m-2]. character(len=200) :: inputdir !< The directory for input files. + logical :: int_tide_source_test !< If true, apply an arbitrary generation site + !! for internal tide testing (BDM) + type(time_type) :: time_max_source !< A time for use in testing internal tides + real :: int_tide_source_x !< X Location of generation site + !! for internal tide for testing (BDM) + real :: int_tide_source_y !< Y Location of generation site + !! for internal tide for testing (BDM) + + !>@{ Diagnostic IDs integer :: id_TKE_itidal = -1, id_Nb = -1, id_N2_bot = -1 !!@} @@ -75,18 +87,20 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) type(int_tide_input_CS), pointer :: CS !< This module's control structure. ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & - N2_bot ! The bottom squared buoyancy frequency [s-2]. + N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & T_f, S_f ! The temperature and salinity in [degC] and [ppt] with the values in ! the massless layers filled vertically by diffusion. logical :: use_EOS ! If true, density is calculated from T & S using an ! equation of state. + logical :: avg_enabled ! for testing internal tides (BDM) + type(time_type) :: time_end !< For use in testing internal tides (BDM) + + integer :: i, j, k, is, ie, js, je, nz integer :: isd, ied, jsd, jed - real :: kappa_fill ! diffusivity used to fill massless layers - real :: dt_fill ! timestep used to fill massless layers is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -94,32 +108,43 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) if (.not.associated(CS)) call MOM_error(FATAL,"set_diffusivity: "//& "Module must be initialized before it is used.") - kappa_fill = 1.e-3*US%m_to_Z**2 !### Dimensional constant [m2 s-1]. - dt_fill = 7200. !### Dimensionalconstant [s]. - use_EOS = associated(tv%eqn_of_state) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, kappa_fill, dt_fill, T_f, S_f, G, GV) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill, dt*US%s_to_T, T_f, S_f, G, GV) endif call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) -!$OMP parallel do default(none) shared(is,ie,js,je,G,itide,N2_bot,CS) + !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) - itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j),CS%TKE_itide_max) + itide%Nb(i,j) = G%mask2dT(i,j) * US%s_to_T*sqrt(N2_bot(i,j)) + itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) enddo ; enddo + if (CS%int_tide_source_test) then + itide%TKE_itidal_input(:,:) = 0.0 + avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end) + if (time_end <= CS%time_max_source) then + do j=js,je ; do i=is,ie + ! Input an arbitrary energy point source.id_ + if (((G%geoLonCu(I-1,j)-CS%int_tide_source_x) * (G%geoLonBu(I,j)-CS%int_tide_source_x) <= 0.0) .and. & + ((G%geoLatCv(i,J-1)-CS%int_tide_source_y) * (G%geoLatCv(i,j)-CS%int_tide_source_y) <= 0.0)) then + itide%TKE_itidal_input(i,j) = 1.0 + endif + enddo ; enddo + endif + endif + if (CS%debug) then - call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0) + call hchksum(N2_bot,"N2_bot",G%HI,haloshift=0, scale=US%s_to_T**2) call hchksum(itide%TKE_itidal_input,"TKE_itidal_input",G%HI,haloshift=0) endif if (CS%id_TKE_itidal > 0) call post_data(CS%id_TKE_itidal, itide%TKE_itidal_input, CS%diag) if (CS%id_Nb > 0) call post_data(CS%id_Nb, itide%Nb, CS%diag) - if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot,N2_bot,CS%diag) + if (CS%id_N2_bot > 0 ) call post_data(CS%id_N2_bot, N2_bot, CS%diag) end subroutine set_int_tide_input @@ -156,11 +181,11 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) real :: dz_int ! The thickness associated with an interface [Z ~> m]. real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density [Z m3 s-2 kg-1 ~> m4 s-2 kg-1]. + ! density [Z m3 T-2 kg-1 ~> m4 s-2 kg-1]. logical :: do_i(SZI_(G)), do_any integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2*GV%LZT_g_Earth) / GV%Rho0 ! Find the (limited) density jump across each interface. do i=is,ie @@ -259,11 +284,15 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) character(len=200) :: filename, tideamp_file, h2_file real :: mask_itidal + real :: max_frac_rough ! The fraction relating the maximum topographic roughness + ! to the mean depth [nondim] real :: utide ! constant tidal amplitude [m s-1] to be used if ! tidal amplitude file is not present. real :: kappa_h2_factor ! factor for the product of wavenumber * rms sgs height. real :: kappa_itides ! topographic wavenumber and non-dimensional scaling real :: min_zbot_itides ! Minimum ocean depth for internal tide conversion [Z ~> m]. + integer :: tlen_days !< Time interval from start for adding wave source + !! for testing internal tides (BDM) integer :: i, j, is, ie, js, je, isd, ied, jsd, jed if (associated(CS)) then @@ -295,6 +324,10 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total "//& "ocean depth is less than this value.", units="m", default=0.0, scale=US%m_to_Z) + call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_fill, & + "A diapycnal diffusivity that is used to interpolate "//& + "more sensible values of T & S into thin layers.", & + default=1.0e-6, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & @@ -339,15 +372,35 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', itide%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + + ! The following parameters are used in testing the internal tide code. + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TEST", CS%int_tide_source_test, & + "If true, apply an arbitrary generation site for internal tide testing", & + default=.false.) + if (CS%int_tide_source_test)then + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + "X Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + "Y Location of generation site for internal tide", default=1.) + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_TLEN_DAYS", tlen_days, & + "Time interval from start of experiment for adding wave source", & + units="days", default=0) + CS%time_max_source = Time + set_time(0, days=tlen_days) + endif + do j=js,je ; do i=is,ie mask_itidal = 1.0 if (G%bathyT(i,j) < min_zbot_itides) mask_itidal = 0.0 itide%tideamp(i,j) = itide%tideamp(i,j) * mask_itidal * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the use here of a hard-coded nondimensional constant. - itide%h2(i,j) = min(0.01*G%bathyT(i,j)**2, itide%h2(i,j)) + ! Restrict rms topo to a fraction (often 10 percent) of the column depth. + if (max_frac_rough >= 0.0) & + itide%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, itide%h2(i,j)) ! Compute the fixed part of internal tidal forcing; units are [J m-2] here. CS%TKE_itidal_coef(i,j) = 0.5*kappa_h2_factor*GV%Rho0*& @@ -362,7 +415,7 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) 'Bottom Buoyancy Frequency', 's-1') CS%id_N2_bot = register_diag_field('ocean_model','N2_b_itide',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) end subroutine int_tide_input_init diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index b5caeb2f53..e80793695f 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -55,8 +55,8 @@ module MOM_kappa_shear real :: lambda2_N_S !< The square of the ratio of the coefficients of !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale. Nondim. - real :: TKE_bg !< The background level of TKE [m2 s-2]. - real :: kappa_0 !< The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. + real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. + real :: kappa_0 !< The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real :: kappa_tol_err !< The fractional error in kappa that is tolerated. real :: Prandtl_turb !< Prandtl number used to convert Kd_shear into viscosity. integer :: nkml !< The number of layers in the mixed layer, as @@ -109,21 +109,18 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [Pa] (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. Initially this is the + !! (not layer!) [Z2 T-1 ~> m2 s-1]. Initially this is the !! value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at + !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. This discards any + !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -134,24 +131,21 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZI_(G),SZK_(GV)+1) :: & - kappa_2d, tke_2d ! 2-D versions of various kappa_io and tke_io. + kappa_2d, & ! 2-D version of kappa_io [Z2 T-1 ~> m2 s-1]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [Z m s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [Z m s-1 ~> m2 s-1]. T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. + kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. + tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -172,27 +166,11 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkap, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif is = G%isc ; ie = G%iec; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -289,22 +267,29 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = 0.25 * US%s_to_T**2 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) + f2 = 0.25 * ((G%CoriolisBu(I,j)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I,J-1)**2 + G%CoriolisBu(I-1,J)**2)) surface_pres = 0.0 ; if (associated(p_surf)) surface_pres = p_surf(i,j) - ! ---------------------------------------------------- + ! ---------------------------------------------------- I_Ld2_1d, dz_Int_1d + ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(i,K) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) +#endif ! call cpu_clock_begin(id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. @@ -328,15 +313,8 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,1) = 0.0 ; dz_Int_2d(i,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(i,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(i,K) = dz_Int(K) - enddo - I_Ld2_2d(i,nzc+1) = 0.0 ; dz_Int_2d(i,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(id_clock_setup) @@ -344,8 +322,7 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & do K=1,nz+1 kappa_2d(i,K) = 0.0 ; tke_2d(i,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(i,K) = 0.0 - dz_Int_2d(i,K) = dz_Int(K) + I_Ld2_2d(i,K) = 0.0 ; dz_Int_2d(i,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -355,16 +332,15 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) - dz_Int_3d(i,j,K) = dz_Int_2d(i,K) + I_Ld2_3d(i,j,K) = I_Ld2_2d(i,K) ; dz_Int_3d(i,j,K) = dz_Int_2d(i,K) #endif enddo ; enddo enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) - call hchksum(tke_io, "tke", G%HI) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif if (CS%id_Kd_shear > 0) call post_data(CS%id_Kd_shear, kappa_io, CS%diag) @@ -400,19 +376,16 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: tke_io !< The turbulent kinetic energy per unit mass at - !! each interface (not layer!) [m2 s-2]. - !! Initially this is the value from the previous - !! timestep, which may accelerate the iteration - !! toward convergence. + intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at + !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 s-1 ~> m2 s-1]. + intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. !! The previous value is used to initialize kappa !! in the vertex columes as Kappa = Kv/Prandtl !! to accelerate the iteration toward covergence. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. logical, optional, intent(in) :: initialize_all !< If present and false, the previous @@ -423,26 +396,22 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ h_2d, & ! A 2-D version of h, but converted to m. u_2d, v_2d, T_2d, S_2d, rho_2d ! 2-D versions of u_in, v_in, T, S, and rho. real, dimension(SZIB_(G),SZK_(GV)+1,2) :: & - kappa_2d ! Quasi 2-D versions of kappa_io [Z2 s-1 ~> m2 s-1]. + kappa_2d ! Quasi 2-D versions of kappa_io [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & - tke_2d ! 2-D version tke_io [m2 s-2]. + tke_2d ! 2-D version tke_io [Z2 T-2 ~> m2 s-2]. real, dimension(SZK_(GV)) :: & - u, & ! The zonal velocity after a timestep of mixing [m s-1]. - v, & ! The meridional velocity after a timestep of mixing [m s-1]. Idz, & ! The inverse of the distance between TKE points [Z-1 ~> m-1]. - T, & ! The potential temperature after a timestep of mixing [degC]. - Sal, & ! The salinity after a timestep of mixing [ppt]. dz, & ! The layer thickness [Z ~> m]. u0xdz, & ! The initial zonal velocity times dz [m Z s-1 ~> m2 s-1]. v0xdz, & ! The initial meridional velocity times dz [m Z s-1 ~> m2 s-1]. T0xdz, & ! The initial temperature times dz [degC Z ~> degC m]. S0xdz ! The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1) :: & - kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 s-1 ~> m2 s-1]. - tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [m2 s-2]. - kappa_avg, & ! The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. - tke_avg ! The time-weighted average of TKE [m2 s-2]. - real :: f2 ! The squared Coriolis parameter of each column [s-2]. + kappa, & ! The shear-driven diapycnal diffusivity at an interface [Z2 T-1 ~> m2 s-1]. + tke, & ! The Turbulent Kinetic Energy per unit mass at an interface [Z2 T-2 ~> m2 s-2]. + kappa_avg, & ! The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. + tke_avg ! The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. + real :: f2 ! The squared Coriolis parameter of each column [T-2 ~> s-2]. real :: surface_pres ! The top surface pressure [Pa]. real :: dz_in_lay ! The running sum of the thickness in a layer [Z ~> m]. @@ -466,34 +435,18 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ ! Diagnostics that should be deleted? #ifdef ADD_DIAGNOSTICS real, dimension(SZK_(GV)+1) :: & ! Additional diagnostics. - I_Ld2_1d + I_Ld2_1d, dz_Int_1d real, dimension(SZI_(G),SZK_(GV)+1) :: & ! 2-D versions of diagnostics. I_Ld2_2d, dz_Int_2d real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & ! 3-D versions of diagnostics. I_Ld2_3d, dz_Int_3d -#endif -#ifdef DEBUG - integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt - real, dimension(SZK_(GV)+1) :: & - Ri_k, tke_prev, dtke, dkappa, dtke_norm, & - ksrc_av ! The average through the iterations of k_src [s-1]. - real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & - tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 - real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & - dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm - real, dimension(SZK_(GV),0:max_debug_itt) :: & - u_it1, v_it1, rho_it1, T_it1, S_it1 - real, dimension(0:max_debug_itt) :: & - dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag - real, dimension(max_debug_itt) :: dt_it1 #endif isB = G%isc-1 ; ieB = G%iecB ; jsB = G%jsc-1 ; jeB = G%jecB ; nz = GV%ke use_temperature = .false. ; if (associated(tv%T)) use_temperature = .true. new_kappa = .true. ; if (present(initialize_all)) new_kappa = initialize_all - k0dt = dt*CS%kappa_0 + k0dt = dt*CS%kappa_0 dz_massless = 0.1*sqrt(k0dt) I_Prandtl = 0.0 ; if (CS%Prandtl_turb > 0.0) I_Prandtl = 1.0 / CS%Prandtl_turb @@ -612,25 +565,29 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ nzc = nz do k=1,nzc+1 ; kc(k) = k ; kf(k) = 0.0 ; enddo endif - f2 = US%s_to_T**2 * G%CoriolisBu(I,J)**2 - surface_pres = 0.0 ; if (associated(p_surf)) then + f2 = G%CoriolisBu(I,J)**2 + surface_pres = 0.0 ; if (associated(p_surf)) & surface_pres = 0.25 * ((p_surf(i,j) + p_surf(i+1,j+1)) + & (p_surf(i+1,j) + p_surf(i,j+1))) - endif ! ---------------------------------------------------- ! Set the initial guess for kappa, here defined at interfaces. ! ---------------------------------------------------- if (new_kappa) then - do K=1,nzc+1 ; kappa(K) = US%m_to_Z**2*1.0 ; enddo + do K=1,nzc+1 ; kappa(K) = US%m2_s_to_Z2_T*1.0 ; enddo else do K=1,nzc+1 ; kappa(K) = kappa_2d(I,K,J2) ; enddo endif +#ifdef ADD_DIAGNOSTICS + call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & + dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) +#else call kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & tke_avg, tv, CS, GV, US) - +#endif ! call cpu_clock_begin(Id_clock_setup) ! Extrapolate from the vertically reduced grid back to the original layers. if (nz == nzc) then @@ -645,23 +602,14 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ kappa_2d(I,K,J2) = kappa_avg(kc(K)) tke_2d(I,K) = tke_avg(kc(K)) else - kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + & - kf(K) * kappa_avg(kc(K)+1) - tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + & - kf(K) * tke_avg(kc(K)+1) + kappa_2d(I,K,J2) = (1.0-kf(K)) * kappa_avg(kc(K)) + kf(K) * kappa_avg(kc(K)+1) + tke_2d(I,K) = (1.0-kf(K)) * tke_avg(kc(K)) + kf(K) * tke_avg(kc(K)+1) endif enddo endif #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,1) = 0.0 ; dz_Int_2d(I,1) = dz_Int(1) - do K=2,nzc - I_Ld2_2d(I,K) = I_L2_bdry(K) + & - (N2(K) / CS%lambda**2 + f2) * Z2_to_L2 / (max(TKE(K),1e-30)) - dz_Int_2d(I,K) = dz_Int(K) - enddo - I_Ld2_2d(I,nzc+1) = 0.0 ; dz_Int_2d(I,nzc+1) = dz_Int(nzc+1) - do K=nzc+2,nz+1 - I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 + do K=1,nz+1 + I_Ld2_2d(i,K) = I_Ld2_1d(K) ; dz_Int_2d(i,K) = dz_Int_1d(K) enddo #endif ! call cpu_clock_end(Id_clock_setup) @@ -669,8 +617,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 kappa_2d(I,K,J2) = 0.0 ; tke_2d(I,K) = 0.0 #ifdef ADD_DIAGNOSTICS - I_Ld2_2d(I,K) = 0.0 - dz_Int_2d(I,K) = dz_Int(K) + I_Ld2_2d(I,K) = 0.0 ; dz_Int_2d(I,K) = 0.0 #endif enddo endif ; enddo ! i-loop @@ -679,8 +626,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb #ifdef ADD_DIAGNOSTICS - I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) - dz_Int_3d(I,J,K) = dz_Int_2d(I,K) + I_Ld2_3d(I,J,K) = I_Ld2_2d(I,K) ; dz_Int_3d(I,J,K) = dz_Int_2d(I,K) #endif enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec @@ -693,7 +639,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z_to_m**2) + call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) call Bchksum(tke_io, "tke", G%HI) endif @@ -710,16 +656,16 @@ end subroutine Calc_kappa_shear_vertex !> This subroutine calculates shear-driven diffusivity and TKE in a single column subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dz, u0xdz, v0xdz, T0xdz, S0xdz, kappa_avg, & - tke_avg, tv, CS, GV, US) + tke_avg, tv, CS, GV, US, I_Ld2_1d, dz_Int_1d) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)+1), & - intent(inout) :: kappa !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(inout) :: kappa !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(inout) :: tke !< The Turbulent Kinetic Energy per unit mass at - !! an interface [m2 s-2]. + intent(out) :: tke !< The Turbulent Kinetic Energy per unit mass at + !! an interface [Z2 T-2 ~> m2 s-2]. integer, intent(in) :: nzc !< The number of active layers in the column. - real, intent(in) :: f2 !< The square of the Coriolis parameter [s-2]. + real, intent(in) :: f2 !< The square of the Coriolis parameter [T-2 ~> s-2]. real, intent(in) :: surface_pres !< The surface pressure [Pa]. real, dimension(SZK_(GV)), & intent(in) :: dz !< The layer thickness [Z ~> m]. @@ -732,15 +678,20 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & real, dimension(SZK_(GV)), & intent(in) :: S0xdz !< The initial salinity times dz [ppt Z ~> ppt m]. real, dimension(SZK_(GV)+1), & - intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 s-1 ~> m2 s-1]. + intent(out) :: kappa_avg !< The time-weighted average of kappa [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)+1), & - intent(out) :: tke_avg !< The time-weighted average of TKE [m2 s-2]. - real, intent(in) :: dt !< Time increment [s]. + intent(out) :: tke_avg !< The time-weighted average of TKE [Z2 T-2 ~> m2 s-2]. + real, intent(in) :: dt !< Time increment [T ~> s]. type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any !! available thermodynamic fields. Absent fields !! have NULL ptrs. type(Kappa_shear_CS), pointer :: CS !< The control structure returned by a previous !! call to kappa_shear_init. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: I_Ld2_1d !< The inverse of the squared mixing length [Z-2 ~> m-2]. + real, dimension(SZK_(GV)+1), & + optional, intent(out) :: dz_Int_1d !< The extent of a finite-volume space surrounding an interface, + !! as used in calculating kappa and TKE [Z ~> m]. real, dimension(nzc) :: & u, & ! The zonal velocity after a timestep of mixing [m s-1]. @@ -751,59 +702,60 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & u_test, v_test, T_test, S_test real, dimension(nzc+1) :: & - N2, & ! The squared buoyancy frequency at an interface [s-2]. + N2, & ! The squared buoyancy frequency at an interface [T-2 ~> s-2]. dz_Int, & ! The extent of a finite-volume space surrounding an interface, ! as used in calculating kappa and TKE [Z ~> m]. I_dz_int, & ! The inverse of the distance between velocity & density points ! above and below an interface [Z-1 ~> m-1]. This is used to ! calculate N2, shear, and fluxes, and it might differ from ! 1/dz_Int, as they have different uses. - S2, & ! The squared shear at an interface [s-2]. + S2, & ! The squared shear at an interface [T-2 ~> s-2]. a1, & ! a1 is the coupling between adjacent interfaces in the TKE, ! velocity, and density equations [Z s-1 ~> m s-1] or [Z ~> m] c1, & ! c1 is used in the tridiagonal (and similar) solvers. - k_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_src, & ! The shear-dependent source term in the kappa equation [s-1]. - kappa_out, & ! The kappa that results from the kappa equation [Z2 s-1 ~> m2 s-1]. - kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 s-1 ~> m2 s-1]. - tke_pred, & ! The value of TKE from a predictor step [m2 s-2]. - kappa_pred, & ! The value of kappa from a predictor step [Z2 s-1 ~> m2 s-1]. + k_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. + kappa_src, & ! The shear-dependent source term in the kappa equation [T-1 ~> s-1]. + kappa_out, & ! The kappa that results from the kappa equation [Z2 T-1 ~> m2 s-1]. + kappa_mid, & ! The average of the initial and predictor estimates of kappa [Z2 T-1 ~> m2 s-1]. + tke_pred, & ! The value of TKE from a predictor step [Z2 T-2 ~> m2 s-2]. + kappa_pred, & ! The value of kappa from a predictor step [Z2 T-1 ~> m2 s-1]. pressure, & ! The pressure at an interface [Pa]. T_int, & ! The temperature interpolated to an interface [degC]. Sal_int, & ! The salinity interpolated to an interface [ppt]. dbuoy_dT, & ! The partial derivatives of buoyancy with changes in temperature - dbuoy_dS, & ! and salinity, [Z s-2 degC-1 ~> m s-2 degC-1] and [Z s-2 ppt-1 ~> m s-2 ppt-1]. + dbuoy_dS, & ! and salinity, [Z T-2 degC-1 ~> m s-2 degC-1] and [Z T-2 ppt-1 ~> m s-2 ppt-1]. I_L2_bdry, & ! The inverse of the square of twice the harmonic mean ! distance to the top and bottom boundaries [Z-2 ~> m-2]. - K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s ~> s]. - K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s ~> s]. + K_Q, & ! Diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. + K_Q_tmp, & ! A temporary copy of diffusivity divided by TKE [Z2 m-2 s2 T-1 ~> s]. local_src_avg, & ! The time-integral of the local source [nondim]. - tol_min, & ! Minimum tolerated ksrc for the corrector step [s-1]. - tol_max, & ! Maximum tolerated ksrc for the corrector step [s-1]. - tol_chg, & ! The tolerated change integrated in time [nondim]. + tol_min, & ! Minimum tolerated ksrc for the corrector step [T-1 ~> s-1]. + tol_max, & ! Maximum tolerated ksrc for the corrector step [T-1 ~> s-1]. + tol_chg, & ! The tolerated change integrated in time [s T-nondim]. dist_from_top, & ! The distance from the top surface [Z ~> m]. local_src ! The sum of all sources of kappa, including kappa_src and - ! sources from the elliptic term [s-1]. + ! sources from the elliptic term [T-1 ~> s-1]. real :: dist_from_bot ! The distance from the bottom surface [Z ~> m]. real :: b1 ! The inverse of the pivot in the tridiagonal equations. real :: bd1 ! A term in the denominator of b1. real :: d1 ! 1 - c1 in the tridiagonal equations. - real :: gR0 ! Rho_0 times g [kg m-2 s-2]. - real :: g_R0 ! g_R0 is g/Rho [Z m3 kg-1 s-2 ~> m4 kg-1 s-2]. + real :: gR0 ! A conversion factor from Z to Pa equal to Rho_0 times g + ! [kg m-1 Z-1 s-2 ~> kg m-2 s-2]. + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [Z m3 kg-1 T-2 ~> m4 kg-1 s-2]. real :: Norm ! A factor that normalizes two weights to 1 [Z-2 ~> m-2]. real :: tol_dksrc, tol2 ! ### Tolerances that need to be set better later. real :: tol_dksrc_low ! The tolerance for the fractional decrease in ksrc ! within an iteration. 0 < tol_dksrc_low < 1. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: dt_rem ! The remaining time to advance the solution [s]. - real :: dt_now ! The time step used in the current iteration [s]. + real :: dt_rem ! The remaining time to advance the solution [T ~> s]. + real :: dt_now ! The time step used in the current iteration [T ~> s]. real :: dt_wt ! The fractional weight of the current iteration [nondim]. real :: dt_test ! A time-step that is being tested for whether it - ! gives acceptably small changes in k_src [s]. - real :: Idtt ! Idtt = 1 / dt_test [s-1]. - real :: dt_inc ! An increment to dt_test that is being tested [s]. + ! gives acceptably small changes in k_src [T ~> s]. + real :: Idtt ! Idtt = 1 / dt_test [T-1 ~> s-1]. + real :: dt_inc ! An increment to dt_test that is being tested [T ~> s]. real :: k0dt ! The background diffusivity times the timestep [Z2 ~> m2]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small @@ -818,9 +770,27 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & ! to estimate the maximum permitted time step. I.e., ! the resolution is 1/2^dt_refinements. integer :: k, itt, itt_dt +#ifdef DEBUG + integer :: max_debug_itt ; parameter(max_debug_itt=20) + real :: wt(SZK_(GV)+1), wt_tot, I_wt_tot, wt_itt + real, dimension(SZK_(GV)+1) :: & + Ri_k, tke_prev, dtke, dkappa, dtke_norm, & + N2_debug, & ! A version of N2 for debugging [T-2 ~> s-2] + ksrc_av ! The average through the iterations of k_src [T-1 ~> s-1]. + real, dimension(SZK_(GV)+1,0:max_debug_itt) :: & + tke_it1, N2_it1, Sh2_it1, ksrc_it1, kappa_it1, kprev_it1 + real, dimension(SZK_(GV)+1,1:max_debug_itt) :: & + dkappa_it1, wt_it1, K_Q_it1, d_dkappa_it1, dkappa_norm + real, dimension(SZK_(GV),0:max_debug_itt) :: & + u_it1, v_it1, rho_it1, T_it1, S_it1 + real, dimension(0:max_debug_itt) :: & + dk_wt_it1, dkpos_wt_it1, dkneg_wt_it1, k_mag + real, dimension(max_debug_itt) :: dt_it1 +#endif Ri_crit = CS%Rino_crit - gR0 = GV%Rho0*(GV%g_Earth*US%m_to_Z) ; g_R0 = (GV%g_Earth*US%m_to_Z**2)/GV%Rho0 + gR0 = GV%z_to_H*GV%H_to_Pa + g_R0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 k0dt = dt*CS%kappa_0 ! These are hard-coded for now. Perhaps these could be made dynamic later? ! tol_dksrc = 0.5*tol_ksrc_chg ; tol_dksrc_low = 1.0 - 1.0/tol_ksrc_chg ? @@ -895,10 +865,6 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo dz_Int(nzc) = dz_Int(nzc) + dz(nzc) ; dz_Int(nzc+1) = 0.0 -#ifdef ADD_DIAGNOSTICS - do K=1,nzc+1 ; I_Ld2_1d(K) = 0.0 ; enddo -#endif - dist_from_bot = 0.0 do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz(k) @@ -910,26 +876,26 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (use_temperature) then pressure(1) = surface_pres do K=2,nzc - pressure(K) = pressure(K-1) + gR0*US%Z_to_m*dz(k-1) + pressure(K) = pressure(K-1) + gR0*dz(k-1) T_int(K) = 0.5*(T(k-1) + T(k)) Sal_int(K) = 0.5*(Sal(k-1) + Sal(k)) enddo call calculate_density_derivs(T_int, Sal_int, pressure, dbuoy_dT, & dbuoy_dS, 2, nzc-1, tv%eqn_of_state) do K=2,nzc - dbuoy_dT(K) = -G_R0*dbuoy_dT(K) - dbuoy_dS(K) = -G_R0*dbuoy_dS(K) + dbuoy_dT(K) = -g_R0*dbuoy_dT(K) + dbuoy_dS(K) = -g_R0*dbuoy_dS(K) enddo else - do K=1,nzc+1 ; dbuoy_dT(K) = -G_R0 ; dbuoy_dS(K) = 0.0 ; enddo + do K=1,nzc+1 ; dbuoy_dT(K) = -g_R0 ; dbuoy_dS(K) = 0.0 ; enddo endif #ifdef DEBUG - N2(1) = 0.0 ; N2(nzc+1) = 0.0 + N2_debug(1) = 0.0 ; N2_debug(nzc+1) = 0.0 do K=2,nzc - N2(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & - dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & - I_dz_int(K), 0.0) + N2_debug(K) = max((dbuoy_dT(K) * (T0xdz(k-1)*Idz(k-1) - T0xdz(k)*Idz(k)) + & + dbuoy_dS(K) * (S0xdz(k-1)*Idz(k-1) - S0xdz(k)*Idz(k))) * & + I_dz_int(K), 0.0) enddo do k=1,nzc u_it1(k,0) = u0xdz(k)*Idz(k) ; v_it1(k,0) = v0xdz(k)*Idz(k) @@ -937,10 +903,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do K=1,nzc+1 kprev_it1(K,0) = kappa(K) ; kappa_it1(K,0) = kappa(K) - tke_it1(K,0) = tke(K) - N2_it1(K,0) = N2(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = k_src(K) + tke_it1(K,0) = 0.0 + N2_it1(K,0) = N2_debug(K) ; Sh2_it1(K,0) = S2(K) ; ksrc_it1(K,0) = K_src(K) enddo - do k=nzc+1,nz + do k=nzc+1,GV%ke u_it1(k,0) = 0.0 ; v_it1(k,0) = 0.0 T_it1(k,0) = 0.0 ; S_it1(k,0) = 0.0 kprev_it1(K+1,0) = 0.0 ; kappa_it1(K+1,0) = 0.0 ; tke_it1(K+1,0) = 0.0 @@ -948,12 +914,12 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo do itt=1,max_debug_itt dt_it1(itt) = 0.0 - do k=1,nz + do k=1,GV%ke u_it1(k,itt) = 0.0 ; v_it1(k,itt) = 0.0 T_it1(k,itt) = 0.0 ; S_it1(k,itt) = 0.0 rho_it1(k,itt) = 0.0 enddo - do K=1,nz+1 + do K=1,GV%ke+1 kprev_it1(K,itt) = 0.0 ; kappa_it1(K,itt) = 0.0 ; tke_it1(K,itt) = 0.0 N2_it1(K,itt) = 0.0 ; Sh2_it1(K,itt) = 0.0 ksrc_it1(K,itt) = 0.0 @@ -961,7 +927,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & K_Q_it1(K,itt) = 0.0 ; d_dkappa_it1(K,itt) = 0.0 enddo enddo - do K=1,nz+1 ; ksrc_av(K) = 0.0 ; enddo + do K=1,GV%ke+1 ; ksrc_av(K) = 0.0 ; enddo #endif ! This call just calculates N2 and S2. @@ -992,7 +958,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & #ifdef DEBUG do K=1,nzc+1 Ri_k(K) = 1e3 ; if (S2(K) > 1e-3*N2(K)) Ri_k(K) = N2(K) / S2(K) - tke_prev(K) = tke(K) + if (itt > 1) then ; tke_prev(K) = tke(K) ; else ; tke_prev(K) = 0.0 ; endif enddo #endif @@ -1043,10 +1009,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / dt_test do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1069,11 +1035,10 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Idtt = 1.0 / (dt_test+dt_inc) do K=max(ks_kappa-1,2),min(ke_kappa+1,nzc) if (N2(K) < Ri_crit * S2(K)) then ! Equivalent to Ri < Ri_crit. - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & - ((Ri_crit*S2(K) - N2(K)) / & - (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) - if ((k_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & - (k_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) + if ((K_src(K) > max(tol_max(K), kappa_src(K) + Idtt*tol_chg(K))) .or. & + (K_src(K) < min(tol_min(K), kappa_src(K) - Idtt*tol_chg(K)))) then valid_dt = .false. ; exit endif else @@ -1090,7 +1055,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & dt_inc = 0.0 endif - dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc,dt_rem) + dt_now = min(dt_test*(1.0+CS%kappa_tol_err)+dt_inc, dt_rem) do K=2,nzc local_src_avg(K) = local_src_avg(K) + dt_now * local_src(K) enddo @@ -1173,7 +1138,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = 0.0 wt_itt = 1.0/real(itt) ; wt_tot = 0.0 do K=1,nzc+1 - ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*k_src(K) + ksrc_av(K) = (1.0-wt_itt)*ksrc_av(K) + wt_itt*K_src(K) wt_tot = wt_tot + dz_Int(K) * ksrc_av(K) enddo ! Use the 1/0=0 convention. @@ -1184,7 +1149,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & k_mag(itt) = k_mag(itt) + wt(K)*kappa_mid(K) dkappa_it1(K,itt) = kappa_pred(K) - kappa_out(K) dk_wt_it1(itt) = dk_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) - if (dk > 0.0) then + if (dkappa_it1(K,itt) > 0.0) then dkpos_wt_it1(itt) = dkpos_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) else dkneg_wt_it1(itt) = dkneg_wt_it1(itt) + wt(K)*dkappa_it1(K,itt) @@ -1196,7 +1161,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & Ri_k(K) = 1e3 ; if (N2(K) < 1e3 * S2(K)) Ri_k(K) = N2(K) / S2(K) dtke(K) = tke_pred(K) - tke(K) dtke_norm(K) = dtke(K) / (0.5*(tke(K) + tke_pred(K))) - dkap(K) = kappa_pred(K) - kappa_out(K) + dkappa(K) = kappa_pred(K) - kappa_out(K) enddo if (itt <= max_debug_itt) then do k=1,nzc @@ -1204,8 +1169,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & T_it1(k,itt) = T(k) ; S_it1(k,itt) = Sal(k) enddo do K=1,nzc+1 - kprev_it1(K,itt)=kappa_out(K) - kappa_it1(K,itt)=kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) + kprev_it1(K,itt) = kappa_out(K) + kappa_it1(K,itt) = kappa_mid(K) ; tke_it1(K,itt) = 0.5*(tke(K)+tke_pred(K)) N2_it1(K,itt)=N2(K) ; Sh2_it1(K,itt)=S2(K) ksrc_it1(K,itt) = kappa_src(K) K_Q_it1(K,itt) = kappa_out(K) / (TKE(K)) @@ -1213,7 +1178,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & if (abs(dkappa_it1(K,itt-1)) > 1e-20) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif - dkappa_norm(K,itt) = dkap(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m_to_Z**2*1e-100) + dkappa_norm(K,itt) = dkappa(K) / max(0.5*(kappa_pred(K) + kappa_out(K)), US%m2_s_to_Z2_T*1e-100) enddo endif #endif @@ -1222,6 +1187,19 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, & enddo ! end itt loop +#ifdef ADD_DIAGNOSTICS + if (present(I_Ld2_1d)) then + do K=1,GV%ke+1 ; I_Ld2_1d(K) = 0.0 ; enddo + do K=2,nzc ; if (TKE(K) > 0.0) & + I_Ld2_1d(K) = I_L2_bdry(K) + (N2(K) / CS%lambda**2 + f2) / TKE(K) + enddo + endif + if (present(dz_Int_1d)) then + do K=1,nzc+1 ; dz_Int_1d(K) = dz_Int(K) ; enddo + do K=nzc+2,GV%ke ; dz_Int_1d(K) = 0.0 ; enddo + endif +#endif + end subroutine kappa_shear_column !> This subroutine calculates the velocities, temperature and salinity that @@ -1233,7 +1211,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & integer, intent(in) :: nz !< The number of layers (after eliminating massless !! layers?). real, dimension(nz+1), intent(in) :: kappa !< The diapycnal diffusivity at interfaces, - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz), intent(in) :: u0 !< The initial zonal velocity [m s-1]. real, dimension(nz), intent(in) :: v0 !< The initial meridional velocity [m s-1]. real, dimension(nz), intent(in) :: T0 !< The initial temperature [degC]. @@ -1242,10 +1220,10 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & real, dimension(nz+1), intent(in) :: I_dz_int !< The inverse of the layer's thicknesses !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: dbuoy_dT !< The partial derivative of buoyancy with - !! temperature [Z s-2 degC-1 ~> m s-2 degC-1]. + !! temperature [Z T-2 degC-1 ~> m s-2 degC-1]. real, dimension(nz+1), intent(in) :: dbuoy_dS !< The partial derivative of buoyancy with - !! salinity [Z s-2 ppt-1 ~> m s-2 ppt-1]. - real, intent(in) :: dt !< The time step [s]. + !! salinity [Z T-2 ppt-1 ~> m s-2 ppt-1]. + real, intent(in) :: dt !< The time step [T ~> s]. real, dimension(nz), intent(inout) :: u !< The zonal velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: v !< The meridional velocity after dt [m s-1]. real, dimension(nz), intent(inout) :: T !< The temperature after dt [degC]. @@ -1253,9 +1231,9 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), optional, & - intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. + intent(inout) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. real, dimension(nz+1), optional, & - intent(inout) :: S2 !< The squared shear at interfaces [s-2]. + intent(inout) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. integer, optional, intent(in) :: ks_int !< The topmost k-index with a non-zero diffusivity. integer, optional, intent(in) :: ke_int !< The bottommost k-index with a non-zero !! diffusivity. @@ -1266,7 +1244,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & ! Local variables real, dimension(nz+1) :: c1 real :: L2_to_Z2 ! A conversion factor from horizontal length units to vertical depth - ! units squared [Z2 m-2 ~> 1]. + ! units squared [Z2 s2 T-2 m-2 ~> 1]. real :: underflow_vel ! Velocities smaller in magnitude than underflow_vel are set to 0 [m s-1]. real :: a_a, a_b, b1, d1, bd1, b1nz_0 integer :: k, ks, ke @@ -1337,7 +1315,7 @@ subroutine calculate_projected_state(kappa, u0, v0, T0, S0, dt, nz, & endif if (present(S2)) then - L2_to_Z2 = US%m_to_Z**2 + L2_to_Z2 = US%m_to_Z**2 * US%T_to_s**2 S2(1) = 0.0 ; S2(nz+1) = 0.0 if (ks > 1) & S2(ks) = ((u(ks)-u0(ks-1))**2 + (v(ks)-v0(ks-1))**2) * (L2_to_Z2*I_dz_int(ks)**2) @@ -1368,57 +1346,58 @@ end subroutine calculate_projected_state subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & nz, CS, GV, US, K_Q, tke, kappa, kappa_src, local_src) integer, intent(in) :: nz !< The number of layers to work on. - real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [s-2]. - real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [s-2]. + real, dimension(nz+1), intent(in) :: N2 !< The buoyancy frequency squared at interfaces [T-2 ~> s-2]. + real, dimension(nz+1), intent(in) :: S2 !< The squared shear at interfaces [T-2 ~> s-2]. real, dimension(nz+1), intent(in) :: kappa_in !< The initial guess at the diffusivity - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), intent(in) :: dz_Int !< The thicknesses associated with interfaces !! [Z-1 ~> m-1]. real, dimension(nz+1), intent(in) :: I_L2_bdry !< The inverse of the squared distance to - !! boundaries [m-2]. + !! boundaries [Z-2 !> m-2]. real, dimension(nz), intent(in) :: Idz !< The inverse grid spacing of layers [Z-1 ~> m-1]. - real, intent(in) :: f2 !< The squared Coriolis parameter [s-2]. + real, intent(in) :: f2 !< The squared Coriolis parameter [T-2 ~> s-2]. type(Kappa_shear_CS), pointer :: CS !< A pointer to this module's control structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(nz+1), intent(inout) :: K_Q !< The shear-driven diapycnal diffusivity divided by !! the turbulent kinetic energy per unit mass at - !! interfaces [s]. + !! interfaces [Z2 m-2 s2 T-1 ~> s]. real, dimension(nz+1), intent(out) :: tke !< The turbulent kinetic energy per unit mass at - !! interfaces [m2 s-2]. + !! interfaces [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1), intent(out) :: kappa !< The diapycnal diffusivity at interfaces - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. real, dimension(nz+1), optional, & - intent(out) :: kappa_src !< The source term for kappa [s-1]. + intent(out) :: kappa_src !< The source term for kappa [T-1]. real, dimension(nz+1), optional, & intent(out) :: local_src !< The sum of all local sources for kappa, - !! [s-1]. + !! [T-1 ~> s-1]. ! This subroutine calculates new, consistent estimates of TKE and kappa. ! Local variables real, dimension(nz) :: & - aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [m s-1]. - dQdz ! Half the partial derivative of TKE with depth [m s-2]. + aQ, & ! aQ is the coupling between adjacent interfaces in the TKE equations [Z T-1 ~> m s-1]. + dQdz ! Half the partial derivative of TKE with depth [Z T-2 ~> m s-2]. real, dimension(nz+1) :: & - dK, & ! The change in kappa [Z2 s-1 ~> m2 s-1]. - dQ, & ! The change in TKE [m2 s-2]. + dK, & ! The change in kappa [Z2 T-1 ~> m2 s-1]. + dQ, & ! The change in TKE [Z2 T-2 ~> m2 s-2]. cQ, cK, & ! cQ and cK are the upward influences in the tridiagonal and ! hexadiagonal solvers for the TKE and kappa equations [nondim]. - I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale - ! for kappa [Z-2 ~> m-2]. - TKE_decay, & ! The local TKE decay rate [s-1]. - k_src, & ! The source term in the kappa equation [s-1]. - dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [m2 s Z-2 ~> s]. - dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [Z2 m-2 s-1 ~> s-1]. + I_Ld2, & ! 1/Ld^2, where Ld is the effective decay length scale for kappa [Z-2 ~> m-2]. + TKE_decay, & ! The local TKE decay rate [T-1 ~> s-1]. + k_src, & ! The source term in the kappa equation [T-1 ~> s-1]. + dQmdK, & ! With Newton's method the change in dQ(k-1) due to dK(k) [T ~> s]. + dKdQ, & ! With Newton's method the change in dK(k) due to dQ(k) [T-1 ~> s-1]. e1 ! The fractional change in a layer TKE due to a change in the ! TKE of the layer above when all the kappas below are 0. ! e1 is nondimensional, and 0 < e1 < 1. real :: tke_src ! The net source of TKE due to mixing against the shear - ! and stratification [m2 s-3]. (For convenience, + ! and stratification [Z2 T-3 ~> m2 s-3]. (For convenience, ! a term involving the non-dissipation of q0 is also ! included here.) - real :: bQ, bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. - real :: bd1 ! A term in the denominator of bQ or bK. + real :: bQ ! The inverse of the pivot in the tridiagonal equations [T Z-1 ~> s m-1]. + real :: bK ! The inverse of the pivot in the tridiagonal equations [Z-1 ~> m-1]. + real :: bQd1 ! A term in the denominator of bQ [Z T-1 ~> m s-1]. + real :: bKd1 ! A term in the denominator of bK [Z ~> m]. real :: cQcomp, cKcomp ! 1 - cQ or 1 - cK in the tridiagonal equations. real :: c_s2 ! The coefficient for the decay of TKE due to ! shear (i.e. proportional to |S|*tke), nondimensional. @@ -1426,30 +1405,28 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! stratification (i.e. proportional to N*tke) [nondim]. real :: Ri_crit ! The critical shear Richardson number for shear- ! driven mixing. The theoretical value is 0.25. - real :: q0 ! The background level of TKE [m2 s-2]. - real :: Ilambda2 ! 1.0 / CS%lambda**2. + real :: q0 ! The background level of TKE [Z2 T-2 ~> m2 s-2]. + real :: Ilambda2 ! 1.0 / CS%lambda**2 [nondim] real :: TKE_min ! The minimum value of shear-driven TKE that can be - ! solved for [m2 s-2]. - real :: kappa0 ! The background diapycnal diffusivity [Z2 s-1 ~> m2 s-1]. - real :: max_err ! The maximum value of norm_err in a column [nondim]. - real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 s-1 ~> m2 s-1]. + ! solved for [Z2 T-2 ~> m2 s-2]. + real :: kappa0 ! The background diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: kappa_trunc ! Diffusivities smaller than this are rounded to 0 [Z2 T-1 ~> m2 s-1]. real :: eden1, eden2, I_eden, ome ! Variables used in calculating e1. - real :: diffusive_src ! The diffusive source in the kappa equation [m s-1]. + real :: diffusive_src ! The diffusive source in the kappa equation [Z T-1 ~> m s-1]. real :: chg_by_k0 ! The value of k_src that leads to an increase of - ! kappa_0 if only the diffusive term is a sink [s-1]. + ! kappa_0 if only the diffusive term is a sink [T-1 ~> s-1]. - real :: kappa_mean ! A mean value of kappa [Z2 s-1 ~> m2 s-1]. + real :: kappa_mean ! A mean value of kappa [Z2 T-1 ~> m2 s-1]. real :: Newton_test ! The value of relative error that will cause the next ! iteration to use Newton's method. ! Temporary variables used in the Newton's method iterations. real :: decay_term_k ! The decay term in the diffusivity equation - real :: decay_term_Q ! The decay term in the TKE equation + real :: decay_term_Q ! The decay term in the TKE equation - proportional to [T-1 ~> s-1] real :: I_Q ! The inverse of TKE [s2 m-2] real :: kap_src - real :: v1, v2 - real :: Z2_to_L2 ! A conversion factor from vertical depth units to horizontal length - ! units squared [m2 Z-2]. + real :: v1 ! A temporary variable proportional to [T-1 ~> s-1] + real :: v2 real :: tol_err ! The tolerance for max_err that determines when to ! stop iterating. real :: Newton_err ! The tolerance for max_err that determines when to @@ -1472,24 +1449,22 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & integer :: itt, k, k2 #ifdef DEBUG integer :: max_debug_itt ; parameter(max_debug_itt=20) - real :: K_err_lin, Q_err_lin + real :: K_err_lin, Q_err_lin, TKE_src_norm real, dimension(nz+1) :: & - kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 s-1 ~> m2 s-1]. - TKE_prev ! The value of TKE at the start of the current iteration [m2 s-2]. + I_Ld2_debug, & ! A separate version of I_Ld2 for debugging [Z-2 ~> m-2]. + kappa_prev, & ! The value of kappa at the start of the current iteration [Z2 T-1 ~> m2 s-1]. + TKE_prev ! The value of TKE at the start of the current iteration [Z2 T-2 ~> m2 s-2]. real, dimension(nz+1,1:max_debug_itt) :: & tke_it1, kappa_it1, kprev_it1, & ! Various values from each iteration. dkappa_it1, K_Q_it1, d_dkappa_it1, dkappa_norm_it1 - real :: norm_err ! The absolute change in kappa between iterations, - ! normalized by the value of kappa [nondim]. - real :: max_TKE_err, min_TKE_err, TKE_err(nz) ! Various normalized TKE changes. integer :: it2 #endif c_N2 = CS%C_N**2 ; c_S2 = CS%C_S**2 - q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 ; TKE_min = max(CS%TKE_bg,1.0E-20) + q0 = CS%TKE_bg ; kappa0 = CS%kappa_0 + TKE_min = max(CS%TKE_bg, 1.0E-20*US%m_to_Z**2*US%T_to_s**2) Ri_crit = CS%Rino_crit Ilambda2 = 1.0 / CS%lambda**2 - Z2_to_L2 = US%Z_to_m**2 kappa_trunc = 0.01*kappa0 ! ### CHANGE THIS HARD-WIRING LATER? do_Newton = .false. ; abort_Newton = .false. tol_err = CS%kappa_tol_err @@ -1503,7 +1478,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Ri = N2(K) / S2(K) ! k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ! ((Ri_crit - Ri) / (Ri_crit + CS%FRi_curvature*Ri)) - k_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & + K_src(K) = (2.0 * CS%Shearmix_rate * sqrt(S2(K))) * & ((Ri_crit*S2(K) - N2(K)) / (Ri_crit*S2(K) + CS%FRi_curvature*N2(K))) ke_src = K if (ks_src > k) ks_src = K @@ -1573,34 +1548,34 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! terms. ke_tke = max(ke_kappa,ke_kappa_prev)+1 - ! aQ is the coupling between adjacent interfaces [Z s-1 ~> m s-1]. + ! aQ is the coupling between adjacent interfaces [Z T-1 ~> m s-1]. do k=1,min(ke_tke,nz) aQ(k) = (0.5*(kappa(K)+kappa(K+1)) + kappa0) * Idz(k) enddo dQ(1) = -TKE(1) if (tke_noflux_top_BC) then - tke_src = Z2_to_L2*kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 - bd1 = dz_Int(1) * TKE_decay(1) - bQ = 1.0 / (bd1 + aQ(1)) + tke_src = kappa0*S2(1) + q0 * TKE_decay(1) ! Uses that kappa(1) = 0 + bQd1 = dz_Int(1) * TKE_decay(1) + bQ = 1.0 / (bQd1 + aQ(1)) tke(1) = bQ * (dz_Int(1)*tke_src) - cQ(2) = aQ(1) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + cQ(2) = aQ(1) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ else tke(1) = q0 ; cQ(2) = 0.0 ; cQcomp = 1.0 endif do K=2,ke_tke-1 dQ(K) = -TKE(K) - tke_src = Z2_to_L2*(kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) - bd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*Z2_to_L2*K_Q(K)) + cQcomp*aQ(k-1) - bQ = 1.0 / (bd1 + aQ(k)) + tke_src = (kappa(K) + kappa0)*S2(K) + q0*TKE_decay(K) + bQd1 = dz_Int(K)*(TKE_decay(K) + N2(K)*K_Q(K)) + cQcomp*aQ(k-1) + bQ = 1.0 / (bQd1 + aQ(k)) tke(K) = bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) - cQ(K+1) = aQ(k) * bQ ; cQcomp = bd1 * bQ ! = 1 - cQ + cQ(K+1) = aQ(k) * bQ ; cQcomp = bQd1 * bQ ! = 1 - cQ enddo if ((ke_tke == nz+1) .and. .not.(tke_noflux_bottom_BC)) then tke(nz+1) = TKE_min dQ(nz+1) = 0.0 else k = ke_tke - tke_src = Z2_to_L2*kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 + tke_src = kappa0*S2(K) + q0*TKE_decay(K) ! Uses that kappa(ke_tke) = 0 if (K == nz+1) then dQ(K) = -TKE(K) bQ = 1.0 / (dz_Int(K)*TKE_decay(K) + cQcomp*aQ(k-1)) @@ -1612,8 +1587,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Account for all changes deeper in the water column. dQ(K) = -TKE(K) tke(K) = max((bQ * (dz_Int(K)*tke_src + aQ(k-1)*tke(K-1)) + & - cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / & - (1.0 - cQ(K+1)*e1(K+1)), TKE_min) + cQ(K+1)*(tke(K+1) - e1(K+1)*tke(K))) / (1.0 - cQ(K+1)*e1(K+1)), TKE_min) dQ(K) = tke(K) + dQ(K) ! Adjust TKE deeper in the water column in case ke_tke increases. @@ -1643,17 +1617,17 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(1) = 0.0 ! kappa takes boundary values of 0. cK(2) = 0.0 ; cKcomp = 1.0 if (itt == 1) then ; dO K=2,nz - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) enddo ; endif do K=2,nz dK(K) = -kappa(K) if (itt>1) & - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * Z2_to_L2 / tke(K) + I_L2_bdry(K) - bd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) - bK = 1.0 / (bd1 + Idz(k)) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) / tke(K) + I_L2_bdry(K) + bKd1 = dz_Int(K)*I_Ld2(K) + cKcomp*Idz(k-1) + bK = 1.0 / (bKd1 + Idz(k)) - kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * k_src(K)) - cK(K+1) = Idz(k) * bK ; cKcomp = bd1 * bK ! = 1 - cK(K+1) + kappa(K) = bK * (Idz(k-1)*kappa(K-1) + dz_Int(K) * K_src(K)) + cK(K+1) = Idz(k) * bK ; cKcomp = bKd1 * bK ! = 1 - cK(K+1) ! Neglect values that are smaller than kappa_trunc. if (kappa(K) < cKcomp*kappa_trunc) then @@ -1692,7 +1666,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & aQ(1) = (0.5*(kappa(1)+kappa(2))+kappa0) * Idz(1) dQdz(1) = 0.5*(TKE(1) - TKE(2))*Idz(1) if (tke_noflux_top_BC) then - tke_src = dz_Int(1) * (Z2_to_L2*kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & + tke_src = dz_Int(1) * (kappa0*S2(1) - (TKE(1) - q0)*TKE_decay(1)) - & aQ(1) * (TKE(1) - TKE(2)) bQ = 1.0 / (aQ(1) + dz_Int(1)*TKE_decay(1)) @@ -1705,9 +1679,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif do K=2,nz I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa(K)) + & + kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa(K)) + & Idz(k-1)*(kappa(K-1)-kappa(K)) - Idz(k)*(kappa(K)-kappa(K+1)) ! Ensure that the pivot is always positive, and that 0 <= cK <= 1. @@ -1718,8 +1692,11 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & cK(K+1) = bK * Idz(k) cKcomp = bK * (Idz(k-1)*cKcomp + decay_term_k) ! = 1-cK(K+1) + !### The following expression appears to be dimensionally inconsistent in length. -RWH dKdQ(K) = bK * (Idz(k-1)*dKdQ(K-1)*cQ(K) + & - US%Z_to_m*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + US%m_to_Z*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) + ! I think that the second term needs to be multiplied by dz_Int(K): + ! dz_Int(K)*(N2(K)*Ilambda2 + f2) * I_Q**2 * kappa(K) ) dK(K) = bK * (kap_src + Idz(k-1)*dK(K-1) + Idz(k-1)*dKdQ(K-1)*dQ(K-1)) ! Truncate away negligibly small values of kappa. @@ -1733,12 +1710,12 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! Solve for dQ(K)... aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) dQdz(k) = 0.5*(TKE(K) - TKE(K+1))*Idz(k) - tke_src = dz_Int(K) * (Z2_to_L2*((kappa(k) + kappa0)*S2(k) - kappa(k)*N2(k)) - & + tke_src = dz_Int(K) * (((kappa(K) + kappa0)*S2(K) - kappa(k)*N2(K)) - & (TKE(k) - q0)*TKE_decay(k)) - & (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) v2 = (v1*dQmdK(K) + dQdz(k-1)*cK(K)) + & - ((dQdz(k-1) - dQdz(k)) + Z2_to_L2*dz_Int(K)*(S2(K) - N2(K))) + ((dQdz(k-1) - dQdz(k)) + dz_Int(K)*(S2(K) - N2(K))) ! Ensure that the pivot is always positive, and that 0 <= cQ <= 1. ! Otherwise do not use Newton's method. @@ -1765,7 +1742,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & dK(nz+1) = 0.0 ; dKdQ(nz+1) = 0.0 if (tke_noflux_bottom_BC) then K = nz+1 - tke_src = dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & + tke_src = dz_Int(K) * (kappa0*S2(K) - (TKE(K) - q0)*TKE_decay(K)) + & aQ(k-1) * (TKE(K-1) - TKE(K)) v1 = aQ(k-1) + dQdz(k-1)*dKdQ(K-1) @@ -1775,8 +1752,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & else bQ = 1.0 / (aQ(k) + (cQcomp*aQ(k-1) + decay_term_Q)) ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), & - -0.5*TKE(K)) + dQ(K) = max(bQ * ((v1 * dQ(K-1) + dQdz(k-1)*dK(K-1)) + tke_src), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) endif else @@ -1791,9 +1767,9 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (K < nz+1) then ! Ignore this source? aQ(k) = (0.5*(kappa(K)+kappa(K+1))+kappa0) * Idz(k) - tke_src = (dz_Int(K) * (Z2_to_L2*kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & - (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & - (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) + tke_src_norm = (dz_Int(K) * (kappa0*S2(K) - (TKE(K)-q0)*TKE_decay(K)) - & + (aQ(k) * (TKE(K) - TKE(K+1)) - aQ(k-1) * (TKE(K-1) - TKE(K))) ) / & + (aQ(k) + (aQ(k-1) + dz_Int(K)*TKE_decay(K))) endif #endif dK(K) = 0.0 @@ -1810,8 +1786,7 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & if (.not. abort_Newton) then do K=ke_kappa,2,-1 ! Ensure that TKE+dQ will not drop below 0.5*TKE. - dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), & - -0.5*TKE(K)) + dQ(K) = max(dQ(K) + (cQ(K+1)*dQ(K+1) + dQmdK(K+1) * dK(K+1)), -0.5*TKE(K)) TKE(K) = max(TKE(K) + dQ(K), TKE_min) dK(K) = dK(K) + (cK(K+1)*dK(K+1) + dKdQ(K) * dQ(K)) ! Truncate away negligibly small values of kappa. @@ -1843,52 +1818,31 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & ! been increased to ensure a positive pivot, or 2) negative TKEs have been ! truncated, or 3) small or negative kappas have been rounded toward 0. I_Q = 1.0 / TKE(K) - I_Ld2(K) = (N2(K)*Ilambda2 + f2) * (Z2_to_L2*I_Q) + I_L2_bdry(K) + I_Ld2_debug(K) = (N2(K)*Ilambda2 + f2) * I_Q + I_L2_bdry(K) - kap_src = dz_Int(K) * (k_src(K) - I_Ld2(K)*kappa_prev(K)) + & + kap_src = dz_Int(K) * (K_src(K) - I_Ld2(K)*kappa_prev(K)) + & (Idz(k-1)*(kappa_prev(k-1)-kappa_prev(k)) - & Idz(k)*(kappa_prev(k)-kappa_prev(k+1))) + !### The last line of the following appears to be dimensionally inconsistent with the first two. + ! I think that the term on the last line needs to be multiplied by dz_Int(K). K_err_lin = -Idz(k-1)*(dK(K-1)-dK(K)) + Idz(k)*(dK(K)-dK(K+1)) + & - dz_Int(K)*I_Ld2(K)*dK(K) - kap_src - & - US%Z_to_m*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) - - tke_src = dz_Int(K) * (Z2_to_L2*(kappa_prev(K) + kappa0)*S2(K) - & - Z2_to_L2*kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & - (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - & - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) - Q_err_lin = (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & - 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & - 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & - dz_Int(K) * (Z2_to_L2*dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) + tke_src + dz_Int(K)*I_Ld2_debug(K)*dK(K) - kap_src - & + US%m_to_Z*(N2(K)*Ilambda2 + f2)*I_Q**2*kappa_prev(K) * dQ(K) + + tke_src = dz_Int(K) * ((kappa_prev(K) + kappa0)*S2(K) - & + kappa_prev(K)*N2(K) - (TKE_prev(K) - q0)*TKE_decay(K)) - & + (aQ(k) * (TKE_prev(K) - TKE_prev(K+1)) - aQ(k-1) * (TKE_prev(K-1) - TKE_prev(K))) + Q_err_lin = tke_src + (aQ(k-1) * (dQ(K-1)-dQ(K)) - aQ(k) * (dQ(k)-dQ(k+1))) - & + 0.5*(TKE_prev(K)-TKE_prev(K+1))*Idz(k) * (dK(K) + dK(K+1)) - & + 0.5*(TKE_prev(K)-TKE_prev(K-1))*Idz(k-1)* (dK(K-1) + dK(K)) + & + dz_Int(K) * (dK(K) * (S2(K) - N2(K)) - dQ(K)*TKE_decay(K)) enddo #endif endif ! End of the Newton's method solver. ! Test kappa for convergence... -#ifdef DEBUG - max_err = 0.0 ; max_TKE_err = 0.0 ; min_TKE_err = 0.0 - do K=min(ks_kappa,ks_kappa_prev),max(ke_kappa,ke_kappa_prev) - norm_err = abs(kappa(K) - kappa_prev(K)) / & - (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) - if (max_err < norm_err) max_err = norm_err - - TKE_err(K) = dQ(K) / (tke(K) - 0.5*dQ(K)) - if (TKE_err(K) > max_TKE_err) max_TKE_err = TKE_err(K) - if (TKE_err(K) < min_TKE_err) min_TKE_err = TKE_err(K) - enddo - if (do_Newton) then - if (max(max_err,max_TKE_err,-min_TKE_err) >= 2.0*Newton_err) then - do_Newton = .false. ; abort_Newton = .true. - endif - else - if (max(max_err,max_TKE_err,-min_TKE_err) < Newton_err) do_Newton = .true. - endif - within_tolerance = (max_err < tol_err) -#else - ! max_err = 0.0 if ((tol_err < Newton_err) .and. (.not.abort_Newton)) then - ! A lower tolerance is used to switch to Newton's method than to - ! switch back. + ! A lower tolerance is used to switch to Newton's method than to switch back. Newton_test = Newton_err ; if (do_Newton) Newton_test = 2.0*Newton_err was_Newton = do_Newton within_tolerance = .true. ; do_Newton = .true. @@ -1914,7 +1868,6 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & endif enddo endif -#endif if (abort_Newton) then do_Newton = .false. ; abort_Newton = .false. @@ -1927,14 +1880,14 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & #ifdef DEBUG if (itt <= max_debug_itt) then do K=1,nz+1 - kprev_it1(K,itt)=kappa_prev(K) - kappa_it1(K,itt)=kappa(K) ; tke_it1(K,itt) = tke(K) + kprev_it1(K,itt) = kappa_prev(K) + kappa_it1(K,itt) = kappa(K) ; tke_it1(K,itt) = tke(K) dkappa_it1(K,itt) = kappa(K) - kappa_prev(K) dkappa_norm_it1(K,itt) = (kappa(K) - kappa_prev(K)) / & (kappa0 + 0.5*(kappa(K) + kappa_prev(K))) K_Q_it1(K,itt) = kappa(K) / max(TKE(K),TKE_min) d_dkappa_it1(K,itt) = 0.0 - if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20) & + if (itt > 1) then ; if (abs(dkappa_it1(K,itt-1)) > 1e-20*US%m2_s_to_Z2_T) & d_dkappa_it1(K,itt) = dkappa_it1(K,itt) / dkappa_it1(K,itt-1) endif enddo @@ -1964,16 +1917,16 @@ subroutine find_kappa_tke(N2, S2, kappa_in, Idz, dz_Int, I_L2_bdry, f2, & diffusive_src = Idz(k-1)*(kappa(K-1)-kappa(K)) + Idz(k)*(kappa(K+1)-kappa(K)) chg_by_k0 = kappa0 * ((Idz(k-1)+Idz(k)) / dz_Int(K) + I_Ld2(K)) if (diffusive_src <= 0.0) then - local_src(K) = k_src(K) + chg_by_k0 + local_src(K) = K_src(K) + chg_by_k0 else - local_src(K) = (k_src(K) + chg_by_k0) + diffusive_src / dz_Int(K) + local_src(K) = (K_src(K) + chg_by_k0) + diffusive_src / dz_Int(K) endif enddo endif if (present(kappa_src)) then kappa_src(1) = 0.0 ; kappa_src(nz+1) = 0.0 do K=2,nz - kappa_src(K) = k_src(K) + kappa_src(K) = K_src(K) enddo endif @@ -2043,7 +1996,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "The background diffusivity that is used to smooth the "//& "density and shear profiles before solving for the "//& "diffusivities. Defaults to value of KD.", & - units="m2 s-1", default=KD_normal, scale=US%m_to_Z**2) + units="m2 s-1", default=KD_normal, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the "//& "Richardson number in the kappa source term in the "//& @@ -2079,7 +2032,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & "A background level of TKE used in the first iteration "//& "of the kappa equation. TKE_BACKGROUND could be 0.", & - units="m2 s-2", default=0.0) + units="m2 s-2", default=0.0, scale=US%m_to_Z**2*US%T_to_s**2) call get_param(param_file, mdl, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & "If true, massless layers are merged with neighboring "//& "massive layers in this calculation. The default is "//& @@ -2123,9 +2076,9 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear',diag%axesTi,Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_TKE = register_diag_field('ocean_model','TKE_shear',diag%axesTi,Time, & - 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2') + 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) #ifdef ADD_DIAGNOSTICS CS%id_ILd2 = register_diag_field('ocean_model','ILd2_shear',diag%axesTi,Time, & 'Inverse kappa decay scale at interfaces', 'm-2', conversion=US%m_to_Z**2) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 75aa447e15..4fc420f24f 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -6,27 +6,50 @@ module MOM_opacity use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_ptr, post_data use MOM_diag_mediator, only : query_averaging_enabled, register_diag_field use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase -use MOM_forcing_type, only : forcing, optics_type -use MOM_grid, only : ocean_grid_type -use MOM_io, only : slasher -use MOM_tracer_flow_control, only : get_chl_from_model, tracer_flow_control_CS -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use time_interp_external_mod, only : init_external_field, time_interp_external -use time_interp_external_mod, only : time_interp_external_init +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type + implicit none ; private #include public set_opacity, opacity_init, opacity_end, opacity_manizza, opacity_morel +public extract_optics_slice, extract_optics_fields, optics_nbands +public absorbRemainingSW, sumSWoverBands + +!> This type is used to store information about ocean optical properties +type, public :: optics_type + integer :: nbands !< The number of penetrating bands of SW radiation + + real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] + !! The number of radiation bands is most rapidly varying (first) index. + + real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates beyond the surface. + !! The most rapidly varying dimension is the band. + + real, pointer, dimension(:) :: & + min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] + max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] + + real :: PenSW_flux_absorb !< A heat flux that is small enough to be completely absorbed in the next + !! sufficiently thick layer [H degC T-1 ~> degC m s-1 or degC kg m-2 s-1]. + real :: PenSW_absorb_Invlen !< The inverse of the thickness that is used to absorb the remaining + !! shortwave heat flux when it drops below PEN_SW_FLUX_ABSORB [H ~> m or kg m-2]. + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + +end type optics_type !> The control structure with paramters for the MOM_opacity module type, public :: opacity_CS ; private - logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified below) to - !! determine the e-folding depth of incoming short wave radiation. - !! The default is false. + logical :: var_pen_sw !< If true, use one of the CHL_A schemes (specified by OPACITY_SCHEME) to + !! determine the e-folding depth of incoming shortwave radiation. integer :: opacity_scheme !< An integer indicating which scheme should be used to translate !! water properties into the opacity (i.e., the e-folding depth) and !! (perhaps) the number of bands of penetrating shortwave radiation to use. @@ -41,17 +64,11 @@ module MOM_opacity !! radiation that is in the blue band [nondim]. real :: opacity_land_value !< The value to use for opacity over land [m-1]. !! The default is 10 m-1 - a value for muddy water. - integer :: sbc_chl !< An integer handle used in time interpolation of - !! chlorophyll read from a file. - logical :: chl_from_file !< If true, chl_a is read from a file. - type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - !< A pointer to the control structure of the tracer modules. !>@{ Diagnostic IDs - integer :: id_sw_pen = -1, id_sw_vis_pen = -1, id_chl = -1 + integer :: id_sw_pen = -1, id_sw_vis_pen = -1 integer, pointer :: id_opacity(:) => NULL() !!@} end type opacity_CS @@ -68,39 +85,43 @@ module MOM_opacity contains !> This sets the opacity of sea water based based on one of several different schemes. -subroutine set_opacity(optics, fluxes, G, GV, CS) +subroutine set_opacity(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) type(optics_type), intent(inout) :: optics !< An optics structure that has values !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(opacity_CS), pointer :: CS !< The control structure earlier set up by !! opacity_init. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions[mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: chl_3d !< The chlorophyll-A concentractions of each layer [mg m-3] -! local variables + ! Local variables integer :: i, j, k, n, is, ie, js, je, nz real :: inv_sw_pen_scale ! The inverse of the e-folding scale [m-1]. real :: Inv_nbands ! The inverse of the number of bands of penetrating ! shortwave radiation. logical :: call_for_surface ! if horizontal slice is the surface layer - real :: tmp(SZI_(G),SZJ_(G),SZK_(G)) ! A 3-d temporary array. - real :: chl(SZI_(G),SZJ_(G),SZK_(G)) ! The concentration of chlorophyll-A [mg m-3]. + real :: tmp(SZI_(G),SZJ_(G),SZK_(GV)) ! A 3-d temporary array. + real :: chl(SZI_(G),SZJ_(G),SZK_(GV)) ! The concentration of chlorophyll-A [mg m-3]. real :: Pen_SW_tot(SZI_(G),SZJ_(G)) ! The penetrating shortwave radiation ! summed across all bands [W m-2]. - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not. associated(CS)) call MOM_error(FATAL, "set_opacity: "// & "Module must be initialized via opacity_init before it is used.") - if (CS%var_pen_sw) then - if (CS%chl_from_file) then - call opacity_from_chl(optics, fluxes, G, CS) - else - call get_chl_from_model(chl, G, CS%tracer_flow_CSp) - call opacity_from_chl(optics, fluxes, G, CS, chl) - endif + if (present(chl_2d) .or. present(chl_3d)) then + ! The optical properties are based on cholophyll concentrations. + call opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) else ! Use sw e-folding scale set by MOM_input if (optics%nbands <= 1) then ; Inv_nbands = 1.0 else ; Inv_nbands = 1.0 / real(optics%nbands) ; endif @@ -115,7 +136,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) optics%opacity_band(2,i,j,k) = 1.0 / max(CS%pen_sw_scale_2nd, & 0.1*GV%Angstrom_m,GV%H_to_m*GV%H_subroundoff) enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -123,15 +144,15 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie - optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) - optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * fluxes%sw(i,j) + optics%sw_pen_band(1,i,j) = (CS%SW_1st_EXP_RATIO) * sw_total(i,j) + optics%sw_pen_band(2,i,j) = (1.-CS%SW_1st_EXP_RATIO) * sw_total(i,j) enddo ; enddo endif else do k=1,nz ; do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%opacity_band(n,i,j,k) = inv_sw_pen_scale enddo ; enddo ; enddo ; enddo - if (.not.associated(fluxes%sw) .or. (CS%pen_SW_scale <= 0.0)) then + if (.not.associated(sw_total) .or. (CS%pen_SW_scale <= 0.0)) then !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands optics%sw_pen_band(n,i,j) = 0.0 @@ -139,7 +160,7 @@ subroutine set_opacity(optics, fluxes, G, GV, CS) else !$OMP parallel do default(shared) do j=js,je ; do i=is,ie ; do n=1,optics%nbands - optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * fluxes%sw(i,j) + optics%sw_pen_band(n,i,j) = CS%pen_SW_frac * Inv_nbands * sw_total(i,j) enddo ; enddo ; enddo endif endif @@ -189,17 +210,22 @@ end subroutine set_opacity !> This sets the "blue" band opacity based on chloophyll A concencentrations !! The red portion is lumped into the net heating at the surface. -subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) - type(optics_type), intent(inout) :: optics !< An optics structure that has values - !! set based on the opacities. - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any - !! possible forcing fields. Unused fields - !! have NULL ptrs. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(opacity_CS), pointer :: CS !< The control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(in) :: chl_in !< A 3-d field of chlorophyll A, - !! in mg m-3. +subroutine opacity_from_chl(optics, sw_total, sw_vis_dir, sw_vis_dif, sw_nir_dir, sw_nir_dif, & + G, GV, CS, chl_2d, chl_3d) + type(optics_type), intent(inout) :: optics !< An optics structure that has values + !! set based on the opacities. + real, dimension(:,:), pointer :: sw_total !< Total shortwave flux into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dir !< Visible, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_vis_dif !< Visible, diffuse shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dir !< Near-IR, direct shortwave into the ocean [W m-2] + real, dimension(:,:), pointer :: sw_nir_dif !< Near-IR, diffuse shortwave into the ocean [W m-2] + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(opacity_CS), pointer :: CS !< The control structure. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: chl_2d !< Vertically uniform chlorophyll-A concentractions [mg m-3] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(in) :: chl_3d !< A 3-d field of chlorophyll-A concentractions [mg m-3] real :: chl_data(SZI_(G),SZJ_(G)) ! The chlorophyll A concentrations in a layer [mg m-3]. real :: Inv_nbands ! The inverse of the number of bands of penetrating @@ -217,7 +243,7 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) integer :: i, j, k, n, is, ie, js, je, nz, nbands logical :: multiband_vis_input, multiband_nir_input - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke ! In this model, the Morel (modified) and Manizza (modified) schemes ! use the "blue" band in the parameterizations to determine the e-folding @@ -227,9 +253,8 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) ! Morel, A., Optical modeling of the upper ocean in relation to its biogenous ! matter content (case-i waters).,J. Geo. Res., {93}, 10,749--10,768, 1988. ! - ! Manizza, M., C.~L. Quere, A.~Watson, and E.~T. Buitenhuis, Bio-optical -! feedbacks amoung phytoplankton, upper ocean physics and sea-ice in a +! feedbacks among phytoplankton, upper ocean physics and sea-ice in a ! global model, Geophys. Res. Let., , L05,603, 2005. nbands = optics%nbands @@ -240,61 +265,51 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) if (nbands <= 2) then ; Inv_nbands_nir = 0.0 else ; Inv_nbands_nir = 1.0 / real(nbands - 2.0) ; endif - multiband_vis_input = (associated(fluxes%sw_vis_dir) .and. & - associated(fluxes%sw_vis_dif)) - multiband_nir_input = (associated(fluxes%sw_nir_dir) .and. & - associated(fluxes%sw_nir_dif)) + multiband_vis_input = (associated(sw_vis_dir) .and. & + associated(sw_vis_dif)) + multiband_nir_input = (associated(sw_nir_dir) .and. & + associated(sw_nir_dif)) chl_data(:,:) = 0.0 - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,1) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,1) ; enddo ; enddo do k=1,nz; do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_in(i,j,k) < 0.0)) then - write(mesg,'(" Negative chl_in of ",(1pe12.4)," found at i,j,k = ", & - & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & - chl_in(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + if ((G%mask2dT(i,j) > 0.5) .and. (chl_3d(i,j,k) < 0.0)) then + write(mesg,'(" Negative chl_3d of ",(1pe12.4)," found at i,j,k = ", & + & 3(1x,i3), " lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & + chl_3d(i,j,k), i, j, k, G%geoLonT(i,j), G%geoLatT(i,j) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo ; enddo - else - ! Only the 2-d surface chlorophyll can be read in from a file. The - ! same value is assumed for all layers. - call time_interp_external(CS%sbc_chl, CS%Time, chl_data) + elseif (present(chl_2d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_2d(i,j) ; enddo ; enddo do j=js,je ; do i=is,ie - if ((G%mask2dT(i,j) > 0.5) .and. (chl_data(i,j) < 0.0)) then - write(mesg,'(" Time_interp negative chl of ",(1pe12.4)," at i,j = ",& + if ((G%mask2dT(i,j) > 0.5) .and. (chl_2d(i,j) < 0.0)) then + write(mesg,'(" Negative chl_2d of ",(1pe12.4)," at i,j = ", & & 2(i3), "lon/lat = ",(1pe12.4)," E ", (1pe12.4), " N.")') & chl_data(i,j), i, j, G%geoLonT(i,j), G%geoLatT(i,j) - call MOM_error(FATAL,"MOM_opacity opacity_from_chl: "//trim(mesg)) + call MOM_error(FATAL, "MOM_opacity opacity_from_chl: "//trim(mesg)) endif enddo ; enddo - endif - - if (CS%id_chl > 0) then - if (present(chl_in)) then - call post_data(CS%id_chl, chl_in(:,:,1), CS%diag) - else - call post_data(CS%id_chl, chl_data, CS%diag) - endif + else + call MOM_error(FATAL, "Either chl_2d or chl_3d must be preesnt in a call to opacity_form_chl.") endif select case (CS%opacity_scheme) case (MANIZZA_05) -!$OMP parallel do default(none) shared(is,ie,js,je,fluxes,optics,CS,G,multiband_nir_input, & -!$OMP nbands,Inv_nbands_nir,multiband_vis_input ) & -!$OMP private(SW_vis_tot,SW_nir_tot) + !$OMP parallel do default(shared) private(SW_vis_tot,SW_nir_tot) do j=js,je ; do i=is,ie SW_vis_tot = 0.0 ; SW_nir_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then if (multiband_vis_input) then - SW_vis_tot = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + SW_vis_tot = sw_vis_dir(i,j) + sw_vis_dif(i,j) else ! Follow Manizza 05 in assuming that 42% of SW is visible. - SW_vis_tot = 0.42 * fluxes%sw(i,j) + SW_vis_tot = 0.42 * sw_total(i,j) endif if (multiband_nir_input) then - SW_nir_tot = fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) + SW_nir_tot = sw_nir_dir(i,j) + sw_nir_dif(i,j) else - SW_nir_tot = fluxes%sw(i,j) - SW_vis_tot + SW_nir_tot = sw_total(i,j) - SW_vis_tot endif endif @@ -309,17 +324,15 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo enddo ; enddo case (MOREL_88) -!$OMP parallel do default(none) shared(is,ie,js,je,G,multiband_vis_input,chl_data, & -!$OMP fluxes,nbands,optics,Inv_nbands) & -!$OMP private(SW_pen_tot) + !$OMP parallel do default(shared) private(SW_pen_tot) do j=js,je ; do i=is,ie SW_pen_tot = 0.0 if (G%mask2dT(i,j) > 0.5) then ; if (multiband_vis_input) then SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - (fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j)) + (sw_vis_dir(i,j) + sw_vis_dif(i,j)) else SW_pen_tot = SW_pen_frac_morel(chl_data(i,j)) * & - 0.5*fluxes%sw(i,j) + 0.5*sw_total(i,j) endif ; endif do n=1,nbands @@ -328,13 +341,12 @@ subroutine opacity_from_chl(optics, fluxes, G, CS, chl_in) enddo ; enddo case default call MOM_error(FATAL, "opacity_from_chl: CS%opacity_scheme is not valid.") - end select + end select -!$OMP parallel do default(none) shared(nz,is,ie,js,je,CS,G,chl_in,optics,nbands) & -!$OMP firstprivate(chl_data) + !$OMP parallel do default(shared) firstprivate(chl_data) do k=1,nz - if (present(chl_in)) then - do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_in(i,j,k) ; enddo ; enddo + if (present(chl_3d)) then + do j=js,je ; do i=is,ie ; chl_data(i,j) = chl_3d(i,j,k) ; enddo ; enddo endif select case (CS%opacity_scheme) @@ -376,13 +388,13 @@ end subroutine opacity_from_chl !! Morel and Antoine (1994). function opacity_morel(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: opacity_morel !< The returned opacity [m-1] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real, dimension(6), parameter :: & Z2_coef=(/7.925, -6.644, 3.662, -1.815, -0.218, 0.502/) real :: Chl, Chl2 ! The log10 of chl_data (in mg m-3), and Chl^2. @@ -396,13 +408,13 @@ function opacity_morel(chl_data) !! Morel and Antoine (1994). function SW_pen_frac_morel(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: SW_pen_frac_morel -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! The following are coefficients for the optical model taken from Morel and -! Antoine (1994). These coeficients represent a non uniform distribution of -! chlorophyll-a through the water column. Other approaches may be more -! appropriate when using an interactive ecosystem model that predicts -! three-dimensional chl-a values. + real :: SW_pen_frac_morel !< The returned penetrating shortwave fraction [nondim] + + ! The following are coefficients for the optical model taken from Morel and + ! Antoine (1994). These coeficients represent a non uniform distribution of + ! chlorophyll-a through the water column. Other approaches may be more + ! appropriate when using an interactive ecosystem model that predicts + ! three-dimensional chl-a values. real :: Chl, Chl2 ! The log10 of chl_data in mg m-3, and Chl^2. real, dimension(6), parameter :: & V1_coef=(/0.321, 0.008, 0.132, 0.038, -0.017, -0.007/) @@ -416,49 +428,507 @@ end function SW_pen_frac_morel !! Manizza, M. et al, 2005. function opacity_manizza(chl_data) real, intent(in) :: chl_data !< The chlorophyll-A concentration in mg m-3. - real :: opacity_manizza -! Argument : chl_data - The chlorophyll-A concentration in mg m-3. -! This sets the blue-wavelength opacity according to the scheme proposed by -! Manizza, M. et al, 2005. + real :: opacity_manizza !< The returned opacity [m-1] +! This sets the blue-wavelength opacity according to the scheme proposed by Manizza, M. et al, 2005. opacity_manizza = 0.0232 + 0.074*chl_data**0.674 end function -subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) +!> This subroutine returns a 2-d slice at constant j of fields from an optics_type, with the potential +!! for rescaling these fields. +subroutine extract_optics_slice(optics, j, G, GV, opacity, opacity_scale, penSW_top, penSW_scale) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, intent(in) :: j !< j-index to extract + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(max(optics%nbands,1),SZI_(G),SZK_(GV)), & + optional, intent(out) :: opacity !< The opacity in each band, i-point, and layer + real, optional, intent(in) :: opacity_scale !< A factor by which to rescale the opacity. + real, dimension(max(optics%nbands,1),SZI_(G)), & + optional, intent(out) :: penSW_top !< The shortwave radiation [W m-2] at the surface + !! in each of the nbands bands that penetrates + !! beyond the surface skin layer. + real, optional, intent(in) :: penSW_scale !< A factor by which to rescale the shortwave flux. + + ! Local variables + real :: scale_opacity, scale_penSW ! Rescaling factors + integer :: i, is, ie, k, nz, n + is = G%isc ; ie = G%iec ; nz = G%ke + + scale_opacity = 1.0 ; if (present(opacity_scale)) scale_opacity = opacity_scale + scale_penSW = 1.0 ; if (present(penSW_scale)) scale_penSW = penSW_scale + + if (present(opacity)) then ; do k=1,nz ; do i=is,ie + do n=1,optics%nbands + opacity(n,i,k) = scale_opacity * optics%opacity_band(n,i,j,k) + enddo + enddo ; enddo ; endif + + if (present(penSW_top)) then ; do k=1,nz ; do i=is,ie + do n=1,optics%nbands + penSW_top(n,i) = scale_penSW * optics%SW_pen_band(n,i,j) + enddo + enddo ; enddo ; endif + +end subroutine extract_optics_slice + +!> Set arguments to fields from the optics type. +subroutine extract_optics_fields(optics, nbands) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer, optional, intent(out) :: nbands !< The number of penetrating bands of SW radiation + + if (present(nbands)) nbands = optics%nbands + +end subroutine extract_optics_fields + +!> Return the number of bands of penetrating shortwave radiation. +function optics_nbands(optics) + type(optics_type), intent(in) :: optics !< An optics structure that has values of opacities + !! and shortwave fluxes. + integer :: optics_nbands !< The number of penetrating bands of SW radiation + + optics_nbands = optics%nbands +end function optics_nbands + +!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted +!! from GOLD) or throughout the water column. +!! +!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total +!! water column thickness is greater than H_limit_fluxes. +!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the +!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. +subroutine absorbRemainingSW(G, GV, US, h, opacity_band, nsw, optics, j, dt, H_limit_fluxes, & + adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & + eps, ksort, htot, Ttot, TKE, dSV_dT) + + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: nsw !< Number of bands of penetrating + !! shortwave radiation. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(max(1,nsw),SZI_(G),SZK_(GV)), intent(in) :: opacity_band !< Opacity in each band of penetrating + !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. + !! The indicies are band, i, k. + type(optics_type), intent(in) :: optics !< An optics structure that has values of + !! opacities and shortwave fluxes. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< If the total ocean depth is + !! less than this, they are scaled away + !! to avoid numerical instabilities + !! [H ~> m or kg m-2]. This would + !! not be necessary if a finite heat + !! capacity mud-layer were added. + logical, intent(in) :: adjustAbsorptionProfile !< If true, apply + !! heating above the layers in which it + !! should have occurred to get the + !! correct mean depth (and potential + !! energy change) of the shortwave that + !! should be absorbed by each layer. + logical, intent(in) :: absorbAllSW !< If true, apply heating above the + !! layers in which it should have occurred + !! to get the correct mean depth (and + !! potential energy change) of the + !! shortwave that should be absorbed by + !! each layer. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer potential/conservative + !! temperatures [degC] + real, dimension(max(1,nsw),SZI_(G)), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in + !! each band that hits the bottom and will + !! will be redistributed through the water + !! column [degC H ~> degC m or degC kg m-2], + !! size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: eps !< Small thickness that must remain in + !! each layer, and which will not be + !! subject to heating [H ~> m or kg m-2] + integer, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: ksort !< Density-sorted k-indicies. + real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer + !! temperature [degC H ~> degC m or degC kg m-2] + real, dimension(SZI_(G),SZK_(GV)), optional, intent(in) :: dSV_dT !< The partial derivative of specific + !! volume with temperature [m3 kg-1 degC-1]. + real, dimension(SZI_(G),SZK_(GV)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating + !! throughout a layer [kg m-3 Z3 T-2 ~> J m-2]. + + ! Local variables + real, dimension(SZI_(G),SZK_(GV)) :: & + T_chg_above ! A temperature change that will be applied to all the thick + ! layers above a given layer [degC]. This is only nonzero if + ! adjustAbsorptionProfile is true, in which case the net + ! change in the temperature of a layer is the sum of the + ! direct heating of that layer plus T_chg_above from all of + ! the layers below, plus any contribution from absorbing + ! radiation that hits the bottom. + real, dimension(SZI_(G)) :: & + h_heat, & ! The thickness of the water column that will be heated by + ! any remaining shortwave radiation [H ~> m or kg m-2]. + T_chg, & ! The temperature change of thick layers due to the remaining + ! shortwave radiation and contributions from T_chg_above [degC]. + Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave + ! heating that hits the bottom and will be redistributed through + ! the water column [degC H ~> degC m or degC kg m-2] + real :: SW_trans ! fraction of shortwave radiation that is not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation that + ! is not absorbed because the layers are too thin + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + real :: heat_bnd ! heating due to absorption in the current + ! layer by the current band, including any piece that + ! is moved upward [degC H ~> degC m or degC kg m-2] + real :: SWa ! fraction of the absorbed shortwave that is + ! moved to layers above with adjustAbsorptionProfile [nondim] + real :: coSWa_frac ! The fraction of SWa that is actually moved upward. + real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] + real :: epsilon ! A small thickness that must remain in each + ! layer, and which will not be subject to heating [H ~> m or kg m-2] + real :: g_Hconv2 ! A conversion factor for use in the TKE calculation + ! in units of [Z3 kg2 m-6 T-2 H-2 ~> kg2 m-5 s-2 or m s-2]. + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + logical :: TKE_calc ! If true, calculate the implications to the + ! TKE budget of the shortwave heating. + real :: C1_6, C1_60 + integer :: is, ie, nz, i, k, ks, n + SW_Remains = .false. + + min_SW_heat = optics%PenSW_flux_absorb * dt + I_Habs = optics%PenSW_absorb_Invlen + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke + C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 + + TKE_calc = (present(TKE) .and. present(dSV_dT)) + + if (optics%answers_2018) then + g_Hconv2 = (US%m_to_Z**2 * US%L_to_Z**2*GV%LZT_g_Earth * GV%H_to_kg_m2) * GV%H_to_kg_m2 + else + g_Hconv2 = US%m_to_Z**2 * US%L_to_Z**2*GV%LZT_g_Earth * GV%H_to_kg_m2**2 + endif + + h_heat(:) = 0.0 + if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do ks=1,nz ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) + + T_chg_above(i,k) = 0.0 + + if (h(i,k) > 1.5*epsilon) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k) * opacity_band(n,i,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) + endif + endif + + Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) + if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then + ! In this case, a fraction of the heating is applied to the + ! overlying water so that the mean pressure at which the shortwave + ! heating occurs is exactly what it would have been with a careful + ! pressure-weighted averaging of the exponential heating profile, + ! hence there should be no TKE budget requirements due to this + ! layer. Very clever, but this is also limited so that the + ! water above is not heated at a faster rate than the layer + ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) + ! and takes the energetics of the rest of the heating into account. + ! (-RWH, ~7 years later.) + if (opt_depth > 1e-5) then + SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & + ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & + (1.0 - exp_OD)) + else + ! Use Taylor series expansion of the expression above for a + ! more accurate form with very small layer optical depths. + SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & + ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) + endif + coSWa_frac = 0.0 + if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then + coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & + (SWa*(h_heat(i) + h(i,k))) + SWa = h_heat(i) / (h_heat(i) + h(i,k)) + endif + + T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) + T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) + else + coSWa_frac = 1.0 + T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) + endif + + if (TKE_calc) then + if (opt_depth > 1e-2) then + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) + else + ! Use Taylor series-derived approximation to the above expression + ! that is well behaved and more accurate when opt_depth is small. + TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & + (0.5*h(i,k)*g_Hconv2) * & + (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + endif ; enddo + endif + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ; enddo ! i & k loops + + +! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return + + ! Unless modified, there is no temperature change due to fluxes from the bottom. + do i=is,ie ; T_chg(i) = 0.0 ; enddo + + if (absorbAllSW) then + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit >= 1.0) then + T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 + else + T_chg(i) = Pen_SW_rem(i) * Ih_limit + unabsorbed = 1.0 - h_heat(i)*Ih_limit + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + endif ! absorbAllSW + + if (absorbAllSW .or. adjustAbsorptionProfile) then + do ks=nz,1,-1 ; do i=is,ie + k = ks + if (present(ksort)) then + if (ksort(i,ks) <= 0) cycle + k = ksort(i,ks) + endif + + if (T_chg(i) > 0.0) then + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) + elseif (h(i,k) > h_min_heat) then + T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) + endif + endif + ! Increase the heating for layers above. + T_chg(i) = T_chg(i) + T_chg_above(i,k) + enddo ; enddo + if (present(htot) .and. present(Ttot)) then + do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo + endif + endif ! absorbAllSW .or. adjustAbsorptionProfile + +end subroutine absorbRemainingSW + + +!> This subroutine calculates the total shortwave heat flux integrated over +!! bands as a function of depth. This routine is only called for computing +!! buoyancy fluxes for use in KPP. This routine does not updat e the state. +subroutine sumSWoverBands(G, GV, US, h, optics, j, dt, & + H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + type(optics_type), intent(in) :: optics !< An optics structure that has values + !! set based on the opacities. + integer, intent(in) :: j !< j-index to work on. + real, intent(in) :: dt !< Time step [T ~> s]. + real, intent(in) :: H_limit_fluxes !< the total depth at which the + !! surface fluxes start to be limited to avoid + !! excessive heating of a thin ocean [H ~> m or kg m-2] + logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave + !! radiation is absorbed in the ocean water column. + real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave + !! heating in each band that hits the bottom and + !! will be redistributed through the water column + !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). + real, dimension(SZI_(G),SZK_(GV)+1), & + intent(inout) :: netPen !< Net penetrating shortwave heat flux at each + !! interface, summed across all bands + !! [degC H ~> degC m or degC kg m-2]. + ! Local variables + real :: h_heat(SZI_(G)) ! thickness of the water column that receives + ! remaining shortwave radiation [H ~> m or kg m-2]. + real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the + ! penetrating shortwave heating that hits the bottom + ! and will be redistributed through the water column + ! [degC H ~> degC m or degC kg m-2] + + real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd + real :: SW_trans ! fraction of shortwave radiation not + ! absorbed in a layer [nondim] + real :: unabsorbed ! fraction of the shortwave radiation + ! not absorbed because the layers are too thin. + real :: Ih_limit ! inverse of the total depth at which the + ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] + real :: min_SW_heat ! A minimum remaining shortwave heating within a timestep that will be simply + ! absorbed in the next layer for computational efficiency, instead of + ! continuing to penetrate [degC H ~> degC m or degC kg m-2]. + real :: I_Habs ! The inverse of the absorption length for a minimal flux [H-1 ~> m-1 or m2 kg-1] + real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] + real :: opt_depth ! optical depth of a layer [nondim] + real :: exp_OD ! exp(-opt_depth) [nondim] + logical :: SW_Remains ! If true, some column has shortwave radiation that + ! was not entirely absorbed. + + integer :: is, ie, nz, i, k, ks, n, nsw + SW_Remains = .false. + + min_SW_heat = optics%PenSW_flux_absorb*dt ! Default of 2.5e-11*US%T_to_s*GV%m_to_H + I_Habs = 1e3*GV%H_to_m ! optics%PenSW_absorb_Invlen + + h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff + is = G%isc ; ie = G%iec ; nz = G%ke ; nsw = optics%nbands + + pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) + do i=is,ie ; h_heat(i) = 0.0 ; enddo + netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface + + ! Apply penetrating SW radiation to remaining parts of layers. + ! Excessively thin layers are not heated to avoid runaway temps. + do k=1,nz + + do i=is,ie + netPen(i,k+1) = 0. + + if (h(i,k) > 0.0) then + do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then + ! SW_trans is the SW that is transmitted THROUGH the layer + opt_depth = h(i,k)*GV%H_to_m * optics%opacity_band(n,i,j,k) + exp_OD = exp(-opt_depth) + SW_trans = exp_OD + + ! Heating at a very small rate can be absorbed by a sufficiently thick layer or several + ! thin layers without further penetration. + if (optics%answers_2018) then + if (nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat*min(1.0, I_Habs*h(i,k)) ) SW_trans = 0.0 + elseif ((nsw*Pen_SW_bnd(n,i)*SW_trans < min_SW_heat) .and. (h(i,k) > h_min_heat)) then + if (nsw*Pen_SW_bnd(n,i) <= min_SW_heat * (I_Habs*(h(i,k) - h_min_heat))) then + SW_trans = 0.0 + else + SW_trans = min(SW_trans, & + 1.0 - (min_SW_heat*(I_Habs*(h(i,k) - h_min_heat))) / (nsw*Pen_SW_bnd(n,i))) + endif + endif + + Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans + netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) + endif ; enddo + endif ! h(i,k) > 0.0 + + ! Add to the accumulated thickness above that could be heated. + ! Only layers greater than h_min_heat thick should get heated. + if (h(i,k) >= 2.0*h_min_heat) then + h_heat(i) = h_heat(i) + h(i,k) + elseif (h(i,k) > h_min_heat) then + h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) + endif + enddo ! i loop + enddo ! k loop + + if (absorbAllSW) then + + ! If there is still shortwave radiation at this point, it could go into + ! the bottom (with a bottom mud model), or it could be redistributed back + ! through the water column. + do i=is,ie + Pen_SW_rem(i) = Pen_SW_bnd(1,i) + do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo + enddo + do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo + + Ih_limit = 1.0 / H_limit_fluxes + do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then + if (h_heat(i)*Ih_limit < 1.0) then + unabsorbed = 1.0 - h_heat(i)*Ih_limit + else + unabsorbed = 0.0 + endif + do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo + endif ; enddo + + endif ! absorbAllSW + +end subroutine sumSWoverBands + + + +!> This routine initalizes the opacity module, including an optics_type. +subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) type(time_type), target, intent(in) :: Time !< The current model time. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< model vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic !! output. - type(tracer_flow_control_CS), & - target, intent(in) :: tracer_flow !< A pointer to the tracer flow control - !! module's control structure type(opacity_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module. type(optics_type), pointer :: optics !< An optics structure that has parameters !! set and arrays allocated here. -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) diag - A structure that is used to regulate diagnostic output. -! -! (in/out) CS - A pointer that is set to point to the control structure -! for this module -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=200) :: inputdir ! The directory where NetCDF input files - character(len=240) :: filename + ! Local variables character(len=200) :: tmpstr character(len=40) :: mdl = "MOM_opacity" character(len=40) :: bandnum, shortname character(len=200) :: longname character(len=40) :: scheme_string + ! This include declares and sets the variable "version". +# include "version_variable.h" + real :: PenSW_absorb_minthick ! A thickness that is used to absorb the remaining shortwave heat + ! flux when that flux drops below PEN_SW_FLUX_ABSORB [m]. + real :: PenSW_minthick_dflt ! The default for PenSW_absorb_minthick [m] + logical :: default_2018_answers logical :: use_scheme - character(len=128) :: chl_file ! Data containing chl_a concentrations. Used - ! when var_pen_sw is defined and reading from file. - character(len=32) :: chl_varname ! Name of chl_a variable in chl_file. integer :: isd, ied, jsd, jed, nz, n isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -469,8 +939,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) else ; allocate(CS) ; endif CS%diag => diag - CS%Time => Time - CS%tracer_flow_CSp => tracer_flow ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, '') @@ -509,23 +977,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%opacity_scheme = MANIZZA_05 ; scheme_string = MANIZZA_05_STRING endif - call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & - "If true, chl_a is read from a file.", default=.true.) - if (CS%chl_from_file) then - call time_interp_external_init() - - call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") - call get_param(param_file, mdl, "CHL_FILE", chl_file, & - "CHL_FILE is the file containing chl_a concentrations in "//& - "the variable CHL_A. It is used when VAR_PEN_SW and "//& - "CHL_FROM_FILE are true.", fail_if_missing=.true.) - filename = trim(slasher(inputdir))//trim(chl_file) - call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", filename) - call get_param(param_file, mdl, "CHL_VARNAME", chl_varname, & - "Name of CHL_A variable in CHL_FILE.", default='CHL_A') - CS%sbc_chl = init_external_field(filename,trim(chl_varname),domain=G%Domain%mpp_domain) - endif - call get_param(param_file, mdl, "BLUE_FRAC_SW", CS%blue_frac, & "The fraction of the penetrating shortwave radiation "//& "that is in the blue band.", default=0.5, units="nondim") @@ -575,16 +1026,36 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) "The number of bands of penetrating shortwave radiation.", & default=1) if (CS%Opacity_scheme == DOUBLE_EXP ) then - if (optics%nbands /= 2) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a double_exp opacity scheme with nbands!=2.") - endif + if (optics%nbands /= 2) call MOM_error(FATAL, & + "set_opacity: \Cannot use a double_exp opacity scheme with nbands!=2.") elseif (CS%Opacity_scheme == SINGLE_EXP ) then - if (optics%nbands /= 1) then - call MOM_error(FATAL, "set_opacity: "// & - "Cannot use a single_exp opacity scheme with nbands!=1.") - endif + if (optics%nbands /= 1) call MOM_error(FATAL, & + "set_opacity: \Cannot use a single_exp opacity scheme with nbands!=1.") endif + + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", optics%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated expressions for "//& + "handling the absorption of small remaining shortwave fluxes.", & + default=default_2018_answers) + + call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, & + "A minimum remaining shortwave heating rate that will be simply absorbed in "//& + "the next sufficiently thick layers for computational efficiency, instead of "//& + "continuing to penetrate. The default, 2.5e-11 degC m s-1, is about 1e-4 W m-2 "//& + "or 0.08 degC m century-1, but 0 is also a valid value.", & + default=2.5e-11, units="degC m s-1", scale=GV%m_to_H*US%T_to_s) + + if (optics%answers_2018) then ; PenSW_minthick_dflt = 0.001 ; else ; PenSW_minthick_dflt = 1.0 ; endif + call get_param(param_file, mdl, "PEN_SW_ABSORB_MINTHICK", PenSW_absorb_minthick, & + "A thickness that is used to absorb the remaining penetrating shortwave heat "//& + "flux when it drops below PEN_SW_FLUX_ABSORB.", & + default=PenSW_minthick_dflt, units="m", scale=GV%m_to_H) + optics%PenSW_absorb_Invlen = 1.0 / (PenSW_absorb_minthick + GV%H_subroundoff) + if (.not.associated(optics%min_wavelength_band)) & allocate(optics%min_wavelength_band(optics%nbands)) if (.not.associated(optics%max_wavelength_band)) & @@ -626,10 +1097,6 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%id_opacity(n) = register_diag_field('ocean_model', shortname, diag%axesTL, Time, & longname, 'm-1') enddo - if (CS%var_pen_sw) & - CS%id_chl = register_diag_field('ocean_model', 'Chl_opac', diag%axesT1, Time, & - 'Surface chlorophyll A concentration used to find opacity', 'mg m-3') - end subroutine opacity_init @@ -650,18 +1117,18 @@ end subroutine opacity_end !> \namespace mom_opacity !! -!! CHL_from_file: -!! In this routine, the Morel (modified) and Manizza (modified) +!! opacity_from_chl: +!! In this routine, the Morel (modified) or Manizza (modified) !! schemes use the "blue" band in the paramterizations to determine !! the e-folding depth of the incoming shortwave attenuation. The red !! portion is lumped into the net heating at the surface. !! !! Morel, A., 1988: Optical modeling of the upper ocean in relation -!! to itsbiogenous matter content (case-i waters)., J. Geo. Res., +!! to its biogenous matter content (case-i waters)., J. Geo. Res., !! 93, 10,749-10,768. !! !! Manizza, M., C. LeQuere, A. J. Watson, and E. T. Buitenhuis, 2005: -!! Bio-optical feedbacks amoung phytoplankton, upper ocean physics +!! Bio-optical feedbacks among phytoplankton, upper ocean physics !! and sea-ice in a global model, Geophys. Res. Let., 32, L05603, !! doi:10.1029/2004GL020778. diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 82d3eaa547..c47f037789 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -81,9 +81,6 @@ module MOM_set_diffusivity !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without !! filtering or scaling [Z2 T-1 ~> m2 s-1]. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness [meter] when BULKMIXEDLAYER==.false. type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing logical :: limit_dissipation !< If enabled, dissipation is limited to be larger @@ -116,6 +113,9 @@ module MOM_set_diffusivity real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to !! obtain energy available for mixing below !! mixed layer base [nondim] + logical :: ML_rad_bug !< If true use code with a bug that reduces the energy available + !! in the transition layer by a factor of the inverse of the energy + !! deposition lenthscale (in m). logical :: ML_rad_TKE_decay !< If true, apply same exponential decay !! to ML_rad as applied to the other surface !! sources of TKE in the mixed layer code. @@ -146,6 +146,10 @@ module MOM_set_diffusivity real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] real :: Kv_molecular !< molecular visc for double diff convect [Z2 T-1 ~> m2 s-1] + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + character(len=200) :: inputdir !< The directory in which input files are found type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() !< Control structure for a child module type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() !< Control structure for a child module @@ -196,7 +200,7 @@ module MOM_set_diffusivity !! viscosity associated with processes 1,2 and 4 listed above, which is stored in !! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via !! visc%Kv_shear -subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & +subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt_in_T, & G, GV, US, CS, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -218,7 +222,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !! properties of the ocean. type(vertvisc_type), intent(inout) :: visc !< Structure containing vertical viscosities, bottom !! boundary layer properies, and related fields. - real, intent(in) :: dt !< Time increment [s]. + real, intent(in) :: dt_in_T !< Time increment [s]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. @@ -291,7 +295,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! If nothing else is specified, this will be the value used. Kd_lay(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = US%s_to_T * CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -349,22 +353,21 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & (GV%Z_to_H**2)*kappa_fill*dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_adj, S_adj, tv, fluxes%p_surf, visc%Kd_shear, & - visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) + visc%TKE_turb, visc%Kv_shear_Bu, dt_in_T, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z_to_m**2) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z_to_m**2) - call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z2_T_to_m2_s) + call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif else - ! Changes: visc%Kd_shear, visc%TKE_turb (not clear that TKE_turb is used as input ????) - ! Sets visc%Kv_shear + ! Changes: visc%Kd_shear ; Sets: visc%Kv_shear and visc%TKE_turb call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & - visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) + visc%Kv_shear, dt_in_T, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z_to_m**2) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z_to_m**2) - call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif endif call cpu_clock_end(id_clock_kappaShear) @@ -373,8 +376,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z_to_m**2) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z_to_m**2) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled @@ -408,12 +411,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KT_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KT_extra(i,K) - visc%Kd_extra_S(i,j,k) = US%s_to_T * (KS_extra(i,K) - KT_extra(i,K)) + visc%Kd_extra_S(i,j,k) = (KS_extra(i,K) - KT_extra(i,K)) visc%Kd_extra_T(i,j,k) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd_lay(i,j,k-1) = Kd_lay(i,j,k-1) + 0.5 * KS_extra(i,K) Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * KS_extra(i,K) - visc%Kd_extra_T(i,j,k) = US%s_to_T * (KT_extra(i,K) - KS_extra(i,K)) + visc%Kd_extra_T(i,j,k) = (KT_extra(i,K) - KS_extra(i,K)) visc%Kd_extra_S(i,j,k) = 0.0 else ! There is no double diffusion at this interface. visc%Kd_extra_T(i,j,k) = 0.0 @@ -441,15 +444,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear .or. CS%use_CVMix_shear) then if (present(Kd_int)) then do K=2,nz ; do i=is,ie - Kd_int(i,j,K) = (US%T_to_s * visc%Kd_shear(i,j,K)) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) + Kd_int(i,j,K) = visc%Kd_shear(i,j,K) + 0.5 * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k)) enddo ; enddo do i=is,ie - Kd_int(i,j,1) = US%T_to_s * visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. + Kd_int(i,j,1) = visc%Kd_shear(i,j,1) ! This isn't actually used. It could be 0. Kd_int(i,j,nz+1) = 0.0 enddo endif do k=1,nz ; do i=is,ie - Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * US%T_to_s * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + 0.5 * (visc%Kd_shear(i,j,K) + visc%Kd_shear(i,j,K+1)) enddo ; enddo else if (present(Kd_int)) then @@ -462,7 +465,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif endif - call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, (US%s_to_T)*dt, G, GV, US, CS, TKE_to_Kd, & + call find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt_in_T, G, GV, US, CS, TKE_to_Kd, & maxTKE, kb) if (associated(dd%maxTKE)) then ; do k=1,nz ; do i=is,ie dd%maxTKE(i,j,k) = maxTKE(i,k) @@ -526,16 +529,16 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call hchksum(Kd_lay ,"Kd_lay", G%HI, haloshift=0, & scale=US%Z2_T_to_m2_s) - if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z_to_m**2) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z_to_m**2) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z_to_m**2) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, & - G%HI, 0, symmetric=.true., scale=US%Z_to_m**2) + G%HI, 0, symmetric=.true., scale=US%Z2_T_to_m2_s) endif if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then @@ -544,7 +547,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T) endif endif @@ -670,8 +673,8 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & ! above or below [Z ~> m]. real :: dRho_lay ! density change across a layer [kg m-3] real :: Omega2 ! rotation rate squared [T-2 ~> s-2] - real :: G_Rho0 ! gravitation accel divided by Bouss ref density [m4 T-2 kg-1 -> m4 s-2 kg-1] - real :: G_IRho0 ! ### Alternate calculation of G_Rho0 for reproducibility + real :: G_Rho0 ! gravitation accel divided by Bouss ref density [Z m3 T-2 kg-1 -> m4 s-2 kg-1] + real :: G_IRho0 ! Alternate calculation of G_Rho0 for reproducibility [Z m3 T-2 kg-1 -> m4 s-2 kg-1] real :: I_Rho0 ! inverse of Boussinesq reference density [m3 kg-1] real :: I_dt ! 1/dt [T-1] real :: H_neglect ! negligibly small thickness [H ~> m or kg m-2] @@ -684,12 +687,13 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & I_dt = 1.0 / dt Omega2 = CS%omega**2 H_neglect = GV%H_subroundoff - ! ### G_Rho0 and G_IRho0 are mathematically identical but give different - ! numerical values. We compute both values for now, but they should be - ! consolidated at some point. - G_Rho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 - I_Rho0 = 1.0 / GV%Rho0 - G_IRho0 = (GV%g_Earth * US%m_to_Z**2 * US%T_to_s**2) * I_Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 + if (CS%answers_2018) then + I_Rho0 = 1.0 / GV%Rho0 + G_IRho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) * I_Rho0 + else + G_IRho0 = G_Rho0 + endif ! Simple but coordinate-independent estimate of Kd/TKE if (CS%simple_TKE_to_Kd) then @@ -732,11 +736,11 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & enddo enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) else ! not bulkmixedlayer kb_min = 2 ; kmb = 0 do i=is,ie ; kb(i) = 1 ; enddo - call set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1) + call set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1) endif ! Determine maxEnt - the maximum permitted entrainment from below by each @@ -878,7 +882,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = G%ke - G_Rho0 = (GV%g_Earth*US%m_to_Z**2 * US%T_to_s**2) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%LZT_g_Earth) / GV%Rho0 H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -1166,7 +1170,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) Rayleigh_drag = .true. I_Rho0 = 1.0/GV%Rho0 - R0_g = GV%Rho0 / (US%m_to_Z**2 * US%T_to_s**2 * GV%g_Earth) + R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%LZT_g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1176,9 +1180,9 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = US%T_to_s * visc%ustar_BBL(i,j) + ustar_h = visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & - ustar_h = ustar_h + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + ustar_h = ustar_h + fluxes%ustar_tidal(i,j) absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) if ((ustar_h > 0.0) .and. (absf > 0.5*CS%IMax_decay*ustar_h)) then @@ -1250,7 +1254,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! TKE_Ray has been initialized to 0 above. if (Rayleigh_drag) TKE_Ray = 0.5*CS%BBL_effic * G%IareaT(i,j) * & - US%m_to_Z**2 * US%T_to_s**3 * & + US%m_to_Z**2 * US%T_to_s**2 * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & (G%areaCv(i,J-1) * visc%Ray_v(i,J-1,k) * v(i,J-1,k)**2 + & @@ -1285,8 +1289,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & elseif (Kd_lay(i,j,k) + (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) > & maxTKE(i,k) * TKE_to_Kd(i,k)) then TKE_here = ((TKE_to_layer + TKE_Ray) + Kd_lay(i,j,k) / TKE_to_Kd(i,k)) - maxTKE(i,k) - ! ### Non-bracketed ternary sum - TKE(i) = TKE(i) - TKE_here + TKE_Ray + TKE(i) = (TKE(i) - TKE_here) + TKE_Ray else TKE_here = TKE_to_layer + TKE_Ray TKE(i) = TKE(i) - TKE_to_layer @@ -1393,12 +1396,13 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! - ! u* at the bottom [m s-1]. - ustar = US%T_to_s * visc%ustar_BBL(i,j) + ! u* at the bottom [Z T-1 ~> m s-1]. + ustar = visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA - if (associated(fluxes%ustar_tidal)) ustar = ustar + (US%m_to_Z * US%T_to_s * fluxes%ustar_tidal(i,j)) + !### Examine this question of whether there is double counting of fluxes%ustar_tidal. + if (associated(fluxes%ustar_tidal)) ustar = ustar + fluxes%ustar_tidal(i,j) ! The maximum decay scale should be something of order 200 m. We use the smaller of u*/f and ! (IMax_decay)^-1 as the decay scale. If ustar = 0, this is land so this value doesn't matter. @@ -1430,7 +1434,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, & ! Add in additional energy input from bottom-drag against slopes (sides) if (Rayleigh_drag) TKE_remaining = TKE_remaining + & - US%m_to_Z**2 * US%T_to_s**3 * & + US%m_to_Z**2 * US%T_to_s**2 * & 0.5*CS%BBL_effic * G%IareaT(i,j) * & ((G%areaCu(I-1,j) * visc%Ray_u(I-1,j,k) * u(I-1,j,k)**2 + & G%areaCu(I,j) * visc%Ray_u(I,j,k) * u(I,j,k)**2) + & @@ -1548,9 +1552,9 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, f_sq = CS%ML_omega_frac * 4.0 * Omega2 + (1.0 - CS%ML_omega_frac) * f_sq endif - ustar_sq = max(US%T_to_s * fluxes%ustar(i,j), CS%ustar_min)**2 + ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (US%T_to_s * fluxes%ustar(i,j))) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & @@ -1588,14 +1592,23 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, G, GV, US, CS, Kd_lay, TKE_to_Kd, do_any = .false. do i=is,ie ; if (do_i(i)) then dzL = GV%H_to_Z*h(i,j,k) ; z1 = dzL*I_decay(i) - if (z1 > 1e-5) then - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 ? + if (CS%ML_Rad_bug) then + !### These expresssions are dimensionally inconsistent. -RWH + ! This is supposed to be the integrated energy deposited in the layer, + ! not the average over the layer as in these expressions. + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 + endif else - !### I think that this might be dimensionally inconsistent, but untested. -RWH - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 ? - US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 ? + if (z1 > 1e-5) then + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (1.0 - exp(-z1)) + else + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * (z1 * (1.0 - z1 * (0.5 - C1_6*z1))) + endif endif Kd_mlr = min(Kd_mlr, CS%ML_rad_kd_max) Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_mlr @@ -1640,13 +1653,13 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) real, dimension(SZIB_(G)) :: & uhtot, & ! running integral of u in the BBL [Z m s-1 ~> m2 s-1] - ustar, & ! bottom boundary layer turbulence speed [Z s-1 ~> m s-1]. + ustar, & ! bottom boundary layer turbulence speed [Z T-1 ~> m s-1]. u2_bbl ! square of the mean zonal velocity in the BBL [m2 s-2] real :: vhtot(SZI_(G)) ! running integral of v in the BBL [Z m s-1 ~> m2 s-1] real, dimension(SZI_(G),SZJB_(G)) :: & - vstar, & ! ustar at at v-points [Z s-1 ~> m s-1]. + vstar, & ! ustar at at v-points [Z T-1 ~> m s-1]. v2_bbl ! square of average meridional velocity in BBL [m2 s-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] @@ -1681,7 +1694,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) ! vertical decay scale. do i=is,ie ; if ((G%mask2dCv(i,J) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. ; vhtot(i) = 0.0 ; htot(i) = 0.0 - vstar(i,J) = visc%kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) else do_i(i) = .false. ; vstar(i,J) = 0.0 ; htot(i) = 0.0 endif ; enddo @@ -1711,7 +1724,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) do j=js,je do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.5) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. ; uhtot(I) = 0.0 ; htot(I) = 0.0 - ustar(I) = visc%kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) else do_i(I) = .false. ; ustar(I) = 0.0 ; htot(I) = 0.0 endif ; enddo @@ -1742,7 +1755,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%T_to_s**3 * US%m_to_Z**2 * & + visc%TKE_BBL(i,j) = US%T_to_s**2 * US%m_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & @@ -1753,7 +1766,7 @@ subroutine set_BBL_TKE(u, v, h, fluxes, visc, G, GV, US, CS) end subroutine set_BBL_TKE -subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) +subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & @@ -1763,6 +1776,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! fields have NULL ptrs. integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(set_diffusivity_CS), pointer :: CS !< Control structure returned by previous !! call to diabatic_entrain_init. integer, intent(in) :: j !< Meridional index upon which to work. @@ -1775,7 +1789,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) !! surface press [kg m-3]. ! Local variables - real :: g_R0 ! g_R0 is g/Rho [m5 Z-1 kg-1 s-2 ~> m4 kg-1 s-2] + real :: g_R0 ! g_R0 is a rescaled version of g/Rho [m3 L2 Z-1 kg-1 T-2 ~> m4 kg-1 s-2] real :: eps, tmp ! nondimensional temproray variables real :: a(SZK_(G)), a_0(SZK_(G)) ! nondimensional temporary variables real :: p_ref(SZI_(G)) ! an array of tv%P_Ref pressures @@ -1798,7 +1812,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) enddo if (CS%bulkmixedlayer) then - g_R0 = GV%g_Earth/GV%Rho0 + g_R0 = GV%LZT_g_Earth / GV%Rho0 kmb = GV%nk_rho_varies eps = 0.1 do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo @@ -1812,7 +1826,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, CS, j, ds_dsp1, rho_0) ! interfaces above and below the buffer layer and the next denser layer. k = kb(i) - I_Drho = g_R0 / GV%g_prime(k+1) + I_Drho = (US%s_to_T**2*US%L_to_m**2*g_R0) / (GV%g_prime(k+1)) ! The indexing convention for a is appropriate for the interfaces. do k3=1,kmb a(k3+1) = (GV%Rlay(k) - Rcv(i,k3)) * I_Drho @@ -1875,13 +1889,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. - ! local variables + ! Local variables real :: decay_length logical :: ML_use_omega - -! This include declares and sets the variable "version". -#include "version_variable.h" - + logical :: default_2018_answers + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. real :: omega_frac_dflt integer :: i, j, is, ie, js, je @@ -1903,7 +1916,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! These default values always need to be set. CS%BBL_mixing_as_max = .true. - CS%Kdml = 0.0 ; CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 + CS%cdrag = 0.003 ; CS%BBL_effic = 0.0 CS%bulkmixedlayer = (GV%nkml > 0) ! Read all relevant parameters and write them to the model log. @@ -1920,6 +1933,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, scale=US%T_to_s) + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=default_2018_answers) + call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind "//& "work to penetrate below the base of the mixed layer "//& @@ -1935,6 +1956,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "depth for turbulence below the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) + call get_param(param_file, mdl, "ML_RAD_BUG", CS%ML_rad_bug, & + "If true use code with a bug that reduces the energy available "//& + "in the transition layer by a factor of the inverse of the energy "//& + "deposition lenthscale (in m).", default=.true.) call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence "//& "radiated from the base of the mixed layer. "//& @@ -1989,13 +2014,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "bottom drag drives BBL diffusion. This is only "//& "used if BOTTOMDRAGLAW is true.", units="nondim", default=0.20) call get_param(param_file, mdl, "BBL_MIXING_MAX_DECAY", decay_length, & - "The maximum decay scale for the BBL diffusion, or 0 "//& - "to allow the mixing to penetrate as far as "//& - "stratification and rotation permit. The default is 0. "//& - "This is only used if BOTTOMDRAGLAW is true.", & - units="m", default=0.0, scale=US%m_to_Z) + "The maximum decay scale for the BBL diffusion, or 0 to allow the mixing "//& + "to penetrate as far as stratification and rotation permit. The default "//& + "for now is 200 m. This is only used if BOTTOMDRAGLAW is true.", & + units="m", default=200.0, scale=US%m_to_Z) - CS%IMax_decay = 1.0 / (200.0*US%m_to_Z) !### This is inconsistent with the description above. + CS%IMax_decay = 0.0 if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the "//& @@ -2057,27 +2081,6 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") - if (CS%bulkmixedlayer) then - ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) - if (CS%Kdml>0.) call MOM_error(FATAL, & - "set_diffusivity_init: KDML cannot be set when using"// & - "bulk mixed layer.") - CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also - ! cannot be a NaN. - else - ! ### This parameter is unused and is staged for deletion - call get_param(param_file, mdl, "KDML", CS%Kdml, & - "If BULKMIXEDLAYER is false, KDML is the elevated "//& - "diapycnal diffusivity in the topmost HMIX of fluid. "//& - "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, & - scale=US%m2_s_to_Z2_T) - call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & - "The prescribed depth over which the near-surface "//& - "viscosity and diffusivity are elevated when the bulk "//& - "mixed layer is not used.", units="m", fail_if_missing=.true.) - endif call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 1265067ef2..912ae64d44 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -54,8 +54,8 @@ module MOM_set_visc real :: Htbl_shelf !< A nominal thickness of the surface boundary layer for use !! in calculating the near-surface velocity [H ~> m or kg m-2]. real :: Htbl_shelf_min !< The minimum surface boundary layer thickness [H ~> m or kg m-2]. - real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 s-1 ~> m2 s-1]. - real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 s-1 ~> m2 s-1]. + real :: KV_BBL_min !< The minimum viscosity in the bottom boundary layer [Z2 T-1 ~> m2 s-1]. + real :: KV_TBL_min !< The minimum viscosity in the top boundary layer [Z2 T-1 ~> m2 s-1]. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a !! drag law c_drag*|u|*u. The velocity magnitude !! may be an assumed value or it may be based on the @@ -72,15 +72,18 @@ module MOM_set_visc !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the !! thickness of the viscous mixed layer. Nondim. - real :: omega !< The Earth's rotation rate [s-1]. + real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical - !! problems [Z s-1 ~> m s-1]. If the value is small enough, + !! problems [Z T-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE !! decay scale, nondimensional. real :: omega_frac !< When setting the decay scale for turbulence, use !! this fraction of the absolute rotation rate blended !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. logical :: debug !< If true, write verbose checksums for debugging purposes. type(ocean_OBC_type), pointer :: OBC => NULL() !< Open boundaries control structure type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -126,7 +129,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! Local variables real, dimension(SZIB_(G)) :: & - ustar, & ! The bottom friction velocity [Z s-1 ~> m s-1]. + ustar, & ! The bottom friction velocity [Z T-1 ~> m s-1]. T_EOS, & ! The temperature used to calculate the partial derivatives ! of density with T and S [degC]. S_EOS, & ! The salinity used to calculate the partial derivatives @@ -179,7 +182,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! the present layer [H ~> m or kg m-2]. real :: bbl_thick ! The thickness of the bottom boundary layer [H ~> m or kg m-2]. real :: bbl_thick_Z ! The thickness of the bottom boundary layer [Z ~> m]. - real :: C2f ! C2f = 2*f at velocity points. + real :: C2f ! C2f = 2*f at velocity points [T-1 ~> s-1]. real :: U_bg_sq ! The square of an assumed background ! velocity, for calculating the mean @@ -195,7 +198,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! of the bottom [H ~> m or kg m-2]. real :: v_at_u, u_at_v ! v at a u point or vice versa [m s-1]. real :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. real, dimension(SZI_(G),SZJ_(G),max(GV%nk_rho_varies,1)) :: & Rml ! The mixed layer coordinate density [kg m-3]. @@ -240,8 +243,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! evaluated at L=L0 [H ~> m or kg m-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 :: ustH ! ustar converted to units of H s-1 [H s-1 ~> m s-1 or kg m-2 s-1]. - real :: root ! A temporary variable [H s-1 ~> m s-1 or kg m-2 s-1]. + real :: ustH ! ustar converted to units of H T-1 [H T-1 ~> m s-1 or kg m-2 s-1]. + real :: root ! A temporary variable [H T-1 ~> m s-1 or kg m-2 s-1]. real :: Cell_width ! The transverse width of the velocity cell [m]. real :: Rayleigh ! A nondimensional value that is multiplied by the layer's @@ -266,7 +269,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies ; nkml = GV%nkml h_neglect = GV%H_subroundoff - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0 / (US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H Vol_quit = 0.9*GV%Angstrom_H + h_neglect C2pi_3 = 8.0*atan(1.0)/3.0 @@ -518,9 +521,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) enddo ! end of k loop if (.not.CS%linear_drag .and. (hwtot > 0.0)) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif if (use_BBL_EOS) then ; if (hwtot > 0.0) then @@ -530,7 +533,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif ; endif endif ; enddo else - do i=is,ie ; ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel ; enddo + do i=is,ie ; ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel ; enddo endif ! Not linear_drag if (use_BBL_EOS) then @@ -626,8 +629,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! The bottom boundary layer thickness is found by solving the same ! equation as in Killworth and Edwards: (h/h_f)^2 + h/h_N = 1. - if (m==1) then ; C2f = US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) - else ; C2f = US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) ; endif + if (m==1) then ; C2f = G%CoriolisBu(I,J-1) + G%CoriolisBu(I,J) + else ; C2f = G%CoriolisBu(I-1,J) + G%CoriolisBu(I,J) ; endif if (CS%cdrag * U_bg_sq <= 0.0) then ! This avoids NaNs and overflows, and could be used in all cases, @@ -640,7 +643,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) endif else bbl_thick = htot / (0.5 + sqrt(0.25 + htot*htot*C2f*C2f/ & - ((ustar(i)*ustar(i)) * (GV%Z_to_H**2) ))) + ((ustar(i)*ustar(i)) * (GV%Z_to_H**2)) ) ) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif @@ -770,18 +773,19 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = (vol-Vol_0) ! dV_dL2 = 0.5*(slope+a) - a*L0 ; dVol = max(vol-Vol_0, 0.0) - !### The following code is more robust when GV%Angstrom_H=0, but it - !### changes answers. - ! Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - ! Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) - - ! if (dVol <= 0.0) then - ! L(K) = L0 - ! Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol - ! elseif (a*a*dVol**3 < Vol_tol*dV_dL2**2 * & - ! (dV_dL2*Vol_tol - 2.0*a*L0*dVol)) then - if (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & - (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol)) then + ! The following code is more robust when GV%Angstrom_H=0, but it changes answers. + if (.not.CS%answers_2018) then + Vol_tol = max(0.5*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + Vol_quit = max(0.9*GV%Angstrom_H + GV%H_subroundoff, 1e-14*vol) + endif + + if ((.not.CS%answers_2018) .and. (dVol <= 0.0)) then + L(K) = L0 + Vol_err = 0.5*(L(K)*L(K))*(slope + a_3*(3.0-4.0*L(K))) - vol + elseif ( ((.not.CS%answers_2018) .and. & + (a*a*dVol**3 < Vol_tol*dV_dL2**2 *(dV_dL2*Vol_tol - 2.0*a*L0*dVol))) .or. & + (CS%answers_2018 .and. (a*a*dVol**3 < GV%Angstrom_H*dV_dL2**2 * & + (0.25*dV_dL2*GV%Angstrom_H - a*L0*dVol) )) ) then ! One iteration of Newton's method should give an estimate ! that is accurate to within Vol_tol. L(K) = sqrt(L0*L0 + dVol / dV_dL2) @@ -840,13 +844,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh*sqrt(u(I,j,k)*u(I,j,k) + & + visc%Ray_u(I,j,k) = Rayleigh*US%T_to_s*sqrt(u(I,j,k)*u(I,j,k) + & v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh*sqrt(v(i,J,k)*v(i,J,k) + & + visc%Ray_v(i,J,k) = Rayleigh*US%T_to_s*sqrt(v(i,J,k)*v(i,J,k) + & u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -855,11 +859,11 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, & + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, & + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, & cdrag_sqrt*ustar(i)*bbl_thick_Z*BBL_visc_frac) visc%bbl_thick_v(i,J) = bbl_thick_Z endif @@ -869,10 +873,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) ! the correct stress when the shear occurs over bbl_thick. bbl_thick_Z = bbl_thick * GV%H_to_Z if (m==1) then - visc%kv_bbl_u(I,j) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_u(I,j) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_u(I,j) = bbl_thick_Z else - visc%kv_bbl_v(i,J) = max(CS%KV_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) + visc%Kv_bbl_v(i,J) = max(CS%Kv_BBL_min, cdrag_sqrt*ustar(i)*bbl_thick_Z) visc%bbl_thick_v(i,J) = bbl_thick_Z endif endif @@ -897,7 +901,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, symmetrize) if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m) if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z_to_m**2) + call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, & visc%bbl_thick_v, G%HI, haloshift=0, scale=US%Z_to_m) @@ -1036,7 +1040,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! (roughly the base of the mixed layer) with temperature [kg m-3 degC-1]. dR_dS, & ! Partial derivative of the density at the base of layer nkml ! (roughly the base of the mixed layer) with salinity [kg m-3 ppt-1]. - ustar, & ! The surface friction velocity under ice shelves [Z s-1 ~> m s-1]. + ustar, & ! The surface friction velocity under ice shelves [Z T-1 ~> m s-1]. press, & ! The pressure at which dR_dT and dR_dS are evaluated [Pa]. T_EOS, & ! The potential temperature at which dR_dT and dR_dS are evaluated [degC] S_EOS ! The salinity at which dR_dT and dR_dS are evaluated [ppt]. @@ -1101,15 +1105,15 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri ! the quadratic surface drag [m2 s-2]. real :: h_tiny ! A very small thickness [H ~> m or kg m-2]. Layers that are less than ! h_tiny can not be the deepest in the viscous mixed layer. - real :: absf ! The absolute value of f averaged to velocity points, s-1. - real :: U_star ! The friction velocity at velocity points [Z s-1 ~> m s-1]. + real :: absf ! The absolute value of f averaged to velocity points [T-1 ~> s-1]. + real :: U_star ! The friction velocity at velocity points [Z T-1 ~> m s-1]. 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 :: Rho0x400_G ! 400*Rho0/G_Earth, times unit conversion factors - ! [kg s2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. + ! [kg T2 H m-3 Z-2 ~> kg s2 m-4 or kg2 s2 m-7]. ! The 400 is a constant proposed by Killworth and Edwards, 1999. - real :: ustar1 ! ustar [H s-1 ~> m s-1 or kg m-2 s-1] - real :: h2f2 ! (h*2*f)^2 [H2 s-2 ~> m2 s-2 or kg2 m-4 s-2] + real :: ustar1 ! ustar [H T-1 ~> m s-1 or kg m-2 s-1] + real :: h2f2 ! (h*2*f)^2 [H2 T-2 ~> m2 s-2 or kg2 m-4 s-2] logical :: use_EOS, do_any, do_any_shelf, do_i(SZIB_(G)) integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, K2, nkmb, nkml, n type(ocean_OBC_type), pointer :: OBC => NULL() @@ -1127,7 +1131,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri Jsq = js-1 ; Isq = is-1 endif ; endif - Rho0x400_G = 400.0*(GV%Rho0/GV%g_Earth) * US%Z_to_m**2 * GV%Z_to_H + Rho0x400_G = 400.0*(GV%Rho0/(US%L_to_Z**2 * GV%LZT_g_Earth)) * GV%Z_to_H U_bg_sq = CS%drag_bg_vel * CS%drag_bg_vel cdrag_sqrt = sqrt(CS%cdrag) cdrag_sqrt_Z = US%m_to_Z * sqrt(CS%cdrag) @@ -1137,7 +1141,8 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri dt_Rho0 = dt/GV%H_to_kg_m2 h_neglect = GV%H_subroundoff h_tiny = 2.0*GV%Angstrom_H + h_neglect - g_H_Rho0 = (GV%g_Earth*GV%H_to_Z) / GV%Rho0 + ! g_H_Rho0 can be rescaled after all test cases are using non-zero VEL_UNDERFLOW. + g_H_Rho0 = (US%s_to_T**2*US%L_to_m**2*GV%LZT_g_Earth*GV%H_to_Z) / GV%Rho0 if (associated(forces%frac_shelf_u) .neqv. associated(forces%frac_shelf_v)) & call MOM_error(FATAL, "set_viscous_ML: one of forces%frac_shelf_u and "//& @@ -1203,7 +1208,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%tauy(i,J-1) + forces%tauy(i+1,J))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) + absf = 0.5*(abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I,J-1))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1332,9 +1337,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if ((.not.CS%linear_drag) .and. (hwtot > 0.0)) then - ustar(I) = cdrag_sqrt_Z*hutot/hwtot + ustar(I) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(I) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(I) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1406,14 +1411,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_u(I,j) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(I) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*(G%CoriolisBu(I,J-1)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z - visc%kv_tbl_shelf_u(I,j) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1438,7 +1443,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri (forces%taux(I-1,j) + forces%taux(I,j+1))) if (CS%omega_frac >= 1.0) then ; absf = 2.0*CS%omega ; else - absf = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%omega_frac > 0.0) & absf = sqrt(CS%omega_frac*4.0*CS%omega**2 + (1.0-CS%omega_frac)*absf**2) endif @@ -1569,9 +1574,9 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri enddo ; endif if (.not.CS%linear_drag) then ; if (hwtot > 0.0) then - ustar(i) = cdrag_sqrt_Z*hutot/hwtot + ustar(i) = cdrag_sqrt_Z*US%T_to_s*hutot/hwtot else - ustar(i) = cdrag_sqrt_Z*CS%drag_bg_vel + ustar(i) = cdrag_sqrt_Z*US%T_to_s*CS%drag_bg_vel endif ; endif if (use_EOS) then ; if (hwtot > 0.0) then @@ -1643,14 +1648,14 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS, symmetri !visc%tbl_thick_shelf_v(i,J) = GV%H_to_Z * max(CS%Htbl_shelf_min, & ! htot(i) / (0.5 + sqrt(0.25 + & - ! (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & + ! (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))**2 / & ! (ustar(i)*GV%Z_to_H)**2 )) ) ustar1 = ustar(i)*GV%Z_to_H - h2f2 = (htot(i)*US%s_to_T*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%Omega)**2 + h2f2 = (htot(i)*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)) + h_neglect*CS%omega)**2 tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z - visc%kv_tbl_shelf_v(i,J) = max(CS%KV_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -1722,17 +1727,12 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) endif if (use_kappa_shear .and. KS_at_vertex) then call safe_alloc_ptr(visc%TKE_turb, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) - call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", & - hor_grid="Bu", z_grid='i') call safe_alloc_ptr(visc%Kv_shear_Bu, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) call register_restart_field(visc%Kv_shear_Bu, "Kv_shear_Bu", .false., restart_CS, & "Shear-driven turbulent viscosity at vertex interfaces", "m2 s-1", & hor_grid="Bu", z_grid='i') elseif (use_kappa_shear) then call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1) - call register_restart_field(visc%TKE_turb, "TKE_turb", .false., restart_CS, & - "Turbulent kinetic energy per unit mass at interfaces", "m2 s-2", z_grid='i') endif ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM @@ -1777,19 +1777,25 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS !! structure for this module type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. type(ocean_OBC_type), pointer :: OBC !< A pointer to an open boundary condition structure + ! Local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt - real :: Z_rescale ! A rescaling factor for heights from the representation in - ! a reastart fole to the internal representation in this run. + real :: Z_rescale ! A rescaling factor for heights from the representation in + ! a restart file to the internal representation in this run. + real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run + ! to the representation in a restart file. + real :: Z2_T_rescale ! A rescaling factor for vertical diffusivities and viscosities from the + ! representation in a restart file to the internal representation in this run. integer :: i, j, k, is, ie, js, je, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz + logical :: default_2018_answers logical :: use_kappa_shear, adiabatic, use_omega logical :: use_CVMix_ddiff, differential_diffusion, use_KPP type(OBC_segment_type), pointer :: segment => NULL() ! pointer to OBC segment type -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" character(len=40) :: mdl = "MOM_set_visc" ! This module's name. if (associated(CS)) then @@ -1811,6 +1817,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. differential_diffusion = .false. + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=default_2018_answers) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& @@ -1884,13 +1897,13 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS units="nondim", default=omega_frac_dflt) call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_Z + GV%H_to_Z*GV%H_subroundoff) else call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & - default=7.2921e-5) + default=7.2921e-5, scale=US%T_to_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & @@ -1959,10 +1972,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & - units="m2 s-1", default=Kv_background, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_background, scale=US%m2_s_to_Z2_T) if (CS%Channel_drag) then call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) @@ -1981,8 +1994,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then - ! These are necessary for reproduciblity across restarts in non-symmetric mode. - call pass_var(visc%TKE_turb, G%Domain, position=CORNER, complete=.false.) + ! This is necessary for reproduciblity across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) endif @@ -1997,19 +2009,19 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z_to_m**2) + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z_to_m**2) + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif if (CS%Channel_drag) then allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u = 0.0 allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v = 0.0 CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m) + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m) + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) endif if (use_CVMix_ddiff .or. differential_diffusion) then @@ -2029,29 +2041,38 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS call register_restart_field_as_obsolete('Kd_turb','Kd_shear', restart_CS) call register_restart_field_as_obsolete('Kv_turb','Kv_shear', restart_CS) - if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) then + ! Account for possible changes in dimensional scaling for variables that have been + ! read from a restart file. + Z_rescale = 1.0 + if ((US%m_to_Z_restart /= 0.0) .and. (US%m_to_Z_restart /= US%m_to_Z)) & Z_rescale = US%m_to_Z / US%m_to_Z_restart + I_T_rescale = 1.0 + if ((US%s_to_T_restart /= 0.0) .and. (US%s_to_T_restart /= US%s_to_T)) & + I_T_rescale = US%s_to_T_restart / US%s_to_T + Z2_T_rescale = Z_rescale**2*I_T_rescale + + if (Z2_T_rescale /= 1.0) then if (associated(visc%Kd_shear)) then ; if (query_initialized(visc%Kd_shear, "Kd_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kd_shear(i,j,k) = Z_rescale**2 * visc%Kd_shear(i,j,k) + visc%Kd_shear(i,j,k) = Z2_T_rescale * visc%Kd_shear(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_shear)) then ; if (query_initialized(visc%Kv_shear, "Kv_shear", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear(i,j,k) = Z_rescale**2 * visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j,k) = Z2_T_rescale * visc%Kv_shear(i,j,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_shear_Bu)) then ; if (query_initialized(visc%Kv_shear_Bu, "Kv_shear_Bu", restart_CS)) then - do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_shear_Bu(i,j,k) = Z_rescale**2 * visc%Kv_shear_Bu(i,j,k) + do k=1,nz+1 ; do J=js-1,je ; do I=is-1,ie + visc%Kv_shear_Bu(I,J,k) = Z2_T_rescale * visc%Kv_shear_Bu(I,J,k) enddo ; enddo ; enddo endif ; endif if (associated(visc%Kv_slow)) then ; if (query_initialized(visc%Kv_slow, "Kv_slow", restart_CS)) then do k=1,nz+1 ; do j=js,je ; do i=is,ie - visc%Kv_slow(i,j,k) = Z_rescale**2 * visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j,k) = Z2_T_rescale * visc%Kv_slow(i,j,k) enddo ; enddo ; enddo endif ; endif endif diff --git a/src/parameterizations/vertical/MOM_shortwave_abs.F90 b/src/parameterizations/vertical/MOM_shortwave_abs.F90 deleted file mode 100644 index cf0da1c5f3..0000000000 --- a/src/parameterizations/vertical/MOM_shortwave_abs.F90 +++ /dev/null @@ -1,419 +0,0 @@ -!> Absorption of downwelling shortwave radiation -module MOM_shortwave_abs - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type - -implicit none ; private - -#include - -public absorbRemainingSW, sumSWoverBands - -!> This type is used to exchange information about ocean optical properties -type, public :: optics_type - ! ocean optical properties - - integer :: nbands !< number of penetrating bands of SW radiation - - real, pointer, dimension(:,:,:,:) :: opacity_band => NULL() !< SW optical depth per unit thickness [m-1] - !! The number of radiation bands is most rapidly varying (first) index. - - real, pointer, dimension(:,:,:) :: SW_pen_band => NULL() !< shortwave radiation [W m-2] at the surface - !! in each of the nbands bands that penetrates beyond the surface. - !! The most rapidly varying dimension is the band. - - real, pointer, dimension(:) :: & - min_wavelength_band => NULL(), & !< The minimum wavelength in each band of penetrating shortwave radiation [nm] - max_wavelength_band => NULL() !< The maximum wavelength in each band of penetrating shortwave radiation [nm] - -end type optics_type - -contains - -!> Apply shortwave heating below the boundary layer (when running with the bulk mixed layer inhereted -!! from GOLD) or throughout the water column. -!! -!! In addition, it causes all of the remaining SW radiation to be absorbed, provided that the total -!! water column thickness is greater than H_limit_fluxes. -!! For thinner water columns, the heating is scaled down proportionately, the assumption being that the -!! remaining heating (which is left in Pen_SW) should go into an (absent for now) ocean bottom sediment layer. -subroutine absorbRemainingSW(G, GV, h, opacity_band, nsw, j, dt, H_limit_fluxes, & - adjustAbsorptionProfile, absorbAllSW, T, Pen_SW_bnd, & - eps, ksort, htot, Ttot, TKE, dSV_dT) - - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< Opacity in each band of penetrating - !! shortwave radiation [H-1 ~> m-1 or m2 kg-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< Number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. - real, intent(in) :: H_limit_fluxes !< If the total ocean depth is - !! less than this, they are scaled away - !! to avoid numerical instabilities - !! [H ~> m or kg m-2]. This would - !! not be necessary if a finite heat - !! capacity mud-layer were added. - logical, intent(in) :: adjustAbsorptionProfile !< If true, apply - !! heating above the layers in which it - !! should have occurred to get the - !! correct mean depth (and potential - !! energy change) of the shortwave that - !! should be absorbed by each layer. - logical, intent(in) :: absorbAllSW !< If true, apply heating above the - !! layers in which it should have occurred - !! to get the correct mean depth (and - !! potential energy change) of the - !! shortwave that should be absorbed by - !! each layer. - real, dimension(SZI_(G),SZK_(G)), intent(inout) :: T !< Layer potential/conservative - !! temperatures [degC] - real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< Penetrating shortwave heating in - !! each band that hits the bottom and will - !! will be redistributed through the water - !! column [degC H ~> degC m or degC kg m-2], - !! size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: eps !< Small thickness that must remain in - !! each layer, and which will not be - !! subject to heating [H ~> m or kg m-2] - integer, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: ksort !< Density-sorted k-indicies. - real, dimension(SZI_(G)), optional, intent(in) :: htot !< Total mixed layer thickness [H ~> m or kg m-2]. - real, dimension(SZI_(G)), optional, intent(inout) :: Ttot !< Depth integrated mixed layer - !! temperature [degC H ~> degC m or degC kg m-2] - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: dSV_dT !< The partial derivative of specific - !! volume with temperature [m3 kg-1 degC-1]. - real, dimension(SZI_(G),SZK_(G)), optional, intent(inout) :: TKE !< The TKE sink from mixing the heating - !! throughout a layer [J m-2]. - ! Local variables - real, dimension(SZI_(G),SZK_(G)) :: & - T_chg_above ! A temperature change that will be applied to all the thick - ! layers above a given layer [degC]. This is only nonzero if - ! adjustAbsorptionProfile is true, in which case the net - ! change in the temperature of a layer is the sum of the - ! direct heating of that layer plus T_chg_above from all of - ! the layers below, plus any contribution from absorbing - ! radiation that hits the bottom. - real, dimension(SZI_(G)) :: & - h_heat, & ! The thickness of the water column that will be heated by - ! any remaining shortwave radiation [H ~> m or kg m-2]. - T_chg, & ! The temperature change of thick layers due to the remaining - ! shortwave radiation and contributions from T_chg_above [degC]. - Pen_SW_rem ! The sum across all wavelength bands of the penetrating shortwave - ! heating that hits the bottom and will be redistributed through - ! the water column [degC H ~> degC m or degC kg m-2] - real :: SW_trans ! fraction of shortwave radiation that is not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation that - ! is not absorbed because the layers are too thin - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - real :: heat_bnd ! heating due to absorption in the current - ! layer by the current band, including any piece that - ! is moved upward [degC H ~> degC m or degC kg m-2] - real :: SWa ! fraction of the absorbed shortwave that is - ! moved to layers above with adjustAbsorptionProfile [nondim] - real :: coSWa_frac ! The fraction of SWa that is actually moved upward. - real :: min_SW_heating ! A minimum remaining shortwave heating rate that will be simply - ! absorbed in the next layer for computational efficiency, instead of - ! continuing to penetrate [degC H s-1 ~> degC m s-1 or degC kg m-2 s-1]. - ! The default, 2.5e-11, is about 0.08 degC m / century. - real :: epsilon ! A small thickness that must remain in each - ! layer, and which will not be subject to heating [H ~> m or kg m-2] - real :: I_G_Earth - real :: g_Hconv2 - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - logical :: TKE_calc ! If true, calculate the implications to the - ! TKE budget of the shortwave heating. - real :: C1_6, C1_60 - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - min_SW_heating = 2.5e-11 - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - C1_6 = 1.0 / 6.0 ; C1_60 = 1.0 / 60.0 - - TKE_calc = (present(TKE) .and. present(dSV_dT)) - g_Hconv2 = GV%H_to_Pa * GV%H_to_kg_m2 - - h_heat(:) = 0.0 - if (present(htot)) then ; do i=is,ie ; h_heat(i) = htot(i) ; enddo ; endif - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do ks=1,nz ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - epsilon = 0.0 ; if (present(eps)) epsilon = eps(i,k) - - T_chg_above(i,k) = 0.0 - - if (h(i,k) > 1.5*epsilon) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k) * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - ! ###Make these numbers into parameters! - if (nsw*Pen_SW_bnd(n,i)*SW_trans < & - dt*min_SW_heating*min(GV%m_to_H,1e3*h(i,k)) ) SW_trans = 0.0 - - Heat_bnd = Pen_SW_bnd(n,i) * (1.0 - SW_trans) - if (adjustAbsorptionProfile .and. (h_heat(i) > 0.0)) then - ! In this case, a fraction of the heating is applied to the - ! overlying water so that the mean pressure at which the shortwave - ! heating occurs is exactly what it would have been with a careful - ! pressure-weighted averaging of the exponential heating profile, - ! hence there should be no TKE budget requirements due to this - ! layer. Very clever, but this is also limited so that the - ! water above is not heated at a faster rate than the layer - ! actually being heated, i.e., SWA <= h_heat / (h_heat + h(i,k)) - ! and takes the energetics of the rest of the heating into account. - ! (-RWH, ~7 years later.) - if (opt_depth > 1e-5) then - SWa = ((opt_depth + (opt_depth + 2.0)*exp_OD) - 2.0) / & - ((opt_depth + opacity_band(n,i,k) * h_heat(i)) * & - (1.0 - exp_OD)) - else - ! Use Taylor series expansion of the expression above for a - ! more accurate form with very small layer optical depths. - SWa = h(i,k) * (opt_depth * (1.0 - opt_depth)) / & - ((h_heat(i) + h(i,k)) * (6.0 - 3.0*opt_depth)) - endif - coSWa_frac = 0.0 - if (SWa*(h_heat(i) + h(i,k)) > h_heat(i)) then - coSWa_frac = (SWa*(h_heat(i) + h(i,k)) - h_heat(i) ) / & - (SWa*(h_heat(i) + h(i,k))) - SWa = h_heat(i) / (h_heat(i) + h(i,k)) - endif - - T_chg_above(i,k) = T_chg_above(i,k) + (SWa * Heat_bnd) / h_heat(i) - T(i,k) = T(i,k) + ((1.0 - SWa) * Heat_bnd) / h(i,k) - else - coSWa_frac = 1.0 - T(i,k) = T(i,k) + Pen_SW_bnd(n,i) * (1.0 - SW_trans) / h(i,k) - endif - - if (TKE_calc) then - if (opt_depth > 1e-2) then - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (opt_depth*(1.0+exp_OD) - 2.0*(1.0-exp_OD)) / (opt_depth*(1.0-exp_OD)) - else - ! Use Taylor series-derived approximation to the above expression - ! that is well behaved and more accurate when opt_depth is small. - TKE(i,k) = TKE(i,k) - coSWa_frac*Heat_bnd*dSV_dT(i,k)* & - (0.5*h(i,k)*g_Hconv2) * & - (C1_6*opt_depth * (1.0 - C1_60*opt_depth**2)) - endif - endif - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - endif ; enddo - endif - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ; enddo ! i & k loops - - -! if (.not.absorbAllSW .and. .not.adjustAbsorptionProfile) return - - ! Unless modified, there is no temperature change due to fluxes from the bottom. - do i=is,ie ; T_chg(i) = 0.0 ; enddo - - if (absorbAllSW) then - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit >= 1.0) then - T_chg(i) = Pen_SW_rem(i) / h_heat(i) ; unabsorbed = 0.0 - else - T_chg(i) = Pen_SW_rem(i) * Ih_limit - unabsorbed = 1.0 - h_heat(i)*Ih_limit - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - endif ! absorbAllSW - - if (absorbAllSW .or. adjustAbsorptionProfile) then - do ks=nz,1,-1 ; do i=is,ie - k = ks - if (present(ksort)) then - if (ksort(i,ks) <= 0) cycle - k = ksort(i,ks) - endif - - if (T_chg(i) > 0.0) then - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then ; T(i,k) = T(i,k) + T_chg(i) - elseif (h(i,k) > h_min_heat) then - T(i,k) = T(i,k) + T_chg(i) * (2.0 - 2.0*h_min_heat/h(i,k)) - endif - endif - ! Increase the heating for layers above. - T_chg(i) = T_chg(i) + T_chg_above(i,k) - enddo ; enddo - if (present(htot) .and. present(Ttot)) then - do i=is,ie ; Ttot(i) = Ttot(i) + T_chg(i) * htot(i) ; enddo - endif - endif ! absorbAllSW .or. adjustAbsorptionProfile - -end subroutine absorbRemainingSW - - -subroutine sumSWoverBands(G, GV, h, opacity_band, nsw, j, dt, & - H_limit_fluxes, absorbAllSW, iPen_SW_bnd, netPen) -!< This subroutine calculates the total shortwave heat flux integrated over -!! bands as a function of depth. This routine is only called for computing -!! buoyancy fluxes for use in KPP. This routine does not updat e the state. - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(:,:,:), intent(in) :: opacity_band !< opacity in each band of - !! penetrating shortwave radiation [m-1]. - !! The indicies are band, i, k. - integer, intent(in) :: nsw !< number of bands of penetrating - !! shortwave radiation. - integer, intent(in) :: j !< j-index to work on. - real, intent(in) :: dt !< Time step [s]. - real, intent(in) :: H_limit_fluxes !< the total depth at which the - !! surface fluxes start to be limited to avoid - !! excessive heating of a thin ocean [H ~> m or kg m-2] - logical, intent(in) :: absorbAllSW !< If true, ensure that all shortwave - !! radiation is absorbed in the ocean water column. - real, dimension(:,:), intent(in) :: iPen_SW_bnd !< The incident penetrating shortwave - !! heating in each band that hits the bottom and - !! will be redistributed through the water column - !! [degC H ~> degC m or degC kg m-2]; size nsw x SZI_(G). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(inout) :: netPen !< Net penetrating shortwave heat flux at each - !! interface, summed across all bands - !! [degC H ~> degC m or degC kg m-2]. - ! Local variables - real :: h_heat(SZI_(G)) ! thickness of the water column that receives - ! remaining shortwave radiation [H ~> m or kg m-2]. - real :: Pen_SW_rem(SZI_(G)) ! sum across all wavelength bands of the - ! penetrating shortwave heating that hits the bottom - ! and will be redistributed through the water column - ! [degC H ~> degC m or degC kg m-2] - - real, dimension(size(iPen_SW_bnd,1),size(iPen_SW_bnd,2)) :: Pen_SW_bnd - real :: SW_trans ! fraction of shortwave radiation not - ! absorbed in a layer [nondim] - real :: unabsorbed ! fraction of the shortwave radiation - ! not absorbed because the layers are too thin. - real :: Ih_limit ! inverse of the total depth at which the - ! surface fluxes start to be limited [H-1 ~> m-1 or m2 kg-1] - real :: h_min_heat ! minimum thickness layer that should get heated [H ~> m or kg m-2] - real :: opt_depth ! optical depth of a layer [nondim] - real :: exp_OD ! exp(-opt_depth) [nondim] - logical :: SW_Remains ! If true, some column has shortwave radiation that - ! was not entirely absorbed. - - integer :: is, ie, nz, i, k, ks, n - SW_Remains = .false. - - h_min_heat = 2.0*GV%Angstrom_H + GV%H_subroundoff - is = G%isc ; ie = G%iec ; nz = G%ke - - pen_SW_bnd(:,:) = iPen_SW_bnd(:,:) - do i=is,ie ; h_heat(i) = 0.0 ; enddo - netPen(:,1) = sum( pen_SW_bnd(:,:), dim=1 ) ! Surface interface - - ! Apply penetrating SW radiation to remaining parts of layers. - ! Excessively thin layers are not heated to avoid runaway temps. - do k=1,nz - - do i=is,ie - netPen(i,k+1) = 0. - - if (h(i,k) > 0.0) then - do n=1,nsw ; if (Pen_SW_bnd(n,i) > 0.0) then - ! SW_trans is the SW that is transmitted THROUGH the layer - opt_depth = h(i,k)*GV%H_to_m * opacity_band(n,i,k) - exp_OD = exp(-opt_depth) - SW_trans = exp_OD - - ! Heating at a rate of less than 10-4 W m-2 = 10-3 K m / Century, - ! and of the layer in question less than 1 K / Century, can be - ! absorbed without further penetration. - if ((nsw*Pen_SW_bnd(n,i)*SW_trans < GV%m_to_H*2.5e-11*dt) .and. & - (nsw*Pen_SW_bnd(n,i)*SW_trans < h(i,k)*dt*2.5e-8)) & - SW_trans = 0.0 - - Pen_SW_bnd(n,i) = Pen_SW_bnd(n,i) * SW_trans - netPen(i,k+1) = netPen(i,k+1) + Pen_SW_bnd(n,i) - endif ; enddo - endif ! h(i,k) > 0.0 - - ! Add to the accumulated thickness above that could be heated. - ! Only layers greater than h_min_heat thick should get heated. - if (h(i,k) >= 2.0*h_min_heat) then - h_heat(i) = h_heat(i) + h(i,k) - elseif (h(i,k) > h_min_heat) then - h_heat(i) = h_heat(i) + (2.0*h(i,k) - 2.0*h_min_heat) - endif - enddo ! i loop - enddo ! k loop - - if (absorbAllSW) then - - ! If there is still shortwave radiation at this point, it could go into - ! the bottom (with a bottom mud model), or it could be redistributed back - ! through the water column. - do i=is,ie - Pen_SW_rem(i) = Pen_SW_bnd(1,i) - do n=2,nsw ; Pen_SW_rem(i) = Pen_SW_rem(i) + Pen_SW_bnd(n,i) ; enddo - enddo - do i=is,ie ; if (Pen_SW_rem(i) > 0.0) SW_Remains = .true. ; enddo - - Ih_limit = 1.0 / H_limit_fluxes - do i=is,ie ; if ((Pen_SW_rem(i) > 0.0) .and. (h_heat(i) > 0.0)) then - if (h_heat(i)*Ih_limit < 1.0) then - unabsorbed = 1.0 - h_heat(i)*Ih_limit - else - unabsorbed = 0.0 - endif - do n=1,nsw ; Pen_SW_bnd(n,i) = unabsorbed * Pen_SW_bnd(n,i) ; enddo - endif ; enddo - - endif ! absorbAllSW - -end subroutine sumSWoverBands - -end module MOM_shortwave_abs diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 024c3125e7..fd910697af 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -42,9 +42,9 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_itidal => NULL(),& !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Fl_itidal => NULL(),& !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 s-1 ~> m2 s-1]. + Kd_Niku => NULL(),& !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. Kd_Niku_work => NULL(),& !< layer integrated work by lee-wave driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Itidal_Work => NULL(),& !< layer integrated work by int tide driven mixing [kg Z3 m-3 T-3 ~> W m-2] Kd_Lowmode_Work => NULL(),& !< layer integrated work by low mode driven mixing [kg Z3 m-3 T-3 ~> W m-2] @@ -54,13 +54,13 @@ module MOM_tidal_mixing real, pointer, dimension(:,:,:) :: tidal_qe_md => NULL() !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate [W m-3?] real, pointer, dimension(:,:,:) :: Kd_lowmode => NULL() !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 s-1 ~> m2 s-1]. + !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. real, pointer, dimension(:,:,:) :: Fl_lowmode => NULL() !< vertical flux of tidal turbulent !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& !< internal tide TKE input at ocean bottom [kg Z3 m-3 T-3 ~> W m-2] - N2_bot => NULL(),& !< bottom squared buoyancy frequency [s-2] - N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [s-2] + N2_bot => NULL(),& !< bottom squared buoyancy frequency [T-2 ~> s-2] + N2_meanz => NULL(),& !< vertically averaged buoyancy frequency [T-2 ~> s-2] Polzin_decay_scale_scaled => NULL(),& !< vertical scale of decay for tidal dissipation Polzin_decay_scale => NULL(),& !< vertical decay scale for tidal diss with Polzin [m] Simmons_coeff_2d => NULL() !< The Simmons et al mixing coefficient @@ -112,7 +112,7 @@ module MOM_tidal_mixing real :: Nbotref_Polzin !< Reference value for the buoyancy frequency at the !! ocean bottom used in Polzin formulation of the - !! vertical scale of decay of tidal dissipation [s-1] + !! vertical scale of decay of tidal dissipation [T-1 ~> s-1] real :: Polzin_decay_scale_factor !< Scaling factor for the decay length scale !! of the tidal dissipation profile in Polzin [nondim] real :: Polzin_decay_scale_max_factor !< The decay length scale of tidal dissipation @@ -148,7 +148,7 @@ module MOM_tidal_mixing !! [kg Z3 m-3 T-3 ~> W m-2] real, pointer, dimension(:,:) :: TKE_itidal => NULL() !< The internal Turbulent Kinetic Energy input divided !! by the bottom stratfication [kg Z3 m-3 T-2 ~> J m-2]. - real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [s-1]. + real, pointer, dimension(:,:) :: Nb => NULL() !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, pointer, dimension(:,:) :: mask_itidal => NULL() !< A mask of where internal tide energy is input real, pointer, dimension(:,:) :: h2 => NULL() !< Squared bottom depth variance [m2]. real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m s-1] @@ -159,6 +159,10 @@ module MOM_tidal_mixing !! TODO: make this E(x,y) only real, allocatable, dimension(:,:,:) :: tidal_qe_3d_in !< q*E(x,y,z) with the Schmittner parameterization [W m-3?] + logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the + !! answers from the end of 2018. Otherwise, use updated and more robust + !! forms of the same expressions. + ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing type(tidal_mixing_diags), pointer :: dd => NULL() !< A pointer to a structure of diagnostic arrays @@ -189,7 +193,6 @@ module MOM_tidal_mixing end type tidal_mixing_cs !!@{ Coded parmameters for specifying mixing schemes -character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. character*(20), parameter :: STLAURENT_PROFILE_STRING = "STLAURENT_02" character*(20), parameter :: POLZIN_PROFILE_STRING = "POLZIN_09" integer, parameter :: STLAURENT_02 = 1 @@ -214,17 +217,18 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) ! Local variables logical :: read_tideamp + logical :: default_2018_answers character(len=20) :: tmpstr, int_tide_profile_str character(len=20) :: CVMix_tidal_scheme_str, tidal_energy_type character(len=200) :: filename, h2_file, Niku_TKE_input_file character(len=200) :: tidal_energy_file, tideamp_file - real :: utide, hamp, prandtl_tidal + real :: utide, hamp, prandtl_tidal, max_frac_rough real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed - -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_tidal_mixing" !< This module's name. if (associated(CS)) then call MOM_error(WARNING, "tidal_mixing_init called when control structure "// & @@ -259,6 +263,14 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) tidal_mixing_init = CS%int_tide_dissipation if (.not. tidal_mixing_init) return + call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & + "This sets the default value for the various _2018_ANSWERS parameters.", & + default=.true.) + call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", CS%answers_2018, & + "If true, use the order of arithmetic and expressions that recover the "//& + "answers from the end of 2018. Otherwise, use updated and more robust "//& + "forms of the same expressions.", default=default_2018_answers) + if (CS%int_tide_dissipation) then ! Read in CVMix tidal scheme if CVMix tidal mixing is on @@ -359,7 +371,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) "reference value of the buoyancy frequency at the ocean "//& "bottom in the Polzin formulation for the vertical "//& "scale of decay for the tidal energy dissipation.", & - units="s-1", default=9.61e-4) + units="s-1", default=9.61e-4, scale=US%T_to_s) call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & CS%Polzin_decay_scale_factor, & "When the Polzin decay profile is used, this is a "//& @@ -447,17 +459,27 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call MOM_read_data(filename, 'h2', CS%h2, G%domain, timelevel=1, scale=US%m_to_Z**2) + call get_param(param_file, mdl, "FRACTIONAL_ROUGHNESS_MAX", max_frac_rough, & + "The maximum topographic roughness amplitude as a fraction of the mean depth, "//& + "or a negative value for no limitations on roughness.", & + units="nondim", default=0.1) + do j=js,je ; do i=is,ie if (G%bathyT(i,j) < CS%min_zbot_itides) CS%mask_itidal(i,j) = 0.0 CS%tideamp(i,j) = CS%tideamp(i,j) * CS%mask_itidal(i,j) * G%mask2dT(i,j) - ! Restrict rms topo to 10 percent of column depth. - !### Note the hard-coded nondimensional constant, and that this could be simplified. - hamp = min(0.1*G%bathyT(i,j),sqrt(CS%h2(i,j))) - CS%h2(i,j) = hamp*hamp + ! Restrict rms topo to a fraction (often 10 percent) of the column depth. + if (CS%answers_2018 .and. (max_frac_rough >= 0.0)) then + hamp = min(max_frac_rough*G%bathyT(i,j), sqrt(CS%h2(i,j))) + CS%h2(i,j) = hamp*hamp + else + if (max_frac_rough >= 0.0) & + CS%h2(i,j) = min((max_frac_rough*G%bathyT(i,j))**2, CS%h2(i,j)) + endif utide = CS%tideamp(i,j) - ! Compute the fixed part of internal tidal forcing; units are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. + ! Compute the fixed part of internal tidal forcing. + ! The units here are [kg Z3 m-3 T-2 ~> J m-2 = kg s-2] here. CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -557,7 +579,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -576,11 +598,11 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_itidal = register_diag_field('ocean_model','TKE_itidal',diag%axesT1,Time, & 'Internal Tide Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Nb = register_diag_field('ocean_model','Nb',diag%axesT1,Time, & - 'Bottom Buoyancy Frequency', 's-1') + 'Bottom Buoyancy Frequency', 's-1', conversion=US%s_to_T) CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity (from propagating low modes)', & - 'm2 s-1', conversion=US%Z_to_m**2) + 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', & @@ -600,10 +622,10 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) 'scaled by N2_bot/N2_meanz', 'm', conversion=US%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & - 'Bottom Buoyancy frequency squared', 's-2') + 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) - CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz',diag%axesT1,Time, & - 'Buoyancy frequency squared averaged over the water column', 's-2') + CS%id_N2_meanz = register_diag_field('ocean_model','N2_meanz', diag%axesT1, Time, & + 'Buoyancy frequency squared averaged over the water column', 's-2', conversion=US%s_to_T**2) CS%id_Kd_Itidal_Work = register_diag_field('ocean_model','Kd_Itidal_Work',diag%axesTL,Time, & 'Work done by Internal Tide Diapycnal Mixing', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) @@ -619,7 +641,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, diag, CS) CS%id_TKE_leewave = register_diag_field('ocean_model','TKE_leewave',diag%axesT1,Time, & 'Lee wave Driven Turbulent Kinetic Energy', 'W m-2', conversion=(US%Z_to_m**3*US%s_to_T**3)) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) endif endif ! S%use_CVMix_tidal endif @@ -662,14 +684,14 @@ subroutine calculate_tidal_mixing(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, C !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then call calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) else call add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, & - G, GV, US, CS, N2_lay, Kd_lay, Kd_int, US%s_to_T*Kd_max) + G, GV, US, CS, N2_lay, Kd_lay, Kd_int, Kd_max) endif endif end subroutine calculate_tidal_mixing @@ -690,10 +712,10 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: Kd_lay!< The diapycnal diffusivities in the layers [Z2 T-1 ~> m2 s-1]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 s-1 ~> m2 s-1]. + !! (not layer!) [Z2 T-1 ~> m2 s-1]. ! Local variables - real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2/s] - real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2/s] + real, dimension(SZK_(G)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] + real, dimension(SZK_(G)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] real, dimension(SZK_(G)+1) :: vert_dep ! vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight ! Height of interfaces [m] real, dimension(SZK_(G)+1) :: SchmittnerSocn @@ -772,13 +794,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. enddo endif ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -874,13 +896,13 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, US, CS, N2_int, Kd_lay, Kv) ! Update viscosity if (associated(Kv)) then do k=1,G%ke+1 - Kv(i,j,k) = Kv(i,j,k) + US%m_to_Z**2 * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 s-1. + Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kv_tidal(k) ! Rescale from m2 s-1 to Z2 T-1. enddo endif ! diagnostics if (associated(dd%Kd_itidal)) then - dd%Kd_itidal(i,j,:) = Kd_tidal(:) + dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) endif if (associated(dd%N2_int)) then dd%N2_int(i,j,:) = N2_int(i,:) @@ -939,7 +961,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, !! [Z2 T-1 ~> m2 s-1]. real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes - !! [Z2 s-1 ~> m2 s-1]. + !! [Z2 T-1 ~> m2 s-1]. !! Set this to a negative value to have no limit. ! local @@ -959,7 +981,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz - N2_meanz, & ! vertically averaged squared buoyancy frequency [s-2] for WKB scaling + N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2] for WKB scaling TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3] TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3] TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM) @@ -971,13 +993,15 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. real :: I_rho0 ! 1 / RHO0 [m3 kg-1] - real :: Kd_add ! diffusivity to add in a layer [Z2 s-1 ~> m2 s-1]. + real :: Kd_add ! diffusivity to add in a layer [Z2 T-1 ~> m2 s-1]. real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3] real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3] real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [Z3 T-3 ~> m3 s-3] (BDM) real :: frac_used ! fraction of TKE that can be used in a layer [nondim] real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. + real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3]. + real :: z0Ps_denom ! The denominator of the unlimited z0_Polzin_scaled [T-3 ~> s-3]. real :: z0_psl ! temporary variable [Z ~> m]. real :: TKE_lowmode_tot ! TKE from all low modes [kg Z3 m-3 T-3 ~> W m-2] (BDM) @@ -1013,8 +1037,8 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & GV%H_subroundoff*GV%H_to_Z) do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) - if (associated(dd%N2_bot)) dd%N2_bot(i,j) = US%s_to_T**2 * N2_bot(i) + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (associated(dd%N2_bot)) dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) @@ -1037,9 +1061,9 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Polzin: if ( use_Polzin ) then ! WKB scaling of the vertical coordinate - do i=is,ie ; N2_meanz(i)=0.0 ; enddo + do i=is,ie ; N2_meanz(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + (US%s_to_T**2 * N2_lay(i,k)) * GV%H_to_Z * h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * GV%H_to_Z * h(i,j,k) enddo ; enddo do i=is,ie N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) @@ -1050,30 +1074,48 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, do i=is,ie ; htot_WKB(i) = htot(i) ; enddo ! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) +! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler do i=is,ie - CS%Nb(i,j) = sqrt(US%s_to_T**2 * N2_bot(i)) - !### In the code below 1.0e-14 is a dimensional constant in [s-3] - if ((CS%tideamp(i,j) > 0.0) .and. & - (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & - CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & - ( CS%kappa_itides**2 * CS%h2(i,j) * US%T_to_s * CS%Nb(i,j)**3 ) - if (z0_polzin(i) < CS%Polzin_min_decay_scale) & - z0_polzin(i) = CS%Polzin_min_decay_scale - if (N2_meanz(i) > 1.0e-14 ) then !### Here 1.0e-14 has dimensions of s-2. - z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + CS%Nb(i,j) = sqrt(N2_bot(i)) + if (CS%answers_2018) then + if ((CS%tideamp(i,j) > 0.0) .and. & + (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then + z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & + ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) + if (z0_polzin(i) < CS%Polzin_min_decay_scale) & + z0_polzin(i) = CS%Polzin_min_decay_scale + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then + z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + else + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) endif - if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0Ps_num = (CS%Polzin_decay_scale_factor * CS%Nu_Polzin * CS%Nbotref_Polzin**2) * CS%tideamp(i,j) + z0Ps_denom = ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j) * N2_meanz(i) ) + if ((CS%tideamp(i,j) > 0.0) .and. & + (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * htot(i))) then + z0_polzin_scaled(i) = z0Ps_num / z0Ps_denom + + if (abs(N2_meanz(i) * z0_polzin_scaled(i)) < & + CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * htot(i))) then + z0_polzin(i) = z0_polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2) + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif + else + z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + endif endif if (associated(dd%Polzin_decay_scale)) & @@ -1082,33 +1124,48 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) if (associated(dd%N2_bot)) dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) - if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (CS%answers_2018) then + ! These expressions use dimensional constants to avoid NaN values. + if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif - endif - if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 endif - endif - if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - ! For the Polzin formulation, this if loop prevents the vertical - ! flux of energy dissipation from having NaN values - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) then !### Avoid using this dimensional constant. - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + endif + else + ! These expressions give values of Inv_int < 10^14 using a variant of Adcroft's reciprocal rule. + Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 + if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + endif + if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + endif + if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then + if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & + Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 endif endif z_from_bot(i) = GV%H_to_Z*h(i,j,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. - if (N2_meanz(i) > 1.0e-14 ) then !### Avoid using this dimensional constant. - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * (US%s_to_T**2 * N2_lay(i,nz)) / N2_meanz(i) - else ; z_from_bot_WKB(i) = 0 ; endif + if (CS%answers_2018) then + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + else + if (GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * htot_WKB(i))) then + z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + else ; z_from_bot_WKB(i) = 0 ; endif + endif enddo endif ! Polzin @@ -1116,7 +1173,7 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, ! Both Polzin and Simmons: do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) - TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*US%T_to_s*CS%Nb(i,j), CS%TKE_itide_max) + TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) if (associated(dd%TKE_itidal_used)) & dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) @@ -1178,21 +1235,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, dd%Kd_itidal is just TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k 1.0e-14 ) then + if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then z_from_bot_WKB(i) = z_from_bot_WKB(i) & - + GV%H_to_Z * h(i,j,k) * (US%s_to_T**2 * N2_lay(i,k)) / N2_meanz(i) + + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif ! Fraction of bottom flux predicted to reach top of this layer @@ -1266,21 +1323,21 @@ subroutine add_int_tide_diffusivity(h, N2_bot, j, TKE_to_Kd, max_TKE, G, GV, US, TKE_lowmode_rem(i) = TKE_lowmode_rem(i) - TKE_lowmode_lay ! Convert power to diffusivity - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + Kd_add = TKE_to_Kd(i,k) * (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) - Kd_lay(i,j,k) = Kd_lay(i,j,k) + (US%T_to_s * Kd_add) + Kd_lay(i,j,k) = Kd_lay(i,j,k) + Kd_add if (present(Kd_int)) then - Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * (US%T_to_s * Kd_add) - Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * (US%T_to_s * Kd_add) + Kd_int(i,j,K) = Kd_int(i,j,K) + 0.5 * Kd_add + Kd_int(i,j,K+1) = Kd_int(i,j,K+1) + 0.5 * Kd_add endif ! diagnostics if (associated(dd%Kd_itidal)) then ! If at layers, this is just dd%Kd_itidal(i,j,K) = TKE_to_Kd(i,k) * TKE_itide_lay ! The following sets the interface diagnostics. - Kd_add = US%s_to_T * TKE_to_Kd(i,k) * TKE_itide_lay + Kd_add = TKE_to_Kd(i,k) * TKE_itide_lay if (Kd_max >= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_itidal(i,j,K) = dd%Kd_itidal(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_Niku(i,j,K) = dd%Kd_Niku(i,j,K) + 0.5*Kd_add if (k= 0.0) Kd_add = min(Kd_add, Kd_max) if (k>1) dd%Kd_lowmode(i,j,K) = dd%Kd_lowmode(i,j,K) + 0.5*Kd_add if (k m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. - real :: Kvml !< The mixed layer vertical viscosity [Z2 s-1 ~> m2 s-1]. - real :: Kv !< The interior vertical viscosity [Z2 s-1 ~> m2 s-1]. + 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 :: Kvbbl !< The vertical viscosity in the bottom boundary - !! layer [Z2 s-1 ~> m2 s-1]. + !! layer [Z2 T-1 ~> m2 s-1]. real :: maxvel !< Velocity components greater than maxvel are truncated [m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -65,17 +65,17 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface [Z s-1 ~> m s-1]. + a_u !< The u-drag coefficient 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 s-1 ~> m s-1]. + a_v !< The v-drag coefficient 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 - !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under - !! ice shelves [Z s-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. logical :: split !< If true, use the split time stepping scheme. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -177,7 +177,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z s-1 ~> m s-1]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress @@ -187,7 +187,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: dt_Rho0 ! The time step divided by the mean density [s m3 kg-1]. real :: Rho0 ! A density used to convert drag laws into stress in Pa [kg m-3]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - [s H Z-1 ~> s or s kg m-3]. + ! units of thickness - [T H Z-1 ~> s or s kg m-3]. 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]. @@ -212,7 +212,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt/GV%H_to_kg_m2 - dt_Z_to_H = dt*GV%Z_to_H + dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H Rho0 = GV%Rho0 h_neglect = GV%H_subroundoff Idt = 1.0 / dt @@ -318,15 +318,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -Rho0*US%s_to_T*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = Rho0 * (u(I,j,nz)*US%s_to_T*CS%a_u(I,j,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + Rho0 * (US%s_to_T*Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -385,7 +385,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & 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(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) @@ -399,15 +399,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (associated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -Rho0*US%s_to_T*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = Rho0 * (v(i,J,nz)*US%s_to_T*CS%a_v(i,J,nz+1)) enddo if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + Rho0 * (US%s_to_T*Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -455,7 +455,7 @@ end subroutine vertvisc !! after a time-step of viscosity, and the fraction of a time-step's !! worth of barotropic acceleration that a layer experiences after !! viscosity is applied. -subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) +subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag @@ -468,6 +468,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) !! barotopic acceleration that a layer experiences after !! viscosity is applied in the meridional direction [nondim] real, intent(in) :: dt !< Time increment [s] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure ! Local variables @@ -475,10 +476,10 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(G)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity times the time step [m]. + real :: Ray(SZIB_(G),SZK_(G)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness [s H Z-1 ~> s or s kg m-3]. + ! units of thickness [T H Z-1 ~> s or s kg m-3]. logical :: do_i(SZIB_(G)) integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz @@ -488,7 +489,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") - dt_Z_to_H = dt*GV%Z_to_H + dt_Z_to_H = US%s_to_T*dt*GV%Z_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo @@ -542,7 +543,7 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) 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(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) @@ -592,14 +593,14 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) hvel, & ! hvel is the thickness used at a velocity grid point [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_(G)+1) :: & - a_cpl, & ! The drag coefficients across interfaces [Z s-1 ~> m s-1]. a_cpl times + 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_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves [Z s-1 ~> m s-1]. + ! ice shelves [Z T-1 ~> m s-1]. z_i ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness, nondim. real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + 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_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. @@ -613,8 +614,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) 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 s-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 s-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 :: 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. @@ -676,7 +677,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq - kv_bbl(I) = visc%kv_bbl_u(I,j) + kv_bbl(I) = visc%Kv_bbl_u(I,j) bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H if (do_i(I)) I_Hbbl(I) = 1.0 / (bbl_thick(I) + h_neglect) enddo ; endif @@ -843,7 +844,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie - kv_bbl(i) = visc%kv_bbl_v(i,J) + kv_bbl(i) = visc%Kv_bbl_v(i,J) bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -1004,9 +1005,9 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) if (CS%debug) then call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & - CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m) + CS%h_v, G%HI,haloshift=0, scale=GV%H_to_m*US%s_to_T) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, & - CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m) + CS%a_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, & G%HI, haloshift=0, scale=GV%H_to_m) @@ -1037,7 +1038,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, 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 s-1 ~> m s-1]. + 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] logical, dimension(SZIB_(G)), & @@ -1046,7 +1047,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point [H ~> m or kg m-2] real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 s-1 ~> m2 s-1]. + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. 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 @@ -1065,35 +1066,37 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point [Z s-1 ~> m s-1]. - absf, & ! The average of the neighboring absolute values of f [s-1]. + u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. + absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1]. ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, [H ~> m or kg m-2] or [nondim]. - kv_tbl, & ! The viscosity in a top boundary layer under ice [Z2 s-1 ~> m2 s-1]. + kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. tbl_thick - real, dimension(SZIB_(G),SZK_(GV)) :: & - Kv_add ! A viscosity to add [Z2 s-1 ~> m2 s-1]. + 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 :: 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 s-1 ~> m2 s-1]. + real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. real :: a_ml ! The layer coupling coefficient across an interface in - ! the mixed layer [m s-1]. - real :: I_amax ! The inverse of the maximum coupling coefficient [Z-1 ~> m-1].??? + ! the mixed layer [Z T-1 ~> m s-1]. + real :: I_amax ! The inverse of the maximum coupling coefficient [T s-1 Z-1 ~> m-1].??? real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] 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 :: z2 ! A copy of z_i, nondim. - real :: topfn - real :: a_top + real :: z2 ! A copy of z_i [nondim] + real :: topfn ! A function that is 1 at the top and small far from it [nondim] + real :: a_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] logical :: do_shelf, do_OBCs integer :: i, k, is, ie, max_nk integer :: nz real :: botfn a_cpl(:,:) = 0.0 + Kv_tot(:,:) = 0.0 if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif @@ -1103,7 +1106,7 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The maximum coupling coefficent was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. - I_amax = (1.0e-10*US%Z_to_m) * dt + I_amax = (1.0e-10*US%Z_to_m) * dt*US%s_to_T do_shelf = .false. ; if (present(shelf)) do_shelf = shelf do_OBCs = .false. @@ -1112,15 +1115,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The following loop calculates the vertical average velocity and ! surface mixed layer contributions to the vertical viscosity. - do i=is,ie ; a_cpl(i,1) = 0.0 ; enddo + do i=is,ie ; Kv_tot(i,1) = 0.0 ; enddo if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) a_cpl(i,K) = 2.0*CS%Kv + if (do_i(i)) Kv_tot(i,K) = CS%Kv enddo ; enddo ; else I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - a_cpl(i,K) = 2.0*CS%Kv + 2.0*CS%Kvml / ((z_t(i)*z_t(i)) * & + Kv_tot(i,K) = CS%Kv + CS%Kvml / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif @@ -1129,51 +1132,48 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (CS%bottomdraglaw) then r = hvel(i,nz)*0.5 if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + r*GV%H_to_Z) else - a_cpl(i,nz+1) = 1.0*kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + bbl_thick(i)*GV%H_to_Z) endif else - a_cpl(i,nz+1) = 2.0*CS%Kvbbl / (hvel(i,nz)*GV%H_to_Z + 2.0*I_amax*CS%Kvbbl) + a_cpl(i,nz+1) = CS%Kvbbl / (0.5*hvel(i,nz)*GV%H_to_Z + I_amax*CS%Kvbbl) endif endif ; enddo if (associated(visc%Kv_shear)) then - ! BGR/ Add factor of 2. * the averaged Kv_shear. - ! this is needed to reproduce the analytical solution to - ! a simple diffusion problem, likely due to h_shear being - ! equal to 2 x \delta z + ! The factor of 2 that used to be required in the viscosities is no longer needed. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) endif ; enddo ; enddo if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = (2.*0.5)*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) + Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i,j+1,k)) endif ; enddo ; enddo if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = 2.*visc%Kv_shear(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = visc%Kv_shear(i,j+1,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1181,11 +1181,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_shear_Bu)) then if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - a_cpl(I,K) = a_cpl(I,K) + (2.*0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(I,K) = Kv_tot(I,K) + (0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + (2.*0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(i,K) = Kv_tot(i,K) + (0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1194,37 +1194,43 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(visc%Kv_slow) .and. (visc%add_Kv_slow)) then ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then + !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(I,K) = Kv_add(I,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + ! Should be : Kv_add(I,K) = 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) endif ; enddo ; enddo + !### I am pretty sure that this code is double counting viscosity at OBC points! - RWH if (do_OBCs) then do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i,j,k) ; enddo + ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(I,K) = Kv_add(I,K) + visc%Kv_slow(i+1,j,k) ; enddo + ! Should be : do K=2,nz ; Kv_add(I,K) = visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(I,K) = Kv_tot(I,K) + Kv_add(I,K) endif ; enddo ; enddo else + !### Incrementing Kv_add here will cause visc%Kv_shear to be double counted. - RWH do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) endif ; enddo ; enddo - !### I am pretty sure that this is double counting here! - RWH + !### I am pretty sure that this code is double counting viscosity at OBC points! - RWH if (do_OBCs) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif do K=2,nz ; do i=is,ie ; if (do_i(i)) then - a_cpl(i,K) = a_cpl(i,K) + Kv_add(i,K) + Kv_tot(i,K) = Kv_tot(i,K) + Kv_add(i,K) endif ; enddo ; enddo endif endif @@ -1236,39 +1242,39 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) if (CS%bottomdraglaw) then - a_cpl(i,K) = a_cpl(i,K) + 2.0*(kv_bbl(i) - CS%Kv)*botfn - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*bbl_thick(i)) then - h_shear = ((1.0 - botfn) * r + botfn*2.0*bbl_thick(i)) + Kv_tot(i,K) = Kv_tot(i,K) + (kv_bbl(i) - CS%Kv)*botfn + r = 0.5*(hvel(i,k) + hvel(i,k-1)) + if (r > bbl_thick(i)) then + h_shear = ((1.0 - botfn) * r + botfn*bbl_thick(i)) else h_shear = r endif else - a_cpl(i,K) = a_cpl(i,K) + 2.0*(CS%Kvbbl-CS%Kv)*botfn - h_shear = hvel(i,k) + hvel(i,k-1) + h_neglect + Kv_tot(i,K) = Kv_tot(i,K) + (CS%Kvbbl-CS%Kv)*botfn + h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) endif - ! Up to this point a_cpl has had units of Z2 s-1, but now is converted to Z s-1. - a_cpl(i,K) = a_cpl(i,K) / (h_shear*GV%H_to_Z + I_amax*a_cpl(i,K)) + ! 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)) endif ; enddo ; enddo ! i & k loops if (do_shelf) then ! Set the coefficients to include the no-slip surface stress. do i=is,ie ; if (do_i(i)) then if (work_on_u) then - kv_tbl(i) = visc%kv_tbl_shelf_u(I,j) + kv_TBL(i) = visc%Kv_tbl_shelf_u(I,j) tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H else - kv_tbl(i) = visc%kv_tbl_shelf_v(i,J) + kv_TBL(i) = visc%Kv_tbl_shelf_v(i,J) tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H endif z_t(i) = 0.0 ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = kv_tbl(i) / (tbl_thick(i) *GV%H_to_Z + I_amax*kv_tbl(i)) + a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i)*GV%H_to_Z + I_amax*kv_TBL(i)) else - a_cpl(i,1) = kv_tbl(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_tbl(i)) + a_cpl(i,1) = kv_TBL(i) / (0.5*hvel(i,1)*GV%H_to_Z + I_amax*kv_TBL(i)) endif endif ; enddo @@ -1276,14 +1282,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t(i) = z_t(i) + hvel(i,k-1) / tbl_thick(i) topfn = 1.0 / (1.0 + 0.09 * z_t(i)**6) - r = (hvel(i,k)+hvel(i,k-1)) - if (r > 2.0*tbl_thick(i)) then - h_shear = ((1.0 - topfn) * r + topfn*2.0*tbl_thick(i)) + r = 0.5*(hvel(i,k)+hvel(i,k-1)) + if (r > tbl_thick(i)) then + h_shear = ((1.0 - topfn) * r + topfn*tbl_thick(i)) else h_shear = r endif - a_top = 2.0 * topfn * kv_tbl(i) + a_top = topfn * kv_TBL(i) a_cpl(i,K) = a_cpl(i,K) + a_top / (h_shear*GV%H_to_Z + I_amax*a_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then @@ -1292,11 +1298,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) if (work_on_u) then u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 else u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*US%s_to_T*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 endif h_ml(i) = h_neglect ; z_t(i) = 0.0 @@ -1333,10 +1339,8 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) ! and be further limited by rotation to give the natural Ekman length. - visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / & - (absf(i)*temp1 + h_ml(i)*u_star(i)) - a_ml = 4.0*visc_ml / ((hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + & - 2.0*I_amax* visc_ml) + visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / (absf(i)*temp1 + h_ml(i)*u_star(i)) + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) ! Choose the largest estimate of a. if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml endif ; endif ; enddo ; enddo @@ -1663,18 +1667,18 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "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%m_to_Z**2, unscaled=Kv_dflt) + units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) 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 "//& "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. "//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if "//& "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m_to_Z**2) + units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a "//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& @@ -1735,19 +1739,19 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & 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, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z_to_m**2) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z_to_m**2) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) 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%Z_to_m**2) + 'Total 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) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) 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) + '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) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 89f4a6eef4..37f66987c0 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -18,7 +18,7 @@ module MOM_offline_aux use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar use MOM_variables, only : vertvisc_type use MOM_forcing_type, only : forcing -use MOM_shortwave_abs, only : optics_type +use MOM_opacity, only : optics_type use MOM_diag_mediator, only : post_data use MOM_forcing_type, only : forcing diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 00b61210fe..8278e57264 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -10,7 +10,7 @@ module MOM_offline_main use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE -use MOM_diabatic_aux, only : diabatic_aux_CS +use MOM_diabatic_aux, only : diabatic_aux_CS, set_pen_shortwave use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS use MOM_diag_mediator, only : diag_ctrl, post_data, register_diag_field @@ -26,9 +26,8 @@ module MOM_offline_main use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_opacity, only : set_opacity, opacity_CS +use MOM_opacity, only : opacity_CS, optics_type use MOM_open_boundary, only : ocean_OBC_type -use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type use MOM_tracer_advect, only : tracer_advect_CS, advect_tracer use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut @@ -70,6 +69,8 @@ module MOM_offline_main !< Pointer to structure containing information about the vertical grid type(optics_type), pointer :: optics => NULL() !< Pointer to the optical properties type + type(diabatic_aux_CS), pointer :: diabatic_aux_CSp => NULL() + !< Pointer to the diabatic_aux control structure !> Variables related to reading in fields from online run integer :: start_index !< Timelevel to start @@ -718,7 +719,7 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, e endif if (associated(CS%optics)) & - call set_opacity(CS%optics, fluxes, CS%G, CS%GV, CS%opacity_CSp) + call set_pen_shortwave(CS%optics, fluxes, CS%G, CS%GV, CS%diabatic_aux_CSp, CS%opacity_CSp, CS%tracer_flow_CSp) ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called ! as the freshwater fluxes have already been accounted for @@ -1400,7 +1401,8 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) if (.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy members from other modules - call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics,& + call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics, & + diabatic_aux_CSp=CS%diabatic_aux_CSp, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 73d4a2ea1f..730551ccdb 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -300,7 +300,7 @@ subroutine idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) do j=js,je do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo @@ -352,7 +352,7 @@ subroutine idealized_hurricane_wind_profile(CS, absf, YY, XX, UOCN, VOCN, Tx, Ty ! Implementing Holland (1980) parameteric wind profile - Radius = SQRT(XX**2.+YY**2.) + Radius = SQRT(XX**2 + YY**2) !/ BGR ! rkm - r converted to km for Holland prof. @@ -493,7 +493,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) !/ BR ! Calculate x position as a function of time. xx = ( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir) - r = sqrt(xx**2.+CS%DY_from_center**2.) + r = sqrt(xx**2 + CS%DY_from_center**2) !/ BR ! rkm - r converted to km for Holland prof. ! used in km due to error, correct implementation should @@ -602,7 +602,7 @@ subroutine SCM_idealized_hurricane_wind_forcing(state, forces, day, G, US, CS) ! Set the surface friction velocity [m s-1]. ustar is always positive. do j=js,je ; do i=is,ie ! This expression can be changed if desired, but need not be. - forces%ustar(i,j) = US%m_to_Z * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * G%mask2dT(i,j) * sqrt(CS%gustiness/CS%Rho0 + & sqrt(0.5*(forces%taux(I-1,j)**2 + forces%taux(I,j)**2) + & 0.5*(forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2))/CS%Rho0) enddo ; enddo diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index ecf373681d..9e09ea9bba 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -104,7 +104,7 @@ module MOM_wave_interface !! Horizontal -> V points !! 3rd dimension -> Freq/Wavenumber real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear [Z2/s ~> m2 s-1] + KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] ! Pointers to auxiliary fields type(time_type), pointer, public :: Time !< A pointer to the ocean model's clock. @@ -483,7 +483,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), & - intent(in) :: ustar !< Wind friction velocity [Z s-1 ~> m s-1]. + intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. ! Local Variables real :: Top, MidPoint, Bottom, one_cm real :: DecayScale @@ -683,7 +683,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) do ii = G%isc,G%iec do jj = G%jsc, G%jec Top = h(ii,jj,1)*GV%H_to_Z - call get_Langmuir_Number( La, G, GV, US, Top, US%Z_to_m*ustar(ii,jj), ii, jj, & + call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & H(ii,jj,:),Override_MA=.false.,WAVES=CS) CS%La_turb(ii,jj) = La enddo @@ -700,7 +700,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar) call post_data(CS%id_3dstokes_x, CS%us_x, CS%diag) if (CS%id_La_turb>0) & call post_data(CS%id_La_turb, CS%La_turb, CS%diag) - return + end subroutine Update_Stokes_Drift !> A subroutine to fill the Stokes drift from a NetCDF file @@ -881,7 +881,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, intent(in) :: ustar !< Friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: HBL !< (Positive) thickness of boundary layer [Z ~> m]. logical, optional, intent(in) :: Override_MA !< Override to use misalignment in LA !! calculation. This can be used if diagnostic @@ -901,7 +901,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & !Local Variables real :: Top, bottom, midpoint real :: Dpt_LASL, ShearDirection, WaveDirection - real :: LA_STKx, LA_STKy, LA_STK + real :: LA_STKx, LA_STKy, LA_STK ! Stokes velocities in [m s-1] logical :: ContinueLoop, USE_MA real, dimension(SZK_(G)) :: US_H, VS_H real, dimension(NumBands) :: StkBand_X, StkBand_Y @@ -971,12 +971,13 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, & ! there is also no good reason to cap it here other then ! to prevent large enhancements in unconstrained parts of ! the curve fit parameterizations. - LA = max(WAVES%La_min, sqrt(US%Z_to_m*ustar / (LA_STK+1.e-10))) + ! Note the dimensional constant background Stokes velocity of 10^-10 m s-1. + LA = max(WAVES%La_min, sqrt(US%Z_to_m*US%s_to_T*ustar / (LA_STK+1.e-10))) endif if (Use_MA) then WaveDirection = atan2(LA_STKy, LA_STKx) - LA = LA / sqrt(max(1.e-8,cos( WaveDirection - ShearDirection))) + LA = LA / sqrt(max(1.e-8, cos( WaveDirection - ShearDirection))) endif return @@ -999,7 +1000,7 @@ end subroutine get_Langmuir_Number !! - BGR remove u10 input !! - BGR note: fixed parameter values should be changed to "get_params" subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) - real, intent(in) :: ustar !< water-side surface friction velocity [Z s-1 ~> m s-1]. + real, intent(in) :: ustar !< water-side surface friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: hbl !< boundary layer depth [Z ~> m]. type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1023,7 +1024,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) if (ustar > 0.0) then ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(US%Z_to_m*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) + call ust_2_u10_coare3p5(US%Z_to_m*US%s_to_T*ustar*sqrt(GV%Rho0/1.225), u10, GV, US) ! surface Stokes drift UStokes = us_to_u10*u10 ! @@ -1033,7 +1034,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) ! ! peak frequency (PM, Bouws, 1998) tmp = 2.0 * PI * u19p5_to_u10 * u10 - fp = 0.877 * (GV%g_Earth*US%m_to_Z) / tmp + fp = 0.877 * GV%mks_g_Earth / tmp ! ! mean frequency fm = fm_into_fp * fp @@ -1068,7 +1069,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, UStokes_SL, LA) sqrt( 2.0 * PI *kstar * z0) * & erfc( sqrt( 2.0 * kstar * z0 ) ) UStokes_sl = UStokes * (0.715 + r1 + r2 + r3 + r4) - LA = sqrt(US%Z_to_m*ustar / UStokes_sl) + LA = sqrt(US%Z_to_m*US%s_to_T*ustar / UStokes_sl) else UStokes_sl = 0.0 LA=1.e8 @@ -1166,15 +1167,15 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) !/ omega_min = 0.1 ! Hz ! Cut off at 30cm for now... - omega_max = 10. ! ~sqrt(0.2*(GV%g_Earth*US%m_to_Z)*2*pi/0.3) + omega_max = 10. ! ~sqrt(0.2*GV%mks_g_Earth*2*pi/0.3) NOmega = 1000 domega = (omega_max-omega_min)/real(NOmega) ! if (WaveAgePeakFreq) then - omega_peak = (GV%g_Earth*US%m_to_Z) / (WA * u10) + omega_peak = GV%mks_g_Earth / (WA * u10) else - omega_peak = 2. * pi * 0.13 * (GV%g_Earth*US%m_to_Z) / U10 + omega_peak = 2. * pi * 0.13 * GV%mks_g_Earth / U10 endif !/ Ann = 0.006 * WaveAge**(-0.55) @@ -1190,11 +1191,11 @@ subroutine DHH85_mid(GV, US, zpt, UStokes) do oi = 1,nomega-1 Dnn = exp ( -0.5 * (omega-omega_peak)**2 / (Snn**2 * omega_peak**2) ) ! wavespec units = m2s - wavespec = (Ann * (GV%g_Earth*US%m_to_Z)**2 / (omega_peak*omega**4 ) ) * & + wavespec = (Ann * GV%mks_g_Earth**2 / (omega_peak*omega**4 ) ) * & exp(-bnn*(omega_peak/omega)**4)*Cnn**Dnn ! Stokes units m (multiply by frequency range for units of m/s) Stokes = 2.0 * wavespec * omega**3 * & - exp( 2.0 * omega**2 * zpt/(GV%g_Earth*US%m_to_Z)) / (GV%g_Earth*US%m_to_Z) + exp( 2.0 * omega**2 * zpt / GV%mks_g_Earth) / GV%mks_g_Earth UStokes = UStokes + Stokes*domega omega = omega + domega enddo @@ -1204,12 +1205,12 @@ end subroutine DHH85_mid !> Explicit solver for Stokes mixing. !! Still in development do not use. -subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) +subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for explicit solver + real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1219,7 +1220,7 @@ subroutine StokesMixing(G, GV, DT, h, u, v, Waves ) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables - real :: dTauUp, dTauDn + real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z T-1 m s-1] real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. integer :: i,j,k diff --git a/src/user/SCM_CVMix_tests.F90 b/src/user/SCM_CVMix_tests.F90 index e24db1bcda..48c4dc229d 100644 --- a/src/user/SCM_CVMix_tests.F90 +++ b/src/user/SCM_CVMix_tests.F90 @@ -218,7 +218,7 @@ subroutine SCM_CVMix_tests_wind_forcing(state, forces, day, G, US, CS) mag_tau = sqrt(CS%tau_x*CS%tau_x + CS%tau_y*CS%tau_y) if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie - forces%ustar(i,j) = US%m_to_Z * sqrt( mag_tau / CS%Rho0 ) + forces%ustar(i,j) = US%m_to_Z*US%T_to_s * sqrt( mag_tau / CS%Rho0 ) enddo ; enddo ; endif end subroutine SCM_CVMix_tests_wind_forcing