From 99ca9a71878c38255dac041d0b833db4e0065c56 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 10 Apr 2018 12:54:25 -0600 Subject: [PATCH 01/53] Adding option to smooth Ri using a 1-2-1 filter --- .../vertical/MOM_cvmix_shear.F90 | 45 +++++++++++++------ 1 file changed, 31 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 345522126b..062282f596 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -30,9 +30,11 @@ module MOM_cvmix_shear !> Control structure including parameters for CVMix interior shear schemes. type, public :: cvmix_shear_cs logical :: use_LMD94, use_PP81 !< Flags for various schemes + logical :: smooth_ri !< If true, smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number real :: Nu_zero !< LMD94 maximum interior diffusivity - real :: KPP_exp !< + real :: KPP_exp !< Exponent of unitless factor of diff. + !! for KPP internal shear mixing scheme. real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number @@ -52,22 +54,22 @@ module MOM_cvmix_shear !> Subroutine for calculating (internal) vertical diffusivities/viscosities subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & kv, G, GV, CS ) - type(ocean_grid_type), intent(in) :: G !< Grid structure. - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: u_H !< Initial zonal velocity on T points, in m s-1. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: v_H !< Initial meridional velocity on T points, in m s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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!) in m2 s-1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) in m2 s-1. - type(cvmix_shear_cs), pointer :: CS !< The control structure returned by a previous call to - !! CVMix_shear_init. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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!) in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: kv !< The vertical viscosity at each interface + !! (not layer!) in 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 + real :: GoRho + 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 @@ -120,10 +122,21 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & ! fill 3d arrays, if user asks for diagsnostics if (CS%id_N2 > 0) CS%N2(i,j,k) = N2 if (CS%id_S2 > 0) CS%S2(i,j,k) = S2 - if (CS%id_ri_grad > 0) CS%ri_grad(i,j,k) = Ri_Grad(k) enddo + ! vertically smooth Ri with 1-2-1 weighting + if (CS%smooth_ri) then + dummy = 0.25 * Ri_grad(1) + Ri_grad(G%ke+1) = Ri_grad(G%ke) + do k = 1, G%ke + Ri_Grad(k) = dummy + 0.5 * Ri_Grad(k) + 0.25 * Ri_grad(k+1) + dummy = 0.25 * Ri_grad(k) + enddo + endif + + if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) + ! Call to CVMix wrapper for computing interior mixing coefficients. call cvmix_coeffs_shear(Mdiff_out=kv(i,j,:), & Tdiff_out=kd(i,j,:), & @@ -209,6 +222,10 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) + call get_param(param_file, mdl, "SMOOTH_RI", CS%smooth_ri, & + "If true, vertically smooth the Richardson"// & + "number by applying a 1-2-1 filter once.", & + default = .false.) call cvmix_init_shear(mix_scheme=CS%mix_scheme, & KPP_nu_zero=CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & From b14213a020730dab9592669e5d681e39f362ebd0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 12 Apr 2018 16:45:55 -0600 Subject: [PATCH 02/53] Fill Ri_grad in vanished layers with adjacent value, just when Ri smooth is enabled --- .../vertical/MOM_cvmix_shear.F90 | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 062282f596..dacb02fe59 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -38,8 +38,6 @@ module MOM_cvmix_shear real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency (1/s2) real, allocatable, dimension(:,:,:) :: S2 !< Squared shear frequency (1/s2) real, allocatable, dimension(:,:,:) :: ri_grad !< Gradient Richardson number -! real, allocatable, dimension(:,:,:) :: kv !< vertical viscosity at interface (m2/s) -! real, allocatable, dimension(:,:,:) :: kd !< vertical diffusivity at interface (m2/s) character(10) :: Mix_Scheme !< Mixing scheme name (string) ! Daignostic handles and pointers type(diag_ctrl), pointer :: diag => NULL() @@ -72,7 +70,8 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & 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, parameter :: epsln = 1.e-10 !< Threshold to identify + !! vanished layers ! some constants GoRho = GV%g_Earth / GV%Rho0 @@ -125,8 +124,17 @@ subroutine calculate_cvmix_shear(u_H, v_H, h, tv, kd, & enddo - ! vertically smooth Ri with 1-2-1 weighting + Ri_grad(G%ke+1) = Ri_grad(G%ke) + if (CS%smooth_ri) then + ! 1) fill Ri_grad in vanished layers with adjacent value + do k = 2, G%ke + if (h(i,j,k) .le. epsln) Ri_grad(k) = Ri_grad(k-1) + enddo + + Ri_grad(G%ke+1) = Ri_grad(G%ke) + + ! 2) vertically smooth Ri with 1-2-1 filter dummy = 0.25 * Ri_grad(1) Ri_grad(G%ke+1) = Ri_grad(G%ke) do k = 1, G%ke From c4f1f553c06d16172be35a09e02f0c50953aeb5b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 12 Apr 2018 17:02:31 -0600 Subject: [PATCH 03/53] Update CVMix --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 653d7c39f5..534fc38e75 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 653d7c39f50047c9d79c1b15caffe5631dad8bbb +Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 From 0c363ae6d8d7b6fd32bfd0ba128513730d6431e0 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 13 Apr 2018 08:39:58 -0600 Subject: [PATCH 04/53] Always allocate CS%OBLdepth since other modules may need to know OBLdepth --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 87ce532a28..baa33e2ffa 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -370,8 +370,9 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & 'j-component flow of surface layer (10% of OBL depth) as passed to [CVmix] KPP', 'm/s') - if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. + ! CS%OBLdepth should always be allocated, since it may used by other modules + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ); CS%OBLdepth(:,:) = 0. + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -864,7 +865,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif ! Copy 1d data into 3d diagnostic arrays - if (CS%id_OBLdepth > 0) CS%OBLdepth(i,j) = OBLdepth_0d + CS%OBLdepth(i,j) = OBLdepth_0d if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) @@ -942,7 +943,7 @@ subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for !! this module type(ocean_grid_type), intent(in) :: G !< Grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BLD!< bnd. layer depth (m) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD!< bnd. layer depth (m) ! Local variables integer :: i,j do j = G%jsc, G%jec ; do i = G%isc, G%iec From 8a4a5edd39d568e8286a1c1dbf92e72c79fa37a6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Fri, 13 Apr 2018 11:44:24 -0600 Subject: [PATCH 05/53] distinguish profiles and cvmix schemes --- .../vertical/MOM_tidal_mixing.F90 | 106 +++++++++--------- 1 file changed, 56 insertions(+), 50 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a59af01afb..c6d522fa93 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -34,6 +34,7 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags + ! TODO: private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) @@ -61,6 +62,7 @@ module MOM_tidal_mixing !> Control structure for tidal mixing module. type, public :: tidal_mixing_cs logical :: debug = .true. + ! TODO: private ! Parameters logical :: int_tide_dissipation ! Internal tide conversion (from barotropic) with @@ -128,9 +130,10 @@ module MOM_tidal_mixing real :: min_thickness ! Minimum thickness allowed [m] ! CVMix-specific parameters + integer :: cvmix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -139,7 +142,7 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) + real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -174,12 +177,12 @@ module MOM_tidal_mixing 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" -character*(20), parameter :: SIMMONS_PROFILE_STRING = "SIMMONS" -character*(20), parameter :: SCHMITTNER_PROFILE_STRING = "SCHMITTNER" integer, parameter :: STLAURENT_02 = 1 integer, parameter :: POLZIN_09 = 2 -integer, parameter :: SIMMONS_04 = 3 -integer, parameter :: SCHMITTNER = 4 +character*(20), parameter :: SIMMONS_SCHEME_STRING = "SIMMONS" +character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER" +integer, parameter :: SIMMONS_04 = 1 +integer, parameter :: SCHMITTNER = 2 contains @@ -197,7 +200,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! Local variables logical :: read_tideamp character(len=20) :: tmpstr, int_tide_profile_str - character(len=20) :: default_profile_string, tidal_energy_type + 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 type(vardesc) :: vd @@ -239,40 +242,47 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) if (CS%int_tide_dissipation) then - default_profile_string = STLAURENT_PROFILE_STRING - if (CS%use_cvmix_tidal) default_profile_string = SIMMONS_PROFILE_STRING - call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & - "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& - "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& - "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& - "\t decay profile.\n"//& - "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& - "\t decay profile.", & - default=default_profile_string) - ! TODO: list the newly available profile selections - int_tide_profile_str = uppercase(int_tide_profile_str) - select case (int_tide_profile_str) - case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 - case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 - case (SIMMONS_PROFILE_STRING) ; CS%int_tide_profile = SIMMONS_04 - case (SCHMITTNER_PROFILE_STRING) ; CS%int_tide_profile = SCHMITTNER - case default - call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & - "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") - end select - ! Check profile consistency - if (CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.STLAURENT_02 .or. & - CS%int_tide_profile.eq.POLZIN_09)) then - call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profile"// & - " "//trim(int_tide_profile_str)//" unavailable in CVMix. Available "//& - "profiles in CVMix are "//trim(SIMMONS_PROFILE_STRING)//" and "//& - trim(SCHMITTNER_PROFILE_STRING)//".") - else if (.not.CS%use_cvmix_tidal .and. (CS%int_tide_profile.eq.SIMMONS_04.or. & - CS%int_tide_profile.eq.SCHMITTNER)) then - call MOM_error(FATAL, "tidal_mixing_init: Tidal mixing profiles "// & - trim(SIMMONS_PROFILE_STRING)//" and "//trim(SCHMITTNER_PROFILE_STRING)//& - " are available only when USE_CVMIX_TIDAL is True.") + ! Read in CVMix tidal scheme if CVMix tidal mixing is on + if (CS%use_cvmix_tidal) then + call get_param(param_file, mdl, "CVMIX_TIDAL_SCHEME", cvmix_tidal_scheme_str, & + "CVMIX_TIDAL_SCHEME selects the CVMix tidal mixing\n"//& + "scheme with INT_TIDE_DISSIPATION. Valid values are:\n"//& + "\t SIMMONS - Use the Simmons et al (2004) tidal \n"//& + "\t mixing scheme.\n"//& + "\t SCHMITTNER - Use the Schmittner et al (2014) tidal \n"//& + "\t mixing scheme.", & + default=SIMMONS_SCHEME_STRING) + cvmix_tidal_scheme_str = uppercase(cvmix_tidal_scheme_str) + + select case (cvmix_tidal_scheme_str) + case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS_04 + case (SCHMITTNER_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SCHMITTNER + case default + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define CVMIX_TIDAL_SCHEME "//trim(cvmix_tidal_scheme_str)//" found in input file.") + end select + endif ! CS%use_cvmix_tidal + + ! Read in vertical profile of tidal energy dissipation + if ( CS%cvmix_tidal_scheme.eq.SCHMITTNER .or. .not. CS%use_cvmix_tidal) then + call get_param(param_file, mdl, "INT_TIDE_PROFILE", int_tide_profile_str, & + "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& + "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& + "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& + "\t decay profile.\n"//& + "\t POLZIN_09 - Use the Polzin WKB-streched algebraic \n"//& + "\t decay profile.", & + default=STLAURENT_PROFILE_STRING) + int_tide_profile_str = uppercase(int_tide_profile_str) + + select case (int_tide_profile_str) + case (STLAURENT_PROFILE_STRING) ; CS%int_tide_profile = STLAURENT_02 + case (POLZIN_PROFILE_STRING) ; CS%int_tide_profile = POLZIN_09 + case default + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define INT_TIDE_PROFILE "//trim(int_tide_profile_str)//" found in input file.") + end select endif else if (CS%use_cvmix_tidal) then @@ -317,10 +327,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then - if (CS%use_cvmix_tidal) then - call MOM_error(FATAL, "tidal_mixing_init: Polzin scheme cannot "// & - "be used when CVMix tidal mixing scheme is active.") - end if call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & "When the Polzin decay profile is used, this is a \n"//& "non-dimensional constant in the expression for the \n"//& @@ -489,14 +495,14 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, do_not_log=.true.) call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) - int_tide_profile_str = lowercase(int_tide_profile_str) + cvmix_tidal_scheme_str = lowercase(cvmix_tidal_scheme_str) ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) ! Set up CVMix call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & - mix_scheme = int_tide_profile_str, & + mix_scheme = cvmix_tidal_scheme_str, & efficiency = CS%Mu_itides, & vertical_decay_scale = CS%int_tide_decay_scale, & max_coefficient = CS%tidal_max_coef, & @@ -646,7 +652,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) is = G%isc ; ie = G%iec dd => CS%dd - select case (CS%int_tide_profile) + select case (CS%cvmix_tidal_scheme) case (SIMMONS_04) do i=is,ie @@ -713,8 +719,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! TODO: case (SCHMITTNER) case default - call MOM_error(FATAL, "tidal_mixing_init: The selected"// & - " INT_TIDE_PROFILE is unavailable in CVMix") + call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & + "#define CVMIX_TIDAL_SCHEME found in input file.") end select end subroutine calculate_cvmix_tidal From 60f7d665a6952225a074a58347ad9e7c2700742f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 13 Apr 2018 14:32:56 -0600 Subject: [PATCH 06/53] Initialize visc%Kv_slow and update halos --- src/core/MOM.F90 | 3 +++ src/parameterizations/vertical/MOM_set_viscosity.F90 | 4 +++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 22dbb86b15..cfbb0c101f 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2292,6 +2292,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (associated(CS%visc%Kv_shear)) & call pass_var(CS%visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) + if (associated(CS%visc%Kv_slow)) & + call pass_var(CS%visc%Kv_slow, G%Domain, To_All+Omit_Corners, halo=1) + call cpu_clock_end(id_clock_pass_init) call register_obsolete_diagnostics(param_file, CS%diag) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 3df3e7b780..18eb80f280 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1811,7 +1811,9 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) allocate(visc%Kd_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kd_shear(:,:,:) = 0.0 allocate(visc%TKE_turb(isd:ied,jsd:jed,nz+1)) ; visc%TKE_turb(:,:,:) = 0.0 allocate(visc%Kv_shear(isd:ied,jsd:jed,nz+1)) ; visc%Kv_shear(:,:,:) = 0.0 - allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 + + ! MOM_bkgnd_mixing is always used, so always allocate visc%Kv_slow. GMM + allocate(visc%Kv_slow(isd:ied,jsd:jed,nz+1)) ; visc%Kv_slow(:,:,:) = 0.0 vd = var_desc("Kd_shear","m2 s-1","Shear-driven turbulent diffusivity at interfaces", & hor_grid='h', z_grid='i') From d774e5f05ce348ae388c10304757df6150d76314 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 09:10:19 -0600 Subject: [PATCH 07/53] Add "slow" vertical viscosity in vertvisc_coef --- .../vertical/MOM_vert_friction.F90 | 37 +++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ff14a698ed..5154e92c33 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1134,6 +1134,43 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif endif + ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) + if (associated(visc%Kv_slow)) then + if (work_on_u) then + do K=2,nz ; do i=is,ie ; if (do_i(i)) then + Kv_add(i,K) = Kv_add(i,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(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) = 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) + 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(i,K) = a(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) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(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) = 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) + 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(i,K) = a(i,K) + Kv_add(i,K) + endif ; enddo ; enddo + endif + endif + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom ! boundary layer, going from 1 at the bottom to 0 in the interior. From fd23f9117335d0542312f932e2fc241fbab25058 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:28:19 -0600 Subject: [PATCH 08/53] Set visc%Kv_slow to zero in diabatic --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 70412a716b..8e45d26688 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -378,6 +378,8 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 + ! visc%Kv_slow must be set to zero + visc%Kv_slow(:,:,:) = 0.0 if (nz == 1) return showCallTree = callTree_showQuery() From 1488b78945b2789b79bb6c7d0589e08674f897bd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:29:00 -0600 Subject: [PATCH 09/53] Add option to save Kv_slow and Kv --- .../vertical/MOM_vert_friction.F90 | 46 ++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 5154e92c33..e391780253 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. - +use MOM_domains, only : pass_var use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -116,6 +116,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 + integer :: id_Kv_slow = -1, id_Kv = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -583,6 +584,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v + real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points + real :: av_h !< v-drag coefficient at h-points, in m s-1 + real :: au_h !< u-drag coefficient at h-points, in m s-1 + real :: dh !< average thickness between layers k and k+1, in m or kg m-2. real :: zcol(SZI_(G)) ! The height of an interface at h-points, in 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. @@ -615,6 +620,10 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val + if (CS%id_Kv > 0) then + allocate(Kv_h(SZI_(G), SZJ_(G), SZK_(G)+1)) ; Kv_h(:,:,:) = 0.0 + endif + if (CS%debug .or. (CS%id_hML_u > 0)) then allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 endif @@ -955,6 +964,29 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif enddo ! end of v-point j loop + ! Total Kv at h points + if (CS%id_Kv > 0) then + do j = js, je + do i = is, ie + ! set surface and bottom values to zero + Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 + do k=2,nz + av_h = 0.5 * (CS%a_v(i,J,k) + CS%a_v(i,J+1,k)) + au_h = 0.5 * (CS%a_u(I,J,k) + CS%a_u(I+1,j,k)) + dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) + if (dh .le. h_neglect) then + Kv_h(i,j,k) = 0.0 + else + Kv_h(i,j,k) = sqrt(av_h**2 + au_h**2) * dh + if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 + endif + enddo + enddo + enddo + ! update halos + call pass_var(Kv_h, G%Domain) + endif + 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) @@ -966,6 +998,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) endif ! Offer diagnostic fields for averaging. + if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (CS%id_Kv > 0) call post_data(CS%id_Kv, Kv_h, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1660,17 +1694,27 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & ALLOC_(CS%a_v(isd:ied,JsdB:JedB,nz+1)) ; CS%a_v(:,:,:) = 0.0 ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 + CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & + 'Slow varying vertical viscosity', 'm2 s-1') + + CS%id_Kv = register_diag_field('ocean_model', 'Kv', diag%axesTi, Time, & + 'Total vertical viscosity', 'm2 s-1') + CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') + CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1') CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_h_v = register_diag_field('ocean_model', 'Hv_visc', diag%axesCvL, Time, & 'Thickness at Meridional Velocity Points for Viscosity', thickness_units) + CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', thickness_units) + CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', thickness_units) From 69c2c96f9812d74d43c8da2421c88e3c5eb9d05f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 11:34:39 -0600 Subject: [PATCH 10/53] Remove trailing space --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index a59af01afb..2b3ffb00df 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1127,7 +1127,7 @@ subroutine setup_tidal_diagnostics(G,CS) integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & From d5be1f8c9b0ba118ab9a5e41c8e4fd88148c0cce Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 16 Apr 2018 13:15:56 -0600 Subject: [PATCH 11/53] Attempt to add diag. for total vertical visc. * I believe there is something wrong (halo updates?) with the way this is being done. It needs to be fixed! --- .../vertical/MOM_vert_friction.F90 | 48 ++++++++++--------- 1 file changed, 26 insertions(+), 22 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e391780253..d90748b820 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -2,7 +2,7 @@ module MOM_vert_friction ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_domains, only : pass_var +use MOM_domains, only : pass_var, To_All, Omit_corners use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : diag_ctrl use MOM_debugging, only : uvchksum, hchksum @@ -585,8 +585,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points - real :: av_h !< v-drag coefficient at h-points, in m s-1 - real :: au_h !< u-drag coefficient at h-points, in m s-1 + real, dimension(SZI_(G),SZJ_(G)) :: av_h, & !< v-drag coefficient at h-points, in m s-1 + au_h !< u-drag coefficient at h-points, in m s-1 real :: dh !< average thickness between layers k and k+1, in m or kg m-2. real :: zcol(SZI_(G)) ! The height of an interface at h-points, in m or kg m-2. real :: botfn ! A function which goes from 1 at the bottom to 0 much more @@ -966,25 +966,29 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Total Kv at h points if (CS%id_Kv > 0) then - do j = js, je - do i = is, ie - ! set surface and bottom values to zero - Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 - do k=2,nz - av_h = 0.5 * (CS%a_v(i,J,k) + CS%a_v(i,J+1,k)) - au_h = 0.5 * (CS%a_u(I,J,k) + CS%a_u(I+1,j,k)) - dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) - if (dh .le. h_neglect) then - Kv_h(i,j,k) = 0.0 - else - Kv_h(i,j,k) = sqrt(av_h**2 + au_h**2) * dh - if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 - endif - enddo - enddo - enddo - ! update halos - call pass_var(Kv_h, G%Domain) + !$OMP parallel do default(shared) + do k=2,nz + ! set surface and bottom values to zero + Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 + do j=js,je ; do I=is-1,ie + au_h(I,j) = CS%a_u(I,J,k) + enddo ; enddo + do J=js-1,je ; do i=is,ie + av_h(i,J) = CS%a_v(i,J,k) + enddo ; enddo + do j = js, je; do i = is, ie + dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) + if (dh .le. h_neglect) then + Kv_h(i,j,k) = 0.0 + else + Kv_h(i,j,k) = sqrt((0.5 * (au_h(I,j)+au_h(I-1,j)))**2 + & + (0.5 * (av_h(i,J) + av_h(i,J-1)))**2) * dh + if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 + endif + enddo ; enddo + enddo ! k + ! update halos + call pass_var(Kv_h, G%Domain, To_All+Omit_Corners, halo=1) endif if (CS%debug) then From 20cc62b8ce8787870714a1658efab0df3923bd65 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Apr 2018 13:10:15 -0600 Subject: [PATCH 12/53] add capability to read ER03 energy file --- .../vertical/MOM_tidal_mixing.F90 | 101 ++++++++++++++++-- 1 file changed, 92 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c6d522fa93..e8b383365d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -132,8 +132,9 @@ module MOM_tidal_mixing ! CVMix-specific parameters integer :: cvmix_tidal_scheme = -1 ! 1 for Simmons, 2 for Schmittner type(cvmix_tidal_params_type) :: cvmix_tidal_params - type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only - real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only + real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] + real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -477,6 +478,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, call get_param(param_file, mdl, "TIDAL_MAX_COEF", CS%tidal_max_coef, & "largest acceptable value for tidal diffusivity", & units="m^2/s", default=50e-4) ! the default is 50e-4 in CVMIX, 100e-4 in POP. + call get_param(param_file, mdl, "TIDAL_DISS_LIM_TC", CS%tidal_diss_lim_tc, & + "Min allowable depth for dissipation for tidal-energy-constituent data. \n"//& + "No dissipation contribution is applied above TIDAL_DISS_LIM_TC.", & + units="m", default=0.0) call get_param(param_file, mdl, "TIDAL_ENERGY_FILE",tidal_energy_file, & "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & @@ -1133,7 +1138,7 @@ subroutine setup_tidal_diagnostics(G,CS) integer :: isd, ied, jsd, jed, nz type(tidal_mixing_diags), pointer :: dd - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke + isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = G%ke dd => CS%dd if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_itidal_z > 0) .or. & @@ -1293,23 +1298,101 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) - allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) select case (uppercase(tidal_energy_type(1:4))) - case ('JAYN') ! Jayne 2009 input tidal energy flux + case ('JAYN') ! Jayne 2009 + allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d + deallocate(tidal_energy_flux_2d) + case ('ER03') ! Egbert & Ray 2003 + call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") - ! TODO: add more tidal energy file types, e.g., Arbic, ER03, GN13, LGM0, etc. - ! see POP::tidal_mixing.F90 end select - deallocate(tidal_energy_flux_2d) - end subroutine read_tidal_energy +subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=20), intent(in) :: tidal_energy_type + character(len=200), intent(in) :: tidal_energy_file + type(tidal_mixing_cs), pointer :: CS + + ! local + integer :: k, isd, ied, jsd, jed, nz + real, parameter :: p33 = 1.0/3.0 + real, dimension(SZK_(G)) :: & + z_t, & ! depth from surface to midpoint of input layer + z_w ! depth from surface to top of input layer + real, dimension(SZI_(G),SZJ_(G)) :: & + tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert + tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + real, allocatable, dimension(:,:,:) :: & + tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] + tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] + tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] + tc_o1, & ! input lunar diurnal tidal energy flux [W/m^2] + tidal_qe_3d ! sum_tc(q_tc*TC(x,y,z)) = q*E(x,y,z) + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + + allocate(tc_m2(isd:ied,jsd:jed,nz), & + tc_s2(isd:ied,jsd:jed,nz), & + tc_k1(isd:ied,jsd:jed,nz), & + tc_o1(isd:ied,jsd:jed,nz), & + tidal_qe_3d(isd:ied,jsd:jed,nz) ) + + ! read in tidal constituents + ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) + call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) + call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) + call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) + call MOM_read_data(tidal_energy_file, 'O1', tc_o1, G%domain) + call MOM_read_data(tidal_energy_file, 'z_t', z_t) + call MOM_read_data(tidal_energy_file, 'z_w', z_w) + + ! form tidal_qe_3d from weighted tidal constituents + tidal_qe_3d = 0.0 + + where (abs(G%geoLatT(:,:)) < 30.0) + tidal_qk1(:,:) = p33 + tidal_qo1(:,:) = p33 + elsewhere + tidal_qk1(:,:) = 1.0 + tidal_qo1(:,:) = 1.0 + endwhere + + do k=1,nz + where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) + tidal_qe_3d(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & + tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) + endwhere + enddo + + ! test if qE is positive + if (any(tidal_qe_3d<0)) then + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d terms.") + endif + + ! collapse 3D q*E to 2D q*E + CS%tidal_qe_2d = 0.0 + do k=1,nz + where (z_t(k) <= G%bathyT(:,:)) + CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + tidal_qe_3d(:,:,k) + endwhere + enddo + + deallocate(tc_m2) + deallocate(tc_s2) + deallocate(tc_k1) + deallocate(tc_o1) + deallocate(tidal_qe_3d) + +end subroutine read_tidal_constituents + + !> Clear pointers and deallocate memory subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure From dcfb722cb334d80d47ece603e6725dd3b30f17bd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 13:18:22 -0600 Subject: [PATCH 13/53] Bug fix in MOM_bkgnd_mixing The background vertical diff was being added to itself, which is wrong and was leading to a increase in kd_bkgnd over time. This commit fixes this problem. --- src/parameterizations/vertical/MOM_bkgnd_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 14c6c3412e..2c55f4b1c5 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -408,7 +408,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, kd_lay, kv, j, G, GV, 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) = CS%kd_bkgnd(i,j,k) + 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 From d09e8099f8bef3d7912e525522e17f43b020261d Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 13:20:48 -0600 Subject: [PATCH 14/53] Add option to diagnose Kv at u and v points Total vertical viscosity can now be diagnosed at u and v points. --- .../vertical/MOM_vert_friction.F90 | 66 +++++++++---------- 1 file changed, 30 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index d90748b820..95773908aa 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -116,7 +116,7 @@ module MOM_vert_friction integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_au_vv = -1, id_av_vv = -1 integer :: id_h_u = -1, id_h_v = -1, id_hML_u = -1 , id_hML_v = -1 integer :: id_Ray_u = -1, id_Ray_v = -1, id_taux_bot = -1, id_tauy_bot = -1 - integer :: id_Kv_slow = -1, id_Kv = -1 + integer :: id_Kv_slow = -1, id_Kv_u = -1, id_Kv_v = -1 !>@} type(PointAccel_CS), pointer :: PointAccel_CSp => NULL() @@ -584,10 +584,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! based on harmonic mean thicknesses, in m or kg m-2. h_ml ! The mixed layer depth, in m or kg m-2. real, allocatable, dimension(:,:) :: hML_u, hML_v - real, allocatable, dimension(:,:,:) :: Kv_h !< Total vertical viscosity at h-points - real, dimension(SZI_(G),SZJ_(G)) :: av_h, & !< v-drag coefficient at h-points, in m s-1 - au_h !< u-drag coefficient at h-points, in m s-1 - real :: dh !< average thickness between layers k and k+1, in m or kg m-2. + real, allocatable, dimension(:,:,:) :: Kv_v, & !< Total vertical viscosity at u-points + Kv_u !< Total vertical viscosity at v-points real :: zcol(SZI_(G)) ! The height of an interface at h-points, in 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. @@ -620,8 +618,12 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl * GV%m_to_H + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val - if (CS%id_Kv > 0) then - allocate(Kv_h(SZI_(G), SZJ_(G), SZK_(G)+1)) ; Kv_h(:,:,:) = 0.0 + if (CS%id_Kv_u > 0) then + allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,G%ke)) ; Kv_u(:,:,:) = 0.0 + endif + + if (CS%id_Kv_v > 0) then + allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,G%ke)) ; Kv_v(:,:,:) = 0.0 endif if (CS%debug .or. (CS%id_hML_u > 0)) then @@ -799,6 +801,13 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) ; enddo ; enddo endif + ! Diagnose total Kv at u-points + if (CS%id_Kv_u > 0) then + do k=1,nz ; do I=Isq,Ieq + if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + enddo ; enddo + endif + enddo @@ -962,34 +971,15 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) CS%a_v(i,J,K) = a(i,K) ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) ; enddo ; enddo endif - enddo ! end of v-point j loop - ! Total Kv at h points - if (CS%id_Kv > 0) then - !$OMP parallel do default(shared) - do k=2,nz - ! set surface and bottom values to zero - Kv_h(i,j,1) = 0.0; Kv_h(i,j,nz+1) = 0.0 - do j=js,je ; do I=is-1,ie - au_h(I,j) = CS%a_u(I,J,k) - enddo ; enddo - do J=js-1,je ; do i=is,ie - av_h(i,J) = CS%a_v(i,J,k) + ! Diagnose total Kv at v-points + if (CS%id_Kv_v > 0) then + do k=1,nz ; do i=is,ie + if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo - do j = js, je; do i = is, ie - dh = 0.5 * (h(i,j,K)+h(i,j,K+1)) - if (dh .le. h_neglect) then - Kv_h(i,j,k) = 0.0 - else - Kv_h(i,j,k) = sqrt((0.5 * (au_h(I,j)+au_h(I-1,j)))**2 + & - (0.5 * (av_h(i,J) + av_h(i,J-1)))**2) * dh - if (Kv_h(i,j,k) .lt. 0.0) Kv_h(i,j,k) = 0.0 - endif - enddo ; enddo - enddo ! k - ! update halos - call pass_var(Kv_h, G%Domain, To_All+Omit_Corners, halo=1) - endif + endif + + enddo ! end of v-point j loop if (CS%debug) then call uvchksum("vertvisc_coef h_[uv]", CS%h_u, & @@ -1003,7 +993,8 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, CS, OBC) ! Offer diagnostic fields for averaging. if (CS%id_Kv_slow > 0) call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) - if (CS%id_Kv > 0) call post_data(CS%id_Kv, Kv_h, CS%diag) + if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) + if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) @@ -1701,8 +1692,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & 'Slow varying vertical viscosity', 'm2 s-1') - CS%id_Kv = register_diag_field('ocean_model', 'Kv', diag%axesTi, Time, & - 'Total vertical viscosity', 'm2 s-1') + CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & + 'Total vertical viscosity at u-points', 'm2 s-1') + + CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & + 'Total vertical viscosity at v-points', 'm2 s-1') CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1') From f13294011be66669d5413096057ca0ea67f429be Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 17 Apr 2018 14:52:02 -0600 Subject: [PATCH 15/53] add call to compute_Schmittner_invariant --- .../vertical/MOM_tidal_mixing.F90 | 54 +++++++++++++++++-- 1 file changed, 49 insertions(+), 5 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index e8b383365d..2d8415d162 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -19,6 +19,7 @@ module MOM_tidal_mixing use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -182,7 +183,7 @@ module MOM_tidal_mixing integer, parameter :: POLZIN_09 = 2 character*(20), parameter :: SIMMONS_SCHEME_STRING = "SIMMONS" character*(20), parameter :: SCHMITTNER_SCHEME_STRING = "SCHMITTNER" -integer, parameter :: SIMMONS_04 = 1 +integer, parameter :: SIMMONS = 1 integer, parameter :: SCHMITTNER = 2 contains @@ -257,7 +258,7 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, cvmix_tidal_scheme_str = uppercase(cvmix_tidal_scheme_str) select case (cvmix_tidal_scheme_str) - case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS_04 + case (SIMMONS_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SIMMONS case (SCHMITTNER_SCHEME_STRING) ; CS%cvmix_tidal_scheme = SCHMITTNER case default call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & @@ -646,9 +647,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! local 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) :: vert_dep !< vertical deposition needed for Simmons tidal mixing. + real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + + real, allocatable, dimension(:,:) :: exp_hab_zetar + integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) @@ -658,7 +662,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) dd => CS%dd select case (CS%cvmix_tidal_scheme) - case (SIMMONS_04) + case (SIMMONS) do i=is,ie if (G%mask2dT(i,j)<1) cycle @@ -722,7 +726,47 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) enddo ! i=is,ie - ! TODO: case (SCHMITTNER) + case (SCHMITTNER) + + allocate(exp_hab_zetar(G%ke+1,G%ke+1)) + + do i=is,ie + + if (G%mask2dT(i,j)<1) cycle + + iFaceHeight = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + do k=1,G%ke + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + ! form the time-invariant part of Schmittner coefficient term + call cvmix_compute_Schmittner_invariant(nlev = G%ke, & + VertDep = vert_dep, & + rho = rho_fw, & + exp_hab_zetar = exp_hab_zetar, & + zw = iFaceHeight, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + ! form the Schmittner coefficient that is based on 3D q*E, which is formed from + ! summing q_i*TidalConstituent_i over the number of constituents. + !call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + ! energy_flux = , & + ! rho = rho_fw, & + ! SchmittnerCoeff = , & + ! exp_hab_zetar = , & + ! CVmix_tidal_params_user = CS%cvmix_tidal_params) + + enddo ! i=is,ie + + deallocate(exp_hab_zetar) + case default call MOM_error(FATAL, "tidal_mixing_init: Unrecognized setting "// & "#define CVMIX_TIDAL_SCHEME found in input file.") From 901c3016270f60a77b25e0001513e5aea8cd9569 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:16:19 -0600 Subject: [PATCH 16/53] Add option to post diags for bkgnd_mixing --- .../vertical/MOM_set_diffusivity.F90 | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index a1f10519e6..7f192d65d9 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -512,12 +512,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - ! send bkgnd_mixing diagnostics to post_data - if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & - call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%Kd_add > 0.0) then if (present(Kd_int)) then !$OMP parallel do default(none) shared(is,ie,js,je,nz,Kd_int,CS,Kd) @@ -538,7 +532,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & T_f, S_f, dd%Kd_user) endif - ! GMM, post diags... + ! post diagnostics + if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & + call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) num_z_diags = 0 From a0358fbbaf7044ac5526f6dad8a054fa69e910bb Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:52:26 -0600 Subject: [PATCH 17/53] Fix bug in MOM_cvmix_conv --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 55e7d55d6e..956d0c0de3 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -212,6 +212,7 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo + ! gets index of the level and interface above hbl kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) call cvmix_coeffs_conv(Mdiff_out=CS%kv_conv(i,j,:), & @@ -224,7 +225,7 @@ subroutine calculate_cvmix_conv(h, tv, G, GV, CS, hbl) OBL_ind=kOBL) ! Do not apply mixing due to convection within the boundary layer - do k=1,NINT(hbl(i,j)) + do k=1,kOBL CS%kv_conv(i,j,k) = 0.0 CS%kd_conv(i,j,k) = 0.0 enddo From 9d6cb46774e83f8eaf2616771c9a70ef5713fa88 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 17 Apr 2018 16:54:55 -0600 Subject: [PATCH 18/53] Rename variable in register_diag_field Variable names are now consistent with what is used in other modules. --- src/parameterizations/vertical/MOM_cvmix_conv.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_cvmix_conv.F90 b/src/parameterizations/vertical/MOM_cvmix_conv.F90 index 956d0c0de3..b385880d7a 100644 --- a/src/parameterizations/vertical/MOM_cvmix_conv.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_conv.F90 @@ -128,11 +128,11 @@ logical function cvmix_conv_init(Time, G, GV, param_file, diag, CS) ! Register diagnostics CS%diag => diag - CS%id_N2 = register_diag_field('ocean_model', 'conv_N2', diag%axesTi, Time, & + 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', 'conv_kd', diag%axesTi, Time, & + CS%id_kd_conv = register_diag_field('ocean_model', 'kd_conv', diag%axesTi, Time, & 'Additional diffusivity added by MOM_cvmix_conv module', 'm2/s') - CS%id_kv_conv = register_diag_field('ocean_model', 'conv_kv', diag%axesTi, Time, & + CS%id_kv_conv = register_diag_field('ocean_model', 'kv_conv', diag%axesTi, Time, & 'Additional viscosity added by MOM_cvmix_conv module', 'm2/s') call cvmix_init_conv(convect_diff=CS%kd_conv_const, & From 78656bbb545f01cd0a2d71af95ec7072ffea89f7 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:49:47 -0600 Subject: [PATCH 19/53] Add missing halo update for visc%Kv_slow --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 8e45d26688..eea1eba16a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1372,6 +1372,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! 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) + 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) if (.not. CS%useALEalgorithm) then From 3385857b6fe19e7c7e35a0370914cdc339c131fa Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:55:22 -0600 Subject: [PATCH 20/53] Initialize Kd, Kd_int and Kv_slow using interior values specified by user --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 7f192d65d9..b9905977d5 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -276,6 +276,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") + ! Set Kd, Kd_int and Kv_slow to constant values. + ! If nothing else is specified, this will be the value used. + Kd(:,:,:) = CS%Kd + Kd_int(:,:,:) = CS%Kd + visc%Kv_slow(:,:,:) = CS%Kv + ! Set up arrays for diagnostics. if ((CS%id_N2 > 0) .or. (CS%id_N2_z > 0)) then From 191b5be35ca028a2aa0608f9202048c5a4a22ca3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 19 Apr 2018 08:56:19 -0600 Subject: [PATCH 21/53] Add a factor of 2 when adding Kv_slow into Kv_add --- .../vertical/MOM_vert_friction.F90 | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 95773908aa..973f256915 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1165,16 +1165,17 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) if (associated(visc%Kv_slow)) then + ! GMM/ A factor of 2 is also needed here, see comment above from BGR. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 0.5 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(i+1,j,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0 * (visc%Kv_slow(i,j,k) + visc%Kv_slow(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) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * 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) + visc%Kv_slow(i+1,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i+1,j,k) ; enddo endif endif ; enddo endif @@ -1183,14 +1184,14 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_add(i,K) = Kv_add(i,K) + 0.5*(visc%Kv_slow(i,j,k) + visc%Kv_slow(i,j+1,k)) + Kv_add(i,K) = Kv_add(i,K) + 1.0*(visc%Kv_slow(i,j,k) + visc%Kv_slow(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) = Kv_add(i,K) + visc%Kv_slow(i,j,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * 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) + visc%Kv_slow(i,j+1,k) ; enddo + do K=2,nz ; Kv_add(i,K) = Kv_add(i,K) + 2. * visc%Kv_slow(i,j+1,k) ; enddo endif endif ; enddo endif From 0e4dce5cd3feed3298ae85663bdbfe147dd35f0a Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 19 Apr 2018 10:00:09 -0600 Subject: [PATCH 22/53] add cvmix_compute_SchmittnerCoeff --- .../vertical/MOM_tidal_mixing.F90 | 81 ++++++++++--------- 1 file changed, 45 insertions(+), 36 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 2d8415d162..26d0bb3584 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -19,7 +19,7 @@ module MOM_tidal_mixing use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type -use cvmix_tidal, only : cvmix_compute_Schmittner_invariant +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -138,13 +138,14 @@ module MOM_tidal_mixing real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data ! Data containers - real, pointer, dimension(:,:) :: TKE_Niku => NULL() - real, pointer, dimension(:,:) :: TKE_itidal => NULL() - real, pointer, dimension(:,:) :: Nb => NULL() - real, pointer, dimension(:,:) :: mask_itidal => NULL() - real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, pointer, dimension(:,:) :: TKE_Niku => NULL() + real, pointer, dimension(:,:) :: TKE_itidal => NULL() + real, pointer, dimension(:,:) :: Nb => NULL() + real, pointer, dimension(:,:) :: mask_itidal => NULL() + real, pointer, dimension(:,:) :: h2 => NULL() + real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) + real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! TODO: make this E(x,y) only ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -243,6 +244,11 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=CS%use_cvmix_tidal) + + ! check if tidal mixing is active + tidal_mixing_init = CS%int_tide_dissipation + if (.not. tidal_mixing_init) return + if (CS%int_tide_dissipation) then ! Read in CVMix tidal scheme if CVMix tidal mixing is on @@ -651,6 +657,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) + real, allocatable, dimension(:) :: Schmittner_coeff real, allocatable, dimension(:,:) :: exp_hab_zetar integer :: i, k, is, ie @@ -728,7 +735,11 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) case (SCHMITTNER) + ! TODO: correct exp_hab_zetar shapes in cvmix_compute_Schmittner_invariant + ! and cvmix_compute_SchmittnerCoeff low subroutines + allocate(exp_hab_zetar(G%ke+1,G%ke+1)) + allocate(Schmittner_coeff(G%ke)) do i=is,ie @@ -756,12 +767,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. - !call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - ! energy_flux = , & - ! rho = rho_fw, & - ! SchmittnerCoeff = , & - ! exp_hab_zetar = , & - ! CVmix_tidal_params_user = CS%cvmix_tidal_params) + call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + energy_flux = CS%tidal_qe_3d_in(i,j,:), & ! todo!!!: vertical interpolation + rho = rho_fw, & + SchmittnerCoeff = Schmittner_coeff, & + exp_hab_zetar = exp_hab_zetar, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) enddo ! i=is,ie @@ -1336,20 +1347,20 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) character(len=200), intent(in) :: tidal_energy_file type(tidal_mixing_cs), pointer :: CS ! local - integer :: isd, ied, jsd, jed + integer :: isd, ied, jsd, jed, nz real, allocatable, dimension(:,:) :: tidal_energy_flux_2d ! input tidal energy flux at T-grid points (W/m^2) - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - - if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke select case (uppercase(tidal_energy_type(1:4))) case ('JAYN') ! Jayne 2009 + if (.not. allocated(CS%tidal_qe_2d)) allocate(CS%tidal_qe_2d(isd:ied,jsd:jed)) allocate(tidal_energy_flux_2d(isd:ied,jsd:jed)) call MOM_read_data(tidal_energy_file,'wave_dissipation',tidal_energy_flux_2d, G%domain) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") @@ -1377,16 +1388,14 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] - tc_o1, & ! input lunar diurnal tidal energy flux [W/m^2] - tidal_qe_3d ! sum_tc(q_tc*TC(x,y,z)) = q*E(x,y,z) + tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke allocate(tc_m2(isd:ied,jsd:jed,nz), & tc_s2(isd:ied,jsd:jed,nz), & tc_k1(isd:ied,jsd:jed,nz), & - tc_o1(isd:ied,jsd:jed,nz), & - tidal_qe_3d(isd:ied,jsd:jed,nz) ) + tc_o1(isd:ied,jsd:jed,nz) ) ! read in tidal constituents ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) @@ -1397,8 +1406,8 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - ! form tidal_qe_3d from weighted tidal constituents - tidal_qe_3d = 0.0 + ! form tidal_qe_3d_in from weighted tidal constituents + CS%tidal_qe_3d_in = 0.0 where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 @@ -1410,29 +1419,28 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) do k=1,nz where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) - tidal_qe_3d(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & + CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere enddo ! test if qE is positive - if (any(tidal_qe_3d<0)) then - call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d terms.") + if (any(CS%tidal_qe_3d_in<0)) then + call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif - ! collapse 3D q*E to 2D q*E - CS%tidal_qe_2d = 0.0 - do k=1,nz - where (z_t(k) <= G%bathyT(:,:)) - CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + tidal_qe_3d(:,:,k) - endwhere - enddo + !! collapse 3D q*E to 2D q*E + !CS%tidal_qe_2d = 0.0 + !do k=1,nz + ! where (z_t(k) <= G%bathyT(:,:)) + ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) + ! endwhere + !enddo deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) deallocate(tc_o1) - deallocate(tidal_qe_3d) end subroutine read_tidal_constituents @@ -1442,7 +1450,8 @@ subroutine tidal_mixing_end(CS) type(tidal_mixing_cs), pointer :: CS ! This module's control structure !TODO deallocate all the dynamically allocated members here ... - if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) + if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) + if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) deallocate(CS%dd) deallocate(CS) From 9703e7c55d370bf16defdb9f70b3126ff262f96d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 19 Apr 2018 18:16:41 -0600 Subject: [PATCH 23/53] remap tidal energy from input coord to model coord --- .../vertical/MOM_tidal_mixing.F90 | 89 ++++++++++++------- 1 file changed, 57 insertions(+), 32 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 4066f71c17..8ca8ecfffb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -3,25 +3,26 @@ module MOM_tidal_mixing ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field -use MOM_diag_mediator, only : safe_alloc_ptr, post_data -use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag -use MOM_diag_to_Z, only : calc_Zint_diags -use MOM_EOS, only : calculate_density -use MOM_variables, only : thermo_var_ptrs, p3d -use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE -use MOM_debugging, only : hchksum -use MOM_grid, only : ocean_grid_type -use MOM_verticalGrid, only : verticalGrid_type -use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_string_functions, only : uppercase, lowercase -use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc -use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant -use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type -use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff -use cvmix_kinds_and_types, only : cvmix_global_params_type -use cvmix_put_get, only : cvmix_put +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : safe_alloc_ptr, post_data +use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag +use MOM_diag_to_Z, only : calc_Zint_diags +use MOM_EOS, only : calculate_density +use MOM_variables, only : thermo_var_ptrs, p3d +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_remapping, only : remapping_CS, initialize_remapping, remapping_core_h +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type +use MOM_string_functions, only : uppercase, lowercase +use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc +use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant +use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type +use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff +use cvmix_kinds_and_types, only : cvmix_global_params_type +use cvmix_put_get, only : cvmix_put implicit none ; private @@ -136,6 +137,7 @@ module MOM_tidal_mixing type(cvmix_global_params_type) :: cvmix_glb_params ! for Prandtl number only real :: tidal_max_coef ! maximum allowable tidal diffusivity. [m^2/s] real :: tidal_diss_lim_tc ! dissipation limit for tidal-energy-constituent data + type(remapping_CS) :: remap_cs ! Data containers real, pointer, dimension(:,:) :: TKE_Niku => NULL() @@ -144,8 +146,9 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only - real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable, dimension(:) :: h_src ! tidal constituent input layer thickness + real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only + real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) ! Diagnostics type(diag_ctrl), pointer :: diag => NULL() ! structure to regulate diagn output timing @@ -660,13 +663,15 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: vert_dep !< vertical deposition real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) - - real, allocatable, dimension(:) :: Schmittner_coeff + real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates + real, dimension(SZK_(G)) :: Schmittner_coeff + real, dimension(SZK_(G)) :: h_m !< Cell thickness [m] real, allocatable, dimension(:,:) :: exp_hab_zetar integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + real :: h_neglect, h_neglect_edge type(tidal_mixing_diags), pointer :: dd is = G%isc ; ie = G%iec @@ -743,7 +748,12 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! and cvmix_compute_SchmittnerCoeff low subroutines allocate(exp_hab_zetar(G%ke+1,G%ke+1)) - allocate(Schmittner_coeff(G%ke)) + if (GV%Boussinesq) then + h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 + else + h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 + endif + do i=is,ie @@ -751,9 +761,10 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight = 0.0 ! BBL is all relative to the surface hcorr = 0.0 + h_m = h(i,j,:)*GV%H_to_m do k=1,G%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = h_m(k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -769,10 +780,14 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) zw = iFaceHeight, & CVmix_tidal_params_user = CS%cvmix_tidal_params) + ! remap from input z coordinate to model coordinate: + tidal_qe_md = 0.0 + call remapping_core_h(CS%remap_cs, G%ke, CS%h_src, CS%tidal_qe_3d_in(i,j,:), G%ke, h_m, tidal_qe_md) + ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - energy_flux = CS%tidal_qe_3d_in(i,j,:), & ! todo!!!: vertical interpolation + energy_flux = tidal_qe_md(:), & rho = rho_fw, & SchmittnerCoeff = Schmittner_coeff, & exp_hab_zetar = exp_hab_zetar, & @@ -1364,7 +1379,6 @@ subroutine read_tidal_energy(G, tidal_energy_type, tidal_energy_file, CS) CS%tidal_qe_2d = (CS%Gamma_itides) * tidal_energy_flux_2d deallocate(tidal_energy_flux_2d) case ('ER03') ! Egbert & Ray 2003 - if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) call read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) case default call MOM_error(FATAL, "read_tidal_energy: Unknown tidal energy file type.") @@ -1383,8 +1397,8 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) integer :: k, isd, ied, jsd, jed, nz real, parameter :: p33 = 1.0/3.0 real, dimension(SZK_(G)) :: & - z_t, & ! depth from surface to midpoint of input layer - z_w ! depth from surface to top of input layer + z_t, & ! depth from surface to midpoint of input layer [cm] + z_w ! depth from surface to top of input layer [cm] real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert @@ -1396,13 +1410,17 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + ! allocate CS variables associated with 3d tidal energy dissipation + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) + if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz)) + + ! allocate local variables allocate(tc_m2(isd:ied,jsd:jed,nz), & tc_s2(isd:ied,jsd:jed,nz), & tc_k1(isd:ied,jsd:jed,nz), & tc_o1(isd:ied,jsd:jed,nz) ) ! read in tidal constituents - ! (NOTE: input z coordinates may differ from the model coordinates, which is fine.) call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) call MOM_read_data(tidal_energy_file, 'S2', tc_s2, G%domain) call MOM_read_data(tidal_energy_file, 'K1', tc_k1, G%domain) @@ -1410,8 +1428,6 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - ! form tidal_qe_3d_in from weighted tidal constituents - CS%tidal_qe_3d_in = 0.0 where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 @@ -1421,7 +1437,11 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) tidal_qo1(:,:) = 1.0 endwhere + CS%tidal_qe_3d_in = 0.0 do k=1,nz + ! input cell thickness + CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 + ! form tidal_qe_3d_in from weighted tidal constituents where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) @@ -1441,6 +1461,10 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) ! endwhere !enddo + ! initialize input remapping: + call initialize_remapping(CS%remap_cs, remapping_scheme="PPM_IH4", & + boundary_extrapolation=.false., check_remapping=CS%debug) + deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) @@ -1456,6 +1480,7 @@ subroutine tidal_mixing_end(CS) !TODO deallocate all the dynamically allocated members here ... if (allocated(CS%tidal_qe_2d)) deallocate(CS%tidal_qe_2d) if (allocated(CS%tidal_qe_3d_in)) deallocate(CS%tidal_qe_3d_in) + if (allocated(CS%h_src)) deallocate(CS%h_src) deallocate(CS%dd) deallocate(CS) From 93f242f69f1221bd6fb22065f94de036232d41b6 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 24 Apr 2018 13:57:25 -0600 Subject: [PATCH 24/53] call cvmix_coeffs_tidal_schmittner --- .../vertical/MOM_tidal_mixing.F90 | 29 +++++++++++++++---- 1 file changed, 23 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 8ca8ecfffb..ae958a02ed 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -21,6 +21,7 @@ module MOM_tidal_mixing use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff +use cvmix_tidal, only : cvmix_coeffs_tidal_schmittner use cvmix_kinds_and_types, only : cvmix_global_params_type use cvmix_put_get, only : cvmix_put @@ -36,7 +37,7 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags - ! TODO: private + private real, pointer, dimension(:,:,:) :: & Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) @@ -662,6 +663,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] 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 real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates real, dimension(SZK_(G)) :: Schmittner_coeff @@ -772,6 +774,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo + SchmittnerSocn = 0.0 ! TODO: compute this + ! form the time-invariant part of Schmittner coefficient term call cvmix_compute_Schmittner_invariant(nlev = G%ke, & VertDep = vert_dep, & @@ -786,11 +790,24 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. - call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & - energy_flux = tidal_qe_md(:), & - rho = rho_fw, & - SchmittnerCoeff = Schmittner_coeff, & - exp_hab_zetar = exp_hab_zetar, & + call cvmix_compute_SchmittnerCoeff( nlev = G%ke, & + energy_flux = tidal_qe_md(:), & + rho = rho_fw, & + SchmittnerCoeff = Schmittner_coeff, & + exp_hab_zetar = exp_hab_zetar, & + CVmix_tidal_params_user = CS%cvmix_tidal_params) + + + call cvmix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & + Tdiff_out = Kd_tidal, & + Nsqr = N2_int(i,:), & + OceanDepth = -iFaceHeight(G%ke+1), & + vert_dep = vert_dep, & + nlev = G%ke, & + max_nlev = G%ke, & + SchmittnerCoeff = Schmittner_coeff, & + SchmittnerSouthernOcean = SchmittnerSocn, & + CVmix_params = CS%cvmix_glb_params, & CVmix_tidal_params_user = CS%cvmix_tidal_params) enddo ! i=is,ie From c04f455a153947dd4a9a14448e41e3293ee9810e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 26 Apr 2018 17:03:16 -0600 Subject: [PATCH 25/53] add diagnostics for schmittner --- .../vertical/MOM_tidal_mixing.F90 | 74 ++++++++++++++----- 1 file changed, 54 insertions(+), 20 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index ae958a02ed..c0dd6e1796 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -39,18 +39,19 @@ module MOM_tidal_mixing type, public :: tidal_mixing_diags private real, pointer, dimension(:,:,:) :: & - Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) - Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) - Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces - ! due to propagating low modes (m2/s) (BDM) - Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation - ! due to propagating low modes (m3/s3) (BDM) - Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) - Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) - Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) - Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM - N2_int => NULL(),& - vert_dep_3d => NULL() + Kd_itidal => NULL(),& ! internal tide diffusivity at interfaces (m2/s) + Fl_itidal => NULL(),& ! vertical flux of tidal turbulent dissipation (m3/s3) + Kd_lowmode => NULL(),& ! internal tide diffusivity at interfaces + ! due to propagating low modes (m2/s) (BDM) + Fl_lowmode => NULL(),& ! vertical flux of tidal turbulent dissipation + ! due to propagating low modes (m3/s3) (BDM) + Kd_Niku => NULL(),& ! lee-wave diffusivity at interfaces (m2/s) + Kd_Niku_work => NULL(),& ! layer integrated work by lee-wave driven mixing (W/m2) + Kd_Itidal_Work => NULL(),& ! layer integrated work by int tide driven mixing (W/m2) + Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM + N2_int => NULL(),& + vert_dep_3d => NULL(),& + Schmittner_coeff_3d => NULL() real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) @@ -177,6 +178,7 @@ module MOM_tidal_mixing integer :: id_Polzin_decay_scale_scaled = -1 integer :: id_N2_int = -1 integer :: id_Simmons_coeff = -1 + integer :: id_Schmittner_coeff = -1 integer :: id_vert_dep = -1 end type tidal_mixing_cs @@ -501,11 +503,6 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, "The path to the file containing tidal energy \n"//& "dissipation. Used with CVMix tidal mixing schemes.", & fail_if_missing=.true.) - tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) - call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & - "The type of input tidal energy flux dataset.",& - fail_if_missing=.true.) - ! TODO: list all available tidal energy types here call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, & do_not_log=.True.) call get_param(param_file, mdl, "PRANDTL_TIDAL", prandtl_tidal, & @@ -515,11 +512,22 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, do_not_log=.true.) call cvmix_put(CS%cvmix_glb_params,'Prandtl',prandtl_tidal) + tidal_energy_file = trim(CS%inputdir) // trim(tidal_energy_file) + call get_param(param_file, mdl, "TIDAL_ENERGY_TYPE",tidal_energy_type, & + "The type of input tidal energy flux dataset. Valid values are"//& + "\t Jayne\n"//& + "\t ER03 \n",& + fail_if_missing=.true.) + ! Check whether tidal energy input format and CVMix tidal mixing scheme are consistent + if ( .not. ( & + (uppercase(tidal_energy_type(1:4)).eq.'JAYN' .and. CS%cvmix_tidal_scheme.eq.SIMMONS).or. & + (uppercase(tidal_energy_type(1:4)).eq.'ER03' .and. CS%cvmix_tidal_scheme.eq.SCHMITTNER) ) )then + call MOM_error(FATAL, "tidal_mixing_init: Tidal energy file type ("//& + trim(tidal_energy_type)//") is incompatible with CVMix tidal "//& + " mixing scheme: "//trim(cvmix_tidal_scheme_str) ) + endif cvmix_tidal_scheme_str = lowercase(cvmix_tidal_scheme_str) - - ! TODO: check parameter consistency. (see POP::tidal_mixing.F90::tidal_check) - ! Set up CVMix call cvmix_init_tidal(CVmix_tidal_params_user = CS%cvmix_tidal_params, & mix_scheme = cvmix_tidal_scheme_str, & @@ -549,6 +557,8 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: add units CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') + CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTi,Time, & + 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') @@ -810,6 +820,25 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) CVmix_params = CS%cvmix_glb_params, & CVmix_tidal_params_user = CS%cvmix_tidal_params) + do k=1,G%ke + Kd(i,j,k) = Kd(i,j,k) + 0.5*(Kd_tidal(k) + Kd_tidal(k+1) ) + !TODO: Kv(i,j,k) = ???????????? + enddo + + ! diagnostics + ! diagnostics + if (associated(dd%Kd_itidal)) then + dd%Kd_itidal(i,j,:) = Kd_tidal(:) + endif + if (associated(dd%N2_int)) then + dd%N2_int(i,j,:) = N2_int(i,:) + endif + if (associated(dd%Schmittner_coeff_3d)) then + dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) + endif + if (associated(dd%vert_dep_3d)) then + dd%vert_dep_3d(i,j,:) = vert_dep(:) + endif enddo ! i=is,ie deallocate(exp_hab_zetar) @@ -1288,6 +1317,9 @@ subroutine setup_tidal_diagnostics(G,CS) if (CS%id_vert_dep > 0) then allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 endif + if (CS%id_Schmittner_coeff > 0) then + allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 + endif end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G,GV,h,CS) @@ -1322,6 +1354,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (CS%id_N2_int> 0) call post_data(CS%id_N2_int, dd%N2_int, CS%diag) if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) + if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) @@ -1373,6 +1406,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (associated(dd%N2_int)) deallocate(dd%N2_int) if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) + if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) end subroutine post_tidal_diagnostics From 05a2e5985425c7bccdf406786c0094525e0a7f2b Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 2 May 2018 14:53:02 -0600 Subject: [PATCH 26/53] debug 3d tidal energy remapping --- .../vertical/MOM_tidal_mixing.F90 | 101 +++++++++++++----- 1 file changed, 73 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index c0dd6e1796..37b187878d 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -17,7 +17,7 @@ module MOM_tidal_mixing use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_string_functions, only : uppercase, lowercase -use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc +use MOM_io, only : slasher, MOM_read_data, vardesc, var_desc, field_size use cvmix_tidal, only : cvmix_init_tidal, cvmix_compute_Simmons_invariant use cvmix_tidal, only : cvmix_coeffs_tidal, cvmix_tidal_params_type use cvmix_tidal, only : cvmix_compute_Schmittner_invariant, cvmix_compute_SchmittnerCoeff @@ -51,7 +51,8 @@ module MOM_tidal_mixing Kd_Lowmode_Work => NULL(),& ! layer integrated work by low mode driven mixing (W/m2) BDM N2_int => NULL(),& vert_dep_3d => NULL(),& - Schmittner_coeff_3d => NULL() + Schmittner_coeff_3d => NULL(),& + tidal_qe_md => NULL() real, pointer, dimension(:,:) :: & TKE_itidal_used => NULL(),& ! internal tide TKE input at ocean bottom (W/m2) @@ -147,8 +148,8 @@ module MOM_tidal_mixing real, pointer, dimension(:,:) :: Nb => NULL() real, pointer, dimension(:,:) :: mask_itidal => NULL() real, pointer, dimension(:,:) :: h2 => NULL() - real, pointer, dimension(:,:) :: tideamp => NULL() ! RMS tidal amplitude (m/s) - real, allocatable, dimension(:) :: h_src ! tidal constituent input layer thickness + real, pointer, dimension(:,:) :: tideamp => NULL() !< RMS tidal amplitude [m/s] + real, allocatable, dimension(:) :: h_src !< tidal constituent input layer thickness [m] real, allocatable ,dimension(:,:) :: tidal_qe_2d ! q*E(x,y) ! TODO: make this E(x,y) only real, allocatable ,dimension(:,:,:) :: tidal_qe_3d_in ! q*E(x,y) @@ -179,6 +180,7 @@ module MOM_tidal_mixing integer :: id_N2_int = -1 integer :: id_Simmons_coeff = -1 integer :: id_Schmittner_coeff = -1 + integer :: id_tidal_qe_md = -1 integer :: id_vert_dep = -1 end type tidal_mixing_cs @@ -557,8 +559,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, ! TODO: add units CS%id_Simmons_coeff = register_diag_field('ocean_model','Simmons_coeff',diag%axesT1,Time, & 'time-invariant portion of the tidal mixing coefficient using the Simmons', '') - CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTi,Time, & + CS%id_Schmittner_coeff = register_diag_field('ocean_model','Schmittner_coeff',diag%axesTL,Time, & 'time-invariant portion of the tidal mixing coefficient using the Schmittner', '') + CS%id_tidal_qe_md = register_diag_field('ocean_model','tidal_qe_md',diag%axesTL,Time, & + 'input tidal energy dissipated locally interpolated to model vertical coordinates', '') CS%id_vert_dep = register_diag_field('ocean_model','vert_dep',diag%axesTi,Time, & 'vertical deposition function needed for Simmons et al tidal mixing', '') @@ -673,7 +677,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)+1) :: Kv_tidal !< tidal viscosity [m2/s] 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 + real, dimension(SZK_(G)+1) :: SchmittnerSocn real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) real, dimension(SZK_(G)) :: tidal_qe_md !< Tidal dissipation energy interpolated from 3d input to model coordinates real, dimension(SZK_(G)) :: Schmittner_coeff @@ -796,7 +800,8 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 - call remapping_core_h(CS%remap_cs, G%ke, CS%h_src, CS%tidal_qe_3d_in(i,j,:), G%ke, h_m, tidal_qe_md) + call remapping_core_h(CS%remap_cs, size(CS%h_src), CS%h_src, CS%tidal_qe_3d_in(i,j,:), & + G%ke, h_m, tidal_qe_md) ! form the Schmittner coefficient that is based on 3D q*E, which is formed from ! summing q_i*TidalConstituent_i over the number of constituents. @@ -811,7 +816,7 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) call cvmix_coeffs_tidal_schmittner( Mdiff_out = Kv_tidal, & Tdiff_out = Kd_tidal, & Nsqr = N2_int(i,:), & - OceanDepth = -iFaceHeight(G%ke+1), & + OceanDepth = -iFaceHeight(G%ke+1), & vert_dep = vert_dep, & nlev = G%ke, & max_nlev = G%ke, & @@ -825,7 +830,6 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) !TODO: Kv(i,j,k) = ???????????? enddo - ! diagnostics ! diagnostics if (associated(dd%Kd_itidal)) then dd%Kd_itidal(i,j,:) = Kd_tidal(:) @@ -836,6 +840,9 @@ subroutine calculate_cvmix_tidal(h, j, G, GV, CS, N2_int, Kd) if (associated(dd%Schmittner_coeff_3d)) then dd%Schmittner_coeff_3d(i,j,:) = Schmittner_coeff(:) endif + if (associated(dd%tidal_qe_md)) then + dd%tidal_qe_md(i,j,:) = tidal_qe_md(:) + endif if (associated(dd%vert_dep_3d)) then dd%vert_dep_3d(i,j,:) = vert_dep(:) endif @@ -1312,14 +1319,29 @@ subroutine setup_tidal_diagnostics(G,CS) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 endif if (CS%id_Simmons_coeff > 0) then + if (CS%cvmix_tidal_scheme .ne. SIMMONS) then + call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& + "only when cvmix_tidal_scheme is Simmons") + endif allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 endif if (CS%id_vert_dep > 0) then allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 endif if (CS%id_Schmittner_coeff > 0) then + if (CS%cvmix_tidal_scheme .ne. SCHMITTNER) then + call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& + "only when cvmix_tidal_scheme is Schmittner.") + endif allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 endif + if (CS%id_tidal_qe_md > 0) then + if (CS%cvmix_tidal_scheme .ne. SCHMITTNER) then + call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& + "only when cvmix_tidal_scheme is Schmittner.") + endif + allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz)) ; dd%tidal_qe_md(:,:,:) = 0.0 + endif end subroutine setup_tidal_diagnostics subroutine post_tidal_diagnostics(G,GV,h,CS) @@ -1355,6 +1377,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (CS%id_vert_dep> 0) call post_data(CS%id_vert_dep, dd%vert_dep_3d, CS%diag) if (CS%id_Simmons_coeff> 0) call post_data(CS%id_Simmons_coeff, dd%Simmons_coeff_2d, CS%diag) if (CS%id_Schmittner_coeff> 0) call post_data(CS%id_Schmittner_coeff, dd%Schmittner_coeff_3d, CS%diag) + if (CS%id_tidal_qe_md> 0) call post_data(CS%id_tidal_qe_md, dd%tidal_qe_md, CS%diag) if (CS%id_Kd_Itidal_Work > 0) & call post_data(CS%id_Kd_Itidal_Work, dd%Kd_Itidal_Work, CS%diag) @@ -1407,6 +1430,7 @@ subroutine post_tidal_diagnostics(G,GV,h,CS) if (associated(dd%vert_dep_3d)) deallocate(dd%vert_dep_3d) if (associated(dd%Simmons_coeff_2d)) deallocate(dd%Simmons_coeff_2d) if (associated(dd%Schmittner_coeff_3d)) deallocate(dd%Schmittner_coeff_3d) + if (associated(dd%tidal_qe_md)) deallocate(dd%tidal_qe_md) end subroutine post_tidal_diagnostics @@ -1445,31 +1469,36 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) type(tidal_mixing_cs), pointer :: CS ! local - integer :: k, isd, ied, jsd, jed, nz - real, parameter :: p33 = 1.0/3.0 - real, dimension(SZK_(G)) :: & - z_t, & ! depth from surface to midpoint of input layer [cm] - z_w ! depth from surface to top of input layer [cm] + integer :: k, isd, ied, jsd, jed, i,j + integer, dimension(4) :: nz_in + real, parameter :: p33 = 1.0/3.0 real, dimension(SZI_(G),SZJ_(G)) :: & tidal_qk1, & ! qk1 coefficient used in Schmittner & Egbert tidal_qo1 ! qo1 coefficient used in Schmittner & Egbert + real, allocatable, dimension(:) :: & + z_t, & ! depth from surface to midpoint of input layer [cm] + z_w ! depth from surface to top of input layer [cm] real, allocatable, dimension(:,:,:) :: & tc_m2, & ! input lunar semidiurnal tidal energy flux [W/m^2] tc_s2, & ! input solar semidiurnal tidal energy flux [W/m^2] tc_k1, & ! input lunar diurnal tidal energy flux [W/m^2] tc_o1 ! input lunar diurnal tidal energy flux [W/m^2] - isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - ! allocate CS variables associated with 3d tidal energy dissipation - if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz)) - if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz)) + ! get number of input levels: + call field_size(tidal_energy_file, 'z_t',nz_in) ! allocate local variables - allocate(tc_m2(isd:ied,jsd:jed,nz), & - tc_s2(isd:ied,jsd:jed,nz), & - tc_k1(isd:ied,jsd:jed,nz), & - tc_o1(isd:ied,jsd:jed,nz) ) + allocate(z_t(nz_in(1)), z_w(nz_in(1)) ) + allocate(tc_m2(isd:ied,jsd:jed,nz_in(1)), & + tc_s2(isd:ied,jsd:jed,nz_in(1)), & + tc_k1(isd:ied,jsd:jed,nz_in(1)), & + tc_o1(isd:ied,jsd:jed,nz_in(1)) ) + + ! allocate CS variables associated with 3d tidal energy dissipation + if (.not. allocated(CS%tidal_qe_3d_in)) allocate(CS%tidal_qe_3d_in(isd:ied,jsd:jed,nz_in(1))) + if (.not. allocated(CS%h_src)) allocate(CS%h_src(nz_in(1))) ! read in tidal constituents call MOM_read_data(tidal_energy_file, 'M2', tc_m2, G%domain) @@ -1479,7 +1508,6 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) call MOM_read_data(tidal_energy_file, 'z_t', z_t) call MOM_read_data(tidal_energy_file, 'z_w', z_w) - where (abs(G%geoLatT(:,:)) < 30.0) tidal_qk1(:,:) = p33 tidal_qo1(:,:) = p33 @@ -1489,37 +1517,54 @@ subroutine read_tidal_constituents(G, tidal_energy_type, tidal_energy_file, CS) endwhere CS%tidal_qe_3d_in = 0.0 - do k=1,nz + do k=1,nz_in(1) ! input cell thickness CS%h_src(k) = (z_t(k)-z_w(k))*2.0 *1e-2 ! form tidal_qe_3d_in from weighted tidal constituents - where (z_t(k) <= G%bathyT(:,:) .and. z_w(k) > CS%tidal_diss_lim_tc) + where ( (z_t(k)*1e-2) <= G%bathyT(:,:) .and. (z_w(k)*1e-2) > CS%tidal_diss_lim_tc) CS%tidal_qe_3d_in(:,:,k) = p33*tc_m2(:,:,k) + p33*tc_s2(:,:,k) + & tidal_qk1*tc_k1(:,:,k) + tidal_qo1*tc_o1(:,:,k) endwhere enddo + !open(unit=1905,file="out_1905.txt",access="APPEND") + !do j=G%jsd,G%jed + ! do i=isd,ied + ! if ( i+G%idg_offset .eq. 90 .and. j+G%jdg_offset .eq. 126) then + ! print *, "-------------------------------------------" + ! do k=50,nz_in(1) + ! write(1905,*) i,j,k + ! write(1905,*) CS%tidal_qe_3d_in(i,j,k), tc_m2(i,j,k) + ! write(1905,*) z_t(k), G%bathyT(i,j), z_w(k),CS%tidal_diss_lim_tc + ! end do + ! endif + ! enddo + !enddo + !close(1905) + ! test if qE is positive - if (any(CS%tidal_qe_3d_in<0)) then + if (any(CS%tidal_qe_3d_in<0.0)) then call MOM_error(FATAL, "read_tidal_constituents: Negative tidal_qe_3d_in terms.") endif !! collapse 3D q*E to 2D q*E !CS%tidal_qe_2d = 0.0 - !do k=1,nz + !do k=1,nz_in(1) ! where (z_t(k) <= G%bathyT(:,:)) ! CS%tidal_qe_2d(:,:) = CS%tidal_qe_2d(:,:) + CS%tidal_qe_3d_in(:,:,k) ! endwhere !enddo ! initialize input remapping: - call initialize_remapping(CS%remap_cs, remapping_scheme="PPM_IH4", & + call initialize_remapping(CS%remap_cs, remapping_scheme="PLM", & boundary_extrapolation=.false., check_remapping=CS%debug) deallocate(tc_m2) deallocate(tc_s2) deallocate(tc_k1) deallocate(tc_o1) + deallocate(z_t) + deallocate(z_w) end subroutine read_tidal_constituents From 9ce97ef0519246ffa826217df223793e69f5d4f4 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 2 May 2018 16:58:47 -0600 Subject: [PATCH 27/53] use unmodified CVMix_compute_Schmittner_invariant interface --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 11effe5dca..9321d3f68c 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -797,10 +797,14 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) ! form the time-invariant part of Schmittner coefficient term call CVMix_compute_Schmittner_invariant(nlev = G%ke, & VertDep = vert_dep, & + efficiency = CS%Mu_itides, & rho = rho_fw, & exp_hab_zetar = exp_hab_zetar, & zw = iFaceHeight, & CVmix_tidal_params_user = CS%CVMix_tidal_params) + !TODO: in above call, there is no need to pass efficiency, since it gets + ! passed via CVMix_init_tidal and stored in CVMix_tidal_params. Change + ! CVMix API to prevent this redundancy. ! remap from input z coordinate to model coordinate: tidal_qe_md = 0.0 From 72774d72b87f8511ef54e26761d5d2cf41a72871 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 10:32:28 -0600 Subject: [PATCH 28/53] split OBL depth computation and KPP_calculate --- src/parameterizations/vertical/MOM_KPP.F90 | 116 +++++++++++++++------ 1 file changed, 85 insertions(+), 31 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 697cc26125..48c683f60a 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -406,9 +406,8 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) end function KPP_init - -!> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & +!> Compute OBL depth +subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& nonLocalTransScalar) @@ -434,21 +433,19 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) ! Local variables - integer :: i, j, k, km1,kp1 ! Loop indices + integer :: i, j, k, km1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -457,7 +454,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Salt_1D real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. @@ -471,20 +468,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp -#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(Temp, "KPP in: T",G%HI,haloshift=0) - call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) - call hchksum(u, "KPP in: u",G%HI,haloshift=0) - call hchksum(v, "KPP in: v",G%HI,haloshift=0) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) - call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) - endif -#endif - ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 @@ -492,17 +475,15 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux, nonLocalTransHeat, & -!$OMP nonLocalTransScalar,Kt,Ks,Kv) & -!$OMP firstprivate(nonLocalTrans) & +!$OMP buoyFlux) & !$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & -!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & +!$OMP OBLdepth_0d,zBottomMinusOffset, & +!$OMP sigma,kOBL,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -746,6 +727,79 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! smg: remove code above ! ********************************************************************** + enddo + enddo + +end subroutine + +!> KPP vertical diffusivity/viscosity and non-local tracer transport +subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & + buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& + nonLocalTransScalar) + + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) + type(EOS_type), pointer :: EOS !< Equation of state + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) + !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) + + ! Local variables + integer :: i, j, k, km1,kp1 ! Loop indices + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) + real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) + real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number + real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) + real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) + + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer + real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) + real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) + + real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux + real :: sigma + + real :: surfTemp ! Integral and average of temp over the surface layer + real :: surfSalt ! Integral and average of saln over the surface layer + real :: surfU ! Integral and average of u over the surface layer + real :: surfV ! Integral and average of v over the surface layer + +#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(Temp, "KPP in: T",G%HI,haloshift=0) + call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) + call hchksum(u, "KPP in: u",G%HI,haloshift=0) + call hchksum(v, "KPP in: v",G%HI,haloshift=0) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) + call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + endif +#endif + + ! loop over horizontal points on processor + do j = G%jsc, G%jec + do i = G%isc, G%iec ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -880,7 +934,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV ! Update output of routine From 80d93232cc447c1db452c80388c18076bf81a25e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 15:27:38 -0600 Subject: [PATCH 29/53] restore KPP_calculate for now --- src/parameterizations/vertical/MOM_KPP.F90 | 297 ++++++++++++++++++++- 1 file changed, 285 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 48c683f60a..192ae02389 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -732,6 +732,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & end subroutine + !> KPP vertical diffusivity/viscosity and non-local tracer transport subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& @@ -758,30 +759,43 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) - ! Local variables +! Local variables integer :: i, j, k, km1,kp1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) - - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) + real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) + real, dimension( G%ke ) :: surfBuoyFlux2 - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux - real :: sigma + ! for EOS calculation + real, dimension( 3*G%ke ) :: rho_1D + real, dimension( 3*G%ke ) :: pres_1D + real, dimension( 3*G%ke ) :: Temp_1D + real, dimension( 3*G%ke ) :: Salt_1D - real :: surfTemp ! Integral and average of temp over the surface layer - real :: surfSalt ! Integral and average of saln over the surface layer - real :: surfU ! Integral and average of u over the surface layer - real :: surfV ! Integral and average of v over the surface layer + real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + + real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) + real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. + real :: hTot ! Running sum of thickness used in the surface layer average (m) + real :: delH ! Thickness of a layer (m) + real :: surfHtemp, surfTemp ! Integral and average of temp over the surface layer + real :: surfHsalt, surfSalt ! Integral and average of saln over the surface layer + real :: surfHu, surfU ! Integral and average of u over the surface layer + real :: surfHv, surfV ! Integral and average of v over the surface layer + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + integer :: kk, ksfc, ktmp #ifdef __DO_SAFETY_CHECKS__ if (CS%debug) then @@ -797,10 +811,268 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif #endif + ! some constants + GoRho = GV%g_Earth / GV%Rho0 + nonLocalTrans(:,:) = 0.0 + + if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + +!$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & +!$OMP buoyFlux, nonLocalTransHeat, & +!$OMP nonLocalTransScalar,Kt,Ks,Kv) & +!$OMP firstprivate(nonLocalTrans) & +!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP surfHtemp,surfSalt,surfHsalt,surfU, & +!$OMP surfHu,surfV,surfHv,iFaceHeight, & +!$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & +!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & +!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & +!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) + ! loop over horizontal points on processor do j = G%jsc, G%jec do i = G%isc, G%iec + ! skip calling KPP for land points + if (G%mask2dT(i,j)==0.) cycle + + ! things independent of position within the column + Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & + +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) + surfFricVel = uStar(i,j) + + ! Bullk Richardson number computed for each cell in a column, + ! assuming OBLdepth = grid cell depth. After Rib(k) is + ! known for the column, then CVMix interpolates to find + ! the actual OBLdepth. This approach avoids need to iterate + ! on the OBLdepth calculation. It follows that used in MOM5 + ! and POP. + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + pRef = 0. + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + + ! find ksfc for cell where "surface layer" sits + SLdepth_0d = CS%surf_layer_ext*max( max(-cellHeight(k),-iFaceHeight(2) ), CS%minOBLdepth ) + ksfc = k + do ktmp = 1,k + if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then + ksfc = ktmp + exit + endif + enddo + + ! average temp, saln, u, v over surface layer + ! use C-grid average to get u,v on T-points. + surfHtemp=0.0 + surfHsalt=0.0 + surfHu =0.0 + surfHv =0.0 + hTot =0.0 + do ktmp = 1,ksfc + + ! SLdepth_0d can be between cell interfaces + delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_m ) + + ! surface layer thickness + hTot = hTot + delH + + ! surface averaged fields + surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH + surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH + surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH + surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + + enddo + surfTemp = surfHtemp / hTot + surfSalt = surfHsalt / hTot + surfU = surfHu / hTot + surfV = surfHv / hTot + + ! vertical shear between present layer and + ! surface layer averaged surfU,surfV. + ! C-grid average to get Uk and Vk on T-points. + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + + ! pressure, temp, and saln for EOS + ! kk+1 = surface fields + ! kk+2 = k fields + ! kk+3 = km1 fields + km1 = max(1, k-1) + kk = 3*(k-1) + pres_1D(kk+1) = pRef + pres_1D(kk+2) = pRef + pres_1D(kk+3) = pRef + Temp_1D(kk+1) = surfTemp + Temp_1D(kk+2) = Temp(i,j,k) + Temp_1D(kk+3) = Temp(i,j,km1) + Salt_1D(kk+1) = surfSalt + Salt_1D(kk+2) = Salt(i,j,k) + Salt_1D(kk+3) = Salt(i,j,km1) + + ! pRef is pressure at interface between k and km1. + ! iterate pRef for next pass through k-loop. + pRef = pRef + GV%H_to_Pa * h(i,j,k) + + ! this difference accounts for penetrating SW + surfBuoyFlux2(k) = buoyFlux(i,j,1) - buoyFlux(i,j,k+1) + + enddo ! k-loop finishes + + ! compute in-situ density + call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 3*G%ke, EOS) + + ! N2 (can be negative) and N (non-negative) on interfaces. + ! deltaRho is non-local rho difference used for bulk Richardson number. + ! N_1d is local N (with floor) used for unresolved shear calculation. + do k = 1, G%ke + km1 = max(1, k-1) + kk = 3*(k-1) + deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) + N2_1d(k) = (GoRho * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & + ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_m) + N_1d(k) = sqrt( max( N2_1d(k), 0.) ) + enddo + N2_1d(G%ke+1 ) = 0.0 + N_1d(G%ke+1 ) = 0.0 + + ! turbulent velocity scales w_s and w_m computed at the cell centers. + ! Note that if sigma > CS%surf_layer_ext, then CVMix_kpp_compute_turbulent_scales + ! computes w_s and w_m velocity scale at sigma=CS%surf_layer_ext. So we only pass + ! sigma=CS%surf_layer_ext for this calculation. + call CVMix_kpp_compute_turbulent_scales( & + CS%surf_layer_ext, & ! (in) Normalized surface layer depth; sigma = CS%surf_layer_ext + -cellHeight, & ! (in) Assume here that OBL depth (m) = -cellHeight(k) + surfBuoyFlux2, & ! (in) Buoyancy flux at surface (m2/s3) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + CVMix_kpp_params_user=CS%KPP_params ) + + ! Calculate Bulk Richardson number from eq (21) of LMD94 + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d) ! Buoyancy frequency (1/s) + + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + OBLdepth_0d, & ! (out) OBL depth (m) + kOBL, & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + ! A hack to avoid KPP reaching the bottom. It was needed during development + ! because KPP was unable to handle vanishingly small layers near the bottom. + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + endif + + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer + OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + +!************************************************************************* +! smg: remove code below + +! Following "correction" step has been found to be unnecessary. +! Code should be removed after further testing. + if (CS%correctSurfLayerAvg) then + + SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d + hTot = h(i,j,1) + surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot + surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot + surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + pRef = 0.0 + + do k = 2, G%ke + + ! Recalculate differences with surface layer + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + pRef = pRef + GV%H_to_Pa * h(i,j,k) + call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) + call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) + deltaRho(k) = rhoK - rho1 + + ! Surface layer averaging (needed for next k+1 iteration of this loop) + if (hTot < SLdepth_0d) then + delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) + hTot = hTot + delH + surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot + surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot + surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + endif + + enddo + + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d ) ! Buoyancy frequency (1/s) + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + OBLdepth_0d, & ! (out) OBL depth (m) + kOBL, & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + endif + + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value + OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer + OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom + kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + + endif ! endif for "correction" step + +! smg: remove code above +! ********************************************************************** + + ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports ! Unlike LMD94, we do not match to interior diffusivities. If using the original @@ -934,7 +1206,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv ! Update output of routine @@ -991,6 +1263,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & end subroutine KPP_calculate + !> Copies KPP surface boundary layer depth into BLD subroutine KPP_get_BLD(CS, BLD, G) type(KPP_CS), pointer :: CS !< Control structure for From 85810d2c2afcc2f19a7709f6623a1dcd75da5103 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 15:32:51 -0600 Subject: [PATCH 30/53] remove unnecessary KPP_compute_OBL arguments --- src/parameterizations/vertical/MOM_KPP.F90 | 16 ++-------------- 1 file changed, 2 insertions(+), 14 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 192ae02389..a9e9c06f87 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -407,9 +407,7 @@ end function KPP_init !> Compute OBL depth -subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar) +subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -423,14 +421,6 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) ! Local variables integer :: i, j, k, km1 ! Loop indices @@ -472,8 +462,6 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 - if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & !$OMP buoyFlux) & !$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & @@ -730,7 +718,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & enddo enddo -end subroutine +end subroutine KPP_compute_OBL !> KPP vertical diffusivity/viscosity and non-local tracer transport From 82d9228b2927478463834ecd4b1e48d5ff933fe7 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 8 May 2018 16:33:13 -0600 Subject: [PATCH 31/53] rename KPP_compute_OBL as KPP_compute_BLD --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++++++-- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 6 +++++- 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index a9e9c06f87..83f9788418 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -28,6 +28,7 @@ module MOM_KPP #include "MOM_memory.h" public :: KPP_init +public :: KPP_compute_BLD public :: KPP_calculate public :: KPP_end public :: KPP_NonLocalTransport_temp @@ -171,6 +172,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) + call get_param(paramFile, mdl, 'APPLY_KPP_OBL_FILTER', CS%applyNonLocalTrans, & + 'If True, applies a 1-1-4-1-1 Laplacian filter one time on HBLT.\n'// & + 'computed via CVMix to reduce any horizontal two-grid-point noise.', & + default=.false.) call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the\n'// & 'surface Ocean Boundary Layer (OBL).', & @@ -407,7 +412,7 @@ end function KPP_init !> Compute OBL depth -subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -718,7 +723,7 @@ subroutine KPP_compute_OBL(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo enddo -end subroutine KPP_compute_OBL +end subroutine KPP_compute_BLD !> KPP vertical diffusivity/viscosity and non-local tracer transport diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 02b9896ab7..284b209932 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -49,7 +49,8 @@ module MOM_diabatic_driver use MOM_internal_tides, only : propagate_int_tide use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used -use MOM_KPP, only : KPP_CS, KPP_init, KPP_calculate, KPP_end, KPP_get_BLD +use MOM_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate +use MOM_KPP, only : KPP_end, KPP_get_BLD use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS use MOM_regularize_layers, only : regularize_layers, regularize_layers_init, regularize_layers_CS @@ -635,6 +636,9 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif !$OMP end parallel + call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux) + call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar) !$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) From c2a6ed841167d648985044b0827084cef6699d13 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 9 May 2018 20:55:18 -0600 Subject: [PATCH 32/53] add smoothBLD var --- src/parameterizations/vertical/MOM_KPP.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 83f9788418..167bd2b589 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -70,6 +70,7 @@ module MOM_KPP character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars + logical :: smoothBLD !< If True, apply a 1-1-4-1-1 Laplacian filter one time on HBLT. logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero; for testing purposes. logical :: KPPisAdditive !< If True, will add KPP diffusivity to initial diffusivity. !! If False, will replace initial diffusivity wherever KPP diffusivity is non-zero. @@ -172,7 +173,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) - call get_param(paramFile, mdl, 'APPLY_KPP_OBL_FILTER', CS%applyNonLocalTrans, & + call get_param(paramFile, mdl, 'SMOOTH_BLD', CS%smoothBLD, & 'If True, applies a 1-1-4-1-1 Laplacian filter one time on HBLT.\n'// & 'computed via CVMix to reduce any horizontal two-grid-point noise.', & default=.false.) From 34e4cf4fc32dc0dba03c7ffd36d4820332881baf Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 13:57:32 -0600 Subject: [PATCH 33/53] use 2d CS arrays for OBLdepth and kOBL --- src/parameterizations/vertical/MOM_KPP.F90 | 173 +++++---------------- 1 file changed, 38 insertions(+), 135 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 167bd2b589..3ae2a1a196 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -106,6 +106,7 @@ module MOM_KPP ! Diagnostics arrays real, allocatable, dimension(:,:) :: OBLdepth !< Depth (positive) of OBL (m) + real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density (kg/m3) real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity (m2/s2) real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer (dimensionless) @@ -376,8 +377,11 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'm/s') - if (CS%id_OBLdepth > 0) allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - if (CS%id_OBLdepth > 0) CS%OBLdepth(:,:) = 0. + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) + CS%OBLdepth(:,:) = 0. + allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) + CS%kOBL(:,:) = 0. + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(G) ) ) if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(G) ) ) @@ -449,7 +453,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) @@ -476,8 +480,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset, & -!$OMP sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP zBottomMinusOffset, & +!$OMP sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -624,8 +628,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent zt_cntr=cellHeight, & ! (in) Height of cell centers (m) surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) @@ -636,14 +640,14 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! because KPP was unable to handle vanishingly small layers near the bottom. if (CS%deepOBLoffset>0.) then zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) !************************************************************************* ! smg: remove code below @@ -652,7 +656,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Code should be removed after further testing. if (CS%correctSurfLayerAvg) then - SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d + SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) hTot = h(i,j,1) surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot @@ -696,8 +700,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) call CVMix_kpp_compute_OBL_depth( & BulkRi_1d, & ! (in) Bulk Richardson number iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent zt_cntr=cellHeight, & ! (in) Height of cell centers (m) surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) @@ -706,15 +710,15 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) if (CS%deepOBLoffset>0.) then zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif ! endif for "correction" step @@ -776,7 +780,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: kOBL, OBLdepth_0d, surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux, Coriolis real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) @@ -821,8 +825,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP OBLdepth_0d,zBottomMinusOffset,Kdiffusivity, & -!$OMP Kviscosity,sigma,kOBL,kk,pres_1D,Temp_1D, & +!$OMP zBottomMinusOffset,Kdiffusivity, & +!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -966,106 +970,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - ! A hack to avoid KPP reaching the bottom. It was needed during development - ! because KPP was unable to handle vanishingly small layers near the bottom. - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deeper than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - -!************************************************************************* -! smg: remove code below - -! Following "correction" step has been found to be unnecessary. -! Code should be removed after further testing. - if (CS%correctSurfLayerAvg) then - - SLdepth_0d = CS%surf_layer_ext * OBLdepth_0d - hTot = h(i,j,1) - surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot - surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot - pRef = 0.0 - - do k = 2, G%ke - - ! Recalculate differences with surface layer - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV - deltaU2(k) = Uk**2 + Vk**2 - pRef = pRef + GV%H_to_Pa * h(i,j,k) - call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) - call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - deltaRho(k) = rhoK - rho1 - - ! Surface layer averaging (needed for next k+1 iteration of this loop) - if (hTot < SLdepth_0d) then - delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) - hTot = hTot + delH - surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot - surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot - endif - - enddo - - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) - N_iface=N_1d ) ! Buoyancy frequency (1/s) - - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) - - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - OBLdepth_0d, & ! (out) OBL depth (m) - kOBL, & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - OBLdepth_0d = min( OBLdepth_0d, -zBottomMinusOffset ) - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) OBLdepth_0d = CS%fixedOBLdepth_value - OBLdepth_0d = max( OBLdepth_0d, -iFaceHeight(2) ) ! no shallower than top layer - OBLdepth_0d = min( OBLdepth_0d, -iFaceHeight(G%ke+1) ) ! no deep than bottom - kOBL = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, OBLdepth_0d ) - - endif ! endif for "correction" step - -! smg: remove code above -! ********************************************************************** - ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports @@ -1076,7 +980,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then surfBuoyFlux = buoyFlux(i,j,1) elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(kOBL)+1) ! We know the actual buoyancy flux into the OBL + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) endif @@ -1099,8 +1003,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & Kviscosity, & ! (in) Original viscosity (m2/s) Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) - OBLdepth_0d, & ! (in) OBL depth (m) - kOBL, & ! (in) level (+fraction) of OBL extent + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) @@ -1122,26 +1026,26 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (surfBuoyFlux < 0.0) then if (CS%NLT_shape == NLT_SHAPE_CUBIC) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then ! Sanity check (should agree with CVMix result using simple matching) do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 nonLocalTrans(k,2) = nonLocalTrans(k,1) enddo @@ -1163,8 +1067,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & ! recompute wscale for diagnostics, now that we in fact know boundary layer depth if (CS%id_Ws > 0) then call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/OBLdepth_0d, & ! (in) Normalized boundary layer coordinate - OBLdepth_0d, & ! (in) OBL depth (m) + -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + CS%OBLdepth(i,j), & ! (in) OBL depth (m) surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) @@ -1184,13 +1088,12 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & endif ! Copy 1d data into 3d diagnostic arrays - if (CS%id_OBLdepth > 0) CS%OBLdepth(i,j) = OBLdepth_0d if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) if (CS%id_sigma > 0) then CS%sigma(i,j,:) = 0. - if (OBLdepth_0d>0.) CS%sigma(i,j,:) = -iFaceHeight/OBLdepth_0d + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) endif if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) From 29a458ac92590330618d161af08c8a25bd17ca5c Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 14:18:48 -0600 Subject: [PATCH 34/53] remove unnecessary vars in KPP_calculate --- src/parameterizations/vertical/MOM_KPP.F90 | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 3ae2a1a196..eb5d27d7bf 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -780,10 +780,9 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux, Coriolis + real :: surfFricVel, surfBuoyFlux real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma - real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -819,13 +818,13 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & !$OMP buoyFlux, nonLocalTransHeat, & !$OMP nonLocalTransScalar,Kt,Ks,Kv) & !$OMP firstprivate(nonLocalTrans) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & !$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & !$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset,Kdiffusivity, & +!$OMP Kdiffusivity, & !$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) @@ -837,8 +836,6 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, From 8f730569e1d091ec3219bb73db95da545434b1fc Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Thu, 10 May 2018 15:52:01 -0600 Subject: [PATCH 35/53] implement smoothing on OBL depth --- src/parameterizations/vertical/MOM_KPP.F90 | 68 ++++++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index eb5d27d7bf..e479460ebe 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -728,9 +728,77 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo enddo + if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) + end subroutine KPP_compute_BLD +!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise +subroutine KPP_smooth_BLD(CS,G,GV,h) + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + + ! local + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + integer :: i, j, k + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + + ! apply smoothing on OBL depth + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & + + ww * CS%OBLdepth(i-1,j) & + + we * CS%OBLdepth(i+1,j) & + + ws * CS%OBLdepth(i,j-1) & + + wn * CS%OBLdepth(i,j+1) + enddo + enddo + + ! Update kOBL for smoothed OBL depths + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + + enddo + enddo + +end subroutine KPP_smooth_BLD + + !> KPP vertical diffusivity/viscosity and non-local tracer transport subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& From bde57f32885d5286f4c33a7b500de4cc043db46e Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 09:54:56 -0600 Subject: [PATCH 36/53] rm trailing whitespaces --- src/parameterizations/vertical/MOM_tidal_mixing.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 9321d3f68c..cb868d9e95 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -802,7 +802,7 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) exp_hab_zetar = exp_hab_zetar, & zw = iFaceHeight, & CVmix_tidal_params_user = CS%CVMix_tidal_params) - !TODO: in above call, there is no need to pass efficiency, since it gets + !TODO: in above call, there is no need to pass efficiency, since it gets ! passed via CVMix_init_tidal and stored in CVMix_tidal_params. Change ! CVMix API to prevent this redundancy. From bfa2613ceaae65760c305cf8df0c0b6213638d49 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 14:09:02 -0600 Subject: [PATCH 37/53] move KPP_compute_BLD to streamline merging --- src/parameterizations/vertical/MOM_KPP.F90 | 762 ++++++++++----------- 1 file changed, 381 insertions(+), 381 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index e479460ebe..804f3ebfb1 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -415,9 +415,10 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) end function KPP_init - -!> Compute OBL depth -subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +!> KPP vertical diffusivity/viscosity and non-local tracer transport +subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & + buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& + nonLocalTransScalar) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -431,21 +432,31 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) + !< (out) Vertical diffusivity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) + !< (out) Vertical viscosity including KPP (m2/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) - ! Local variables - integer :: i, j, k, km1 ! Loop indices +! Local variables + integer :: i, j, k, km1,kp1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) + real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) + real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -453,10 +464,9 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: surfFricVel, surfBuoyFlux + real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma - real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -468,20 +478,38 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp +#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(Temp, "KPP in: T",G%HI,haloshift=0) + call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) + call hchksum(u, "KPP in: u",G%HI,haloshift=0) + call hchksum(v, "KPP in: v",G%HI,haloshift=0) + call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) + call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) + endif +#endif + ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 + if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) + !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP buoyFlux, nonLocalTransHeat, & +!$OMP nonLocalTransScalar,Kt,Ks,Kv) & +!$OMP firstprivate(nonLocalTrans) & +!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset, & -!$OMP sigma,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & +!$OMP Kdiffusivity, & +!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -492,8 +520,6 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column - Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & - +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, @@ -625,184 +651,199 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - CS%OBLdepth(i,j), & ! (out) OBL depth (m) - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - - ! A hack to avoid KPP reaching the bottom. It was needed during development - ! because KPP was unable to handle vanishingly small layers near the bottom. - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) - endif - - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - -!************************************************************************* -! smg: remove code below - -! Following "correction" step has been found to be unnecessary. -! Code should be removed after further testing. - if (CS%correctSurfLayerAvg) then - - SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) - hTot = h(i,j,1) - surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot - surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot - surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot - surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot - pRef = 0.0 - - do k = 2, G%ke - ! Recalculate differences with surface layer - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV - deltaU2(k) = Uk**2 + Vk**2 - pRef = pRef + GV%H_to_Pa * h(i,j,k) - call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) - call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) - deltaRho(k) = rhoK - rho1 + ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports - ! Surface layer averaging (needed for next k+1 iteration of this loop) - if (hTot < SLdepth_0d) then - delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) - hTot = hTot + delH - surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot - surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot - surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot - surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot - endif + ! Unlike LMD94, we do not match to interior diffusivities. If using the original + ! LMD94 shape function, not matching is equivalent to matching to a zero diffusivity. - enddo + !BGR/ Add option for use of surface buoyancy flux with total sw flux. + if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then + surfBuoyFlux = buoyFlux(i,j,1) + elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL + elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then + surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) + endif - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) - N_iface=N_1d ) ! Buoyancy frequency (1/s) + ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. + if (.not. (CS%MatchTechnique.eq.'MatchBoth')) then + Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) + Kviscosity(:) = 0. ! Viscosity (m2/s) + else + Kdiffusivity(:,1) = Kt(i,j,:) + Kdiffusivity(:,2) = Ks(i,j,:) + Kviscosity(:)=Kv(i,j,:) + endif - surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit - ! h to Monin-Obukov (default is false, ie. not used) + call CVMix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) + Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) + Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) + iFaceHeight, & ! (in) Height of interfaces (m) + cellHeight, & ! (in) Height of level centers (m) + Kviscosity, & ! (in) Original viscosity (m2/s) + Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) + Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent + nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) + nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + G%ke, & ! (in) Number of levels to compute coeffs for + G%ke, & ! (in) Number of levels in array shape + CVMix_kpp_params_user=CS%KPP_params ) - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - iFaceHeight, & ! (in) Height of interfaces (m) - CS%OBLdepth(i,j), & ! (out) OBL depth (m) - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=cellHeight, & ! (in) Height of cell centers (m) - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + ! Over-write CVMix NLT shape function with one of the following choices. + ! The CVMix code has yet to update for thse options, so we compute in MOM6. + ! Note that nonLocalTrans = Cs * G(sigma) (LMD94 notation), with + ! Cs = 6.32739901508. + ! Start do-loop at k=2, since k=1 is ocean surface (sigma=0) + ! and we do not wish to double-count the surface forcing. + ! Only compute nonlocal transport for 0 <= sigma <= 1. + ! MOM6 recommended shape is the parabolic; it gives deeper boundary layer + ! and no spurious extrema. + if (surfBuoyFlux < 0.0) then + if (CS%NLT_shape == NLT_SHAPE_CUBIC) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo + elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then + ! Sanity check (should agree with CVMix result using simple matching) + do k = 2, G%ke + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) + nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 + nonLocalTrans(k,2) = nonLocalTrans(k,1) + enddo endif + endif - ! apply some constraints on OBLdepth - if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + ! we apply nonLocalTrans in subroutines + ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln + nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp + nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln - endif ! endif for "correction" step + ! set the KPP diffusivity and viscosity to zero for testing purposes + if(CS%KPPzeroDiffusivity) then + Kdiffusivity(:,1) = 0.0 + Kdiffusivity(:,2) = 0.0 + Kviscosity(:) = 0.0 + endif -! smg: remove code above -! ********************************************************************** + ! recompute wscale for diagnostics, now that we in fact know boundary layer depth + if (CS%id_Ws > 0) then + call CVMix_kpp_compute_turbulent_scales( & + -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + CS%OBLdepth(i,j), & ! (in) OBL depth (m) + surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) + CVMix_kpp_params_user=CS%KPP_params & ! KPP parameters + ) + CS%Ws(i,j,:) = Ws_1d(:) + endif - enddo - enddo + ! compute unresolved squared velocity for diagnostics + if (CS%id_Vt2 > 0) then + Vt2_1d(:) = CVMix_kpp_compute_unresolved_shear( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) + N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + CS%Vt2(i,j,:) = Vt2_1d(:) + endif - if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) - -end subroutine KPP_compute_BLD - - -!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise -subroutine KPP_smooth_BLD(CS,G,GV,h) - ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - - ! local - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) - integer :: i, j, k - real :: wc, ww, we, wn, ws ! averaging weights for smoothing - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) - - ! apply smoothing on OBL depth - do j = G%jsc, G%jec - do i = G%isc, G%iec - - ! skip land points - if (G%mask2dT(i,j)==0.) cycle - - ! compute weights - ww = 0.125 * G%mask2dT(i-1,j) - we = 0.125 * G%mask2dT(i+1,j) - ws = 0.125 * G%mask2dT(i,j-1) - wn = 0.125 * G%mask2dT(i,j+1) - wc = 1.0 - (ww+we+wn+ws) + ! Copy 1d data into 3d diagnostic arrays + if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) + if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) + if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) + if (CS%id_sigma > 0) then + CS%sigma(i,j,:) = 0. + if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) + endif + if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) + if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) + if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) + if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) + if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) + if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp + if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt + if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU + if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv - CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & - + ww * CS%OBLdepth(i-1,j) & - + we * CS%OBLdepth(i+1,j) & - + ws * CS%OBLdepth(i,j-1) & - + wn * CS%OBLdepth(i,j+1) - enddo - enddo - ! Update kOBL for smoothed OBL depths - do j = G%jsc, G%jec - do i = G%isc, G%iec + ! Update output of routine + if (.not. CS%passiveMode) then + if (CS%KPPisAdditive) then + do k=1, G%ke+1 + Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + Kviscosity(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) = Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) + enddo + endif + endif - ! skip land points - if (G%mask2dT(i,j)==0.) cycle - iFaceHeight(1) = 0.0 ! BBL is all relative to the surface - hcorr = 0. - do k=1,G%ke + ! end of the horizontal do-loops over the vertical columns + enddo ! i + enddo ! j - ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment - dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) - hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 - dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * dh - iFaceHeight(k+1) = iFaceHeight(k) - dh - enddo - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) +#ifdef __DO_SAFETY_CHECKS__ + if (CS%debug) then + call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) + call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) + endif +#endif - enddo - enddo + ! send diagnostics to post_data + if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) + if (CS%id_BulkDrho > 0) call post_data(CS%id_BulkDrho, CS%dRho, CS%diag) + if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) + if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) + if (CS%id_sigma > 0) call post_data(CS%id_sigma, CS%sigma, CS%diag) + if (CS%id_Ws > 0) call post_data(CS%id_Ws, CS%Ws, CS%diag) + if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) + if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) + if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) + if (CS%id_uStar > 0) call post_data(CS%id_uStar, uStar, CS%diag) + if (CS%id_buoyFlux > 0) call post_data(CS%id_buoyFlux, buoyFlux, CS%diag) + if (CS%id_Kt_KPP > 0) call post_data(CS%id_Kt_KPP, CS%Kt_KPP, CS%diag) + if (CS%id_Ks_KPP > 0) call post_data(CS%id_Ks_KPP, CS%Ks_KPP, CS%diag) + if (CS%id_Kv_KPP > 0) call post_data(CS%id_Kv_KPP, CS%Kv_KPP, CS%diag) + if (CS%id_NLTt > 0) call post_data(CS%id_NLTt, nonLocalTransHeat, CS%diag) + if (CS%id_NLTs > 0) call post_data(CS%id_NLTs, nonLocalTransScalar,CS%diag) + if (CS%id_Tsurf > 0) call post_data(CS%id_Tsurf, CS%Tsurf, CS%diag) + if (CS%id_Ssurf > 0) call post_data(CS%id_Ssurf, CS%Ssurf, CS%diag) + if (CS%id_Usurf > 0) call post_data(CS%id_Usurf, CS%Usurf, CS%diag) + if (CS%id_Vsurf > 0) call post_data(CS%id_Vsurf, CS%Vsurf, CS%diag) -end subroutine KPP_smooth_BLD +end subroutine KPP_calculate -!> KPP vertical diffusivity/viscosity and non-local tracer transport -subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & - buoyFlux, Kt, Ks, Kv, nonLocalTransHeat,& - nonLocalTransScalar) +!> Compute OBL depth +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! Arguments type(KPP_CS), pointer :: CS !< Control structure @@ -816,31 +857,21 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & type(EOS_type), pointer :: EOS !< Equation of state real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP (m2/s) - !< (out) Vertical diffusivity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP (m2/s) - !< (out) Vertical viscosity including KPP (m2/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local transport (m/s) -! Local variables - integer :: i, j, k, km1,kp1 ! Loop indices + ! Local variables + integer :: i, j, k, km1 ! Loop indices real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) real, dimension( G%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces (1/s2) real, dimension( G%ke+1 ) :: N_1d ! Brunt-Vaisala frequency at interfaces (1/s) (floored at 0) real, dimension( G%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars (m/s) - real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) + !real, dimension( G%ke ) :: Wm_1d ! Profile of vertical velocity scale for momentum (m/s) real, dimension( G%ke ) :: Vt2_1d ! Unresolved velocity for bulk Ri calculation/diagnostic (m2/s2) - real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer real, dimension( G%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number real, dimension( G%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri (m2/s2) - real, dimension( G%ke+1, 2) :: Kdiffusivity ! Vertical diffusivity at interfaces (m2/s) - real, dimension( G%ke+1 ) :: Kviscosity ! Vertical viscosity at interfaces (m2/s) real, dimension( G%ke+1, 2) :: nonLocalTrans ! Non-local transport for heat/salt at interfaces (non-dimensional) real, dimension( G%ke ) :: surfBuoyFlux2 + real, dimension( G%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer ! for EOS calculation real, dimension( 3*G%ke ) :: rho_1D @@ -848,9 +879,10 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real, dimension( 3*G%ke ) :: Temp_1D real, dimension( 3*G%ke ) :: Salt_1D - real :: surfFricVel, surfBuoyFlux - real :: GoRho, pRef, rho1, rhoK, rhoKm1, Uk, Vk, sigma + real :: surfFricVel, surfBuoyFlux, Coriolis + real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: zBottomMinusOffset ! Height of bottom plus a little bit (m) real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth. real :: hTot ! Running sum of thickness used in the surface layer average (m) real :: delH ! Thickness of a layer (m) @@ -862,38 +894,20 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp -#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(Temp, "KPP in: T",G%HI,haloshift=0) - call hchksum(Salt, "KPP in: S",G%HI,haloshift=0) - call hchksum(u, "KPP in: u",G%HI,haloshift=0) - call hchksum(v, "KPP in: v",G%HI,haloshift=0) - call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0) - call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0) - endif -#endif - ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 - if (CS%id_Kd_in > 0) call post_data(CS%id_Kd_in, Kt, CS%diag) - !$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux, nonLocalTransHeat, & -!$OMP nonLocalTransScalar,Kt,Ks,Kv) & -!$OMP firstprivate(nonLocalTrans) & -!$OMP private(surfFricVel,SLdepth_0d,hTot,surfTemp, & +!$OMP buoyFlux) & +!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & !$OMP surfHtemp,surfSalt,surfHsalt,surfU, & !$OMP surfHu,surfV,surfHv,iFaceHeight, & !$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,rhoKm1,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,Vt2_1d,BulkRi_1d, & -!$OMP Kdiffusivity, & -!$OMP Kviscosity,sigma,kk,pres_1D,Temp_1D, & +!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & +!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & +!$OMP zBottomMinusOffset, & +!$OMP sigma,kk,pres_1D,Temp_1D, & !$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) ! loop over horizontal points on processor @@ -904,6 +918,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & if (G%mask2dT(i,j)==0.) cycle ! things independent of position within the column + Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & + +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = uStar(i,j) ! Bullk Richardson number computed for each cell in a column, @@ -1035,195 +1051,179 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit ! h to Monin-Obukov (default is false, ie. not used) + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - ! Call CVMix/KPP to obtain OBL diffusivities, viscosities and non-local transports + ! A hack to avoid KPP reaching the bottom. It was needed during development + ! because KPP was unable to handle vanishingly small layers near the bottom. + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + endif - ! Unlike LMD94, we do not match to interior diffusivities. If using the original - ! LMD94 shape function, not matching is equivalent to matching to a zero diffusivity. + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deeper than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - !BGR/ Add option for use of surface buoyancy flux with total sw flux. - if (CS%SW_METHOD .eq. SW_METHOD_ALL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - elseif (CS%SW_METHOD .eq. SW_METHOD_MXL_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,int(CS%kOBL(i,j))+1) ! We know the actual buoyancy flux into the OBL - elseif (CS%SW_METHOD .eq. SW_METHOD_LV1_SW) then - surfBuoyFlux = buoyFlux(i,j,1) - buoyFlux(i,j,2) - endif +!************************************************************************* +! smg: remove code below - ! If option "MatchBoth" is selected in CVMix, MOM should be capable of matching. - if (.not. (CS%MatchTechnique.eq.'MatchBoth')) then - Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt (m2/s) - Kviscosity(:) = 0. ! Viscosity (m2/s) - else - Kdiffusivity(:,1) = Kt(i,j,:) - Kdiffusivity(:,2) = Ks(i,j,:) - Kviscosity(:)=Kv(i,j,:) - endif +! Following "correction" step has been found to be unnecessary. +! Code should be removed after further testing. + if (CS%correctSurfLayerAvg) then - call CVMix_coeffs_kpp(Kviscosity, & ! (inout) Total viscosity (m2/s) - Kdiffusivity(:,1), & ! (inout) Total heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (inout) Total salt diffusivity (m2/s) - iFaceHeight, & ! (in) Height of interfaces (m) - cellHeight, & ! (in) Height of level centers (m) - Kviscosity, & ! (in) Original viscosity (m2/s) - Kdiffusivity(:,1), & ! (in) Original heat diffusivity (m2/s) - Kdiffusivity(:,2), & ! (in) Original salt diffusivity (m2/s) - CS%OBLdepth(i,j), & ! (in) OBL depth (m) - CS%kOBL(i,j), & ! (in) level (+fraction) of OBL extent - nonLocalTrans(:,1),& ! (out) Non-local heat transport (non-dimensional) - nonLocalTrans(:,2),& ! (out) Non-local salt transport (non-dimensional) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - G%ke, & ! (in) Number of levels to compute coeffs for - G%ke, & ! (in) Number of levels in array shape - CVMix_kpp_params_user=CS%KPP_params ) + SLdepth_0d = CS%surf_layer_ext * CS%OBLdepth(i,j) + hTot = h(i,j,1) + surfTemp = Temp(i,j,1) ; surfHtemp = surfTemp * hTot + surfSalt = Salt(i,j,1) ; surfHsalt = surfSalt * hTot + surfU = 0.5*(u(i,j,1)+u(i-1,j,1)) ; surfHu = surfU * hTot + surfV = 0.5*(v(i,j,1)+v(i,j-1,1)) ; surfHv = surfV * hTot + pRef = 0.0 + do k = 2, G%ke - ! Over-write CVMix NLT shape function with one of the following choices. - ! The CVMix code has yet to update for thse options, so we compute in MOM6. - ! Note that nonLocalTrans = Cs * G(sigma) (LMD94 notation), with - ! Cs = 6.32739901508. - ! Start do-loop at k=2, since k=1 is ocean surface (sigma=0) - ! and we do not wish to double-count the surface forcing. - ! Only compute nonlocal transport for 0 <= sigma <= 1. - ! MOM6 recommended shape is the parabolic; it gives deeper boundary layer - ! and no spurious extrema. - if (surfBuoyFlux < 0.0) then - if (CS%NLT_shape == NLT_SHAPE_CUBIC) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)**2 * (1.0 + 2.0*sigma) !* - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_PARABOLIC) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)**2 !*CS%CS2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_LINEAR) then - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = (1.0 - sigma)!*CS%CS2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo - elseif (CS%NLT_shape == NLT_SHAPE_CUBIC_LMD) then - ! Sanity check (should agree with CVMix result using simple matching) - do k = 2, G%ke - sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) - nonLocalTrans(k,1) = CS%CS2 * sigma*(1.0 -sigma)**2 - nonLocalTrans(k,2) = nonLocalTrans(k,1) - enddo + ! Recalculate differences with surface layer + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + deltaU2(k) = Uk**2 + Vk**2 + pRef = pRef + GV%H_to_Pa * h(i,j,k) + call calculate_density(surfTemp, surfSalt, pRef, rho1, EOS) + call calculate_density(Temp(i,j,k), Salt(i,j,k), pRef, rhoK, EOS) + deltaRho(k) = rhoK - rho1 + + ! Surface layer averaging (needed for next k+1 iteration of this loop) + if (hTot < SLdepth_0d) then + delH = min( max(0., SLdepth_0d - hTot), h(i,j,k)*GV%H_to_m ) + hTot = hTot + delH + surfHtemp = surfHtemp + Temp(i,j,k) * delH ; surfTemp = surfHtemp / hTot + surfHsalt = surfHsalt + Salt(i,j,k) * delH ; surfSalt = surfHsalt / hTot + surfHu = surfHu + 0.5*(u(i,j,k)+u(i-1,j,k)) * delH ; surfU = surfHu / hTot + surfHv = surfHv + 0.5*(v(i,j,k)+v(i,j-1,k)) * delH ; surfV = surfHv / hTot + endif + + enddo + + BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & + cellHeight(1:G%ke), & ! Depth of cell center (m) + GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + deltaU2, & ! Square of resolved velocity difference (m2/s2) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) + N_iface=N_1d ) ! Buoyancy frequency (1/s) + + surfBuoyFlux = buoyFlux(i,j,1) ! This is only used in kpp_compute_OBL_depth to limit + ! h to Monin-Obukov (default is false, ie. not used) + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + iFaceHeight, & ! (in) Height of interfaces (m) + CS%OBLdepth(i,j), & ! (out) OBL depth (m) + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=cellHeight, & ! (in) Height of cell centers (m) + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) + surf_buoy=surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) + Coriolis=Coriolis, & ! (in) Coriolis parameter (1/s) + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + if (CS%deepOBLoffset>0.) then + zBottomMinusOffset = iFaceHeight(G%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(G%ke+1)) + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) endif - endif - ! we apply nonLocalTrans in subroutines - ! KPP_NonLocalTransport_temp and KPP_NonLocalTransport_saln - nonLocalTransHeat(i,j,:) = nonLocalTrans(:,1) ! temp - nonLocalTransScalar(i,j,:) = nonLocalTrans(:,2) ! saln + ! apply some constraints on OBLdepth + if(CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(G%ke+1) ) ! no deep than bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - ! set the KPP diffusivity and viscosity to zero for testing purposes - if(CS%KPPzeroDiffusivity) then - Kdiffusivity(:,1) = 0.0 - Kdiffusivity(:,2) = 0.0 - Kviscosity(:) = 0.0 - endif + endif ! endif for "correction" step - ! recompute wscale for diagnostics, now that we in fact know boundary layer depth - if (CS%id_Ws > 0) then - call CVMix_kpp_compute_turbulent_scales( & - -CellHeight/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate - CS%OBLdepth(i,j), & ! (in) OBL depth (m) - surfBuoyFlux, & ! (in) Buoyancy flux at surface (m2/s3) - surfFricVel, & ! (in) Turbulent friction velocity at surface (m/s) - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) - CVMix_kpp_params_user=CS%KPP_params & ! KPP parameters - ) - CS%Ws(i,j,:) = Ws_1d(:) - endif +! smg: remove code above +! ********************************************************************** - ! compute unresolved squared velocity for diagnostics - if (CS%id_Vt2 > 0) then - Vt2_1d(:) = CVMix_kpp_compute_unresolved_shear( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) - N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - CS%Vt2(i,j,:) = Vt2_1d(:) - endif + enddo + enddo - ! Copy 1d data into 3d diagnostic arrays - if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) - if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = deltaU2(:) - if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) - if (CS%id_sigma > 0) then - CS%sigma(i,j,:) = 0. - if (CS%OBLdepth(i,j)>0.) CS%sigma(i,j,:) = -iFaceHeight/CS%OBLdepth(i,j) - endif - if (CS%id_N > 0) CS%N(i,j,:) = N_1d(:) - if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(i,j,:) = Kdiffusivity(:,1) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(i,j,:) = Kdiffusivity(:,2) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(i,j,:) = Kviscosity(:) - if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp - if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt - if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU - if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfv + if (CS%smoothBLD) call KPP_smooth_BLD(CS,G,GV,h) +end subroutine KPP_compute_BLD - ! Update output of routine - if (.not. CS%passiveMode) then - if (CS%KPPisAdditive) then - do k=1, G%ke+1 - Kt(i,j,k) = Kt(i,j,k) + Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + Kviscosity(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) = Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = Kviscosity(k) - enddo - endif - endif +!> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise +subroutine KPP_smooth_BLD(CS,G,GV,h) + ! Arguments + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - ! end of the horizontal do-loops over the vertical columns - enddo ! i - enddo ! j + ! local + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + integer :: i, j, k + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + ! apply smoothing on OBL depth + do j = G%jsc, G%jec + do i = G%isc, G%iec -#ifdef __DO_SAFETY_CHECKS__ - if (CS%debug) then - call hchksum(Kt, "KPP out: Kt",G%HI,haloshift=0) - call hchksum(Ks, "KPP out: Ks",G%HI,haloshift=0) - endif -#endif + ! skip land points + if (G%mask2dT(i,j)==0.) cycle - ! send diagnostics to post_data - if (CS%id_OBLdepth > 0) call post_data(CS%id_OBLdepth, CS%OBLdepth, CS%diag) - if (CS%id_BulkDrho > 0) call post_data(CS%id_BulkDrho, CS%dRho, CS%diag) - if (CS%id_BulkUz2 > 0) call post_data(CS%id_BulkUz2, CS%Uz2, CS%diag) - if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) - if (CS%id_sigma > 0) call post_data(CS%id_sigma, CS%sigma, CS%diag) - if (CS%id_Ws > 0) call post_data(CS%id_Ws, CS%Ws, CS%diag) - if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) - if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) - if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) - if (CS%id_uStar > 0) call post_data(CS%id_uStar, uStar, CS%diag) - if (CS%id_buoyFlux > 0) call post_data(CS%id_buoyFlux, buoyFlux, CS%diag) - if (CS%id_Kt_KPP > 0) call post_data(CS%id_Kt_KPP, CS%Kt_KPP, CS%diag) - if (CS%id_Ks_KPP > 0) call post_data(CS%id_Ks_KPP, CS%Ks_KPP, CS%diag) - if (CS%id_Kv_KPP > 0) call post_data(CS%id_Kv_KPP, CS%Kv_KPP, CS%diag) - if (CS%id_NLTt > 0) call post_data(CS%id_NLTt, nonLocalTransHeat, CS%diag) - if (CS%id_NLTs > 0) call post_data(CS%id_NLTs, nonLocalTransScalar,CS%diag) - if (CS%id_Tsurf > 0) call post_data(CS%id_Tsurf, CS%Tsurf, CS%diag) - if (CS%id_Ssurf > 0) call post_data(CS%id_Ssurf, CS%Ssurf, CS%diag) - if (CS%id_Usurf > 0) call post_data(CS%id_Usurf, CS%Usurf, CS%diag) - if (CS%id_Vsurf > 0) call post_data(CS%id_Vsurf, CS%Vsurf, CS%diag) + ! compute weights + ww = 0.125 * G%mask2dT(i-1,j) + we = 0.125 * G%mask2dT(i+1,j) + ws = 0.125 * G%mask2dT(i,j-1) + wn = 0.125 * G%mask2dT(i,j+1) + wc = 1.0 - (ww+we+wn+ws) + + CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & + + ww * CS%OBLdepth(i-1,j) & + + we * CS%OBLdepth(i+1,j) & + + ws * CS%OBLdepth(i,j-1) & + + wn * CS%OBLdepth(i,j+1) + enddo + enddo + + ! Update kOBL for smoothed OBL depths + do j = G%jsc, G%jec + do i = G%isc, G%iec + + ! skip land points + if (G%mask2dT(i,j)==0.) cycle + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0. + do k=1,G%ke + + ! cell center and cell bottom in meters (negative values in the ocean) + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) + + enddo + enddo + +end subroutine KPP_smooth_BLD -end subroutine KPP_calculate !> Copies KPP surface boundary layer depth into BLD From 91e459a99e22c91ed4950af5f2c3817fbfed8311 Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Tue, 15 May 2018 15:12:31 -0600 Subject: [PATCH 38/53] 2/2 - merge with candidate may15 --- src/parameterizations/vertical/MOM_KPP.F90 | 142 +++++++++++++++++---- 1 file changed, 114 insertions(+), 28 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 82cfc1c8fb..6ae93013ac 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -688,6 +688,8 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & surfHu =0.0 surfHv =0.0 surfHuS =0.0 + surfHuS =0.0 + surfHvS =0.0 surfHvS =0.0 hTot =0.0 do ktmp = 1,ksfc @@ -918,7 +920,7 @@ subroutine KPP_calculate(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, & Kdiffusivity(k,2) = Kdiffusivity(k,2) * LangEnhK Kviscosity(k) = Kviscosity(k) * LangEnhK elseif (CS%LT_K_SHAPE == LT_K_SCALED) then - sigma = min(1.0,-iFaceHeight(k)/OBLdepth_0d) + sigma = min(1.0,-iFaceHeight(k)/CS%OBLdepth(i,j)) 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. + & @@ -1087,19 +1089,20 @@ end subroutine KPP_calculate !> Compute OBL depth -subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) +subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux, Waves) ! Arguments - type(KPP_CS), pointer :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) - type(EOS_type), pointer :: EOS !< Equation of state - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) + type(KPP_CS), pointer :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + type(wave_parameters_CS), optional, pointer :: Waves !< Wave CS + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Temp !< potential/cons temp (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: Salt !< Salinity (ppt) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< Velocity j-component (m/s) + type(EOS_type), pointer :: EOS !< Equation of state + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity (m/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: buoyFlux !< Surface buoyancy flux (m2/s3) ! Local variables @@ -1124,7 +1127,7 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real, dimension( 3*G%ke ) :: Salt_1D real :: surfFricVel, surfBuoyFlux, Coriolis - real :: GoRho, pRef, rho1, rhoK, Uk, Vk, sigma + real :: GoRho, 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. @@ -1138,21 +1141,24 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: kk, ksfc, ktmp + ! For Langmuir Calculations + real :: LangEnhW ! Langmuir enhancement for turbulent velocity scale + real, dimension(G%ke) :: LangEnhVt2 ! Langmuir enhancement for unresolved shear + real, dimension(G%ke) :: U_H, V_H + real :: MLD_GUESS, LA + real :: LangEnhK ! Langmuir enhancement for mixing coefficient + real :: surfHuS, surfHvS, surfUs, surfVs, wavedir, currentdir + real :: VarUp, VarDn, M, VarLo, VarAvg + real :: H10pct, H20pct,CMNFACT, USx20pct, USy20pct + integer :: B + real :: WST + ! some constants GoRho = GV%g_Earth / GV%Rho0 nonLocalTrans(:,:) = 0.0 -!$OMP parallel do default(none) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & -!$OMP buoyFlux) & -!$OMP private(Coriolis,surfFricVel,SLdepth_0d,hTot,surfTemp, & -!$OMP surfHtemp,surfSalt,surfHsalt,surfU, & -!$OMP surfHu,surfV,surfHv,iFaceHeight, & -!$OMP pRef,km1,cellHeight,Uk,Vk,deltaU2, & -!$OMP rho1,rhoK,deltaRho,N2_1d,N_1d,delH, & -!$OMP surfBuoyFlux,Ws_1d,BulkRi_1d, & -!$OMP zBottomMinusOffset, & -!$OMP sigma,kk,pres_1D,Temp_1D, & -!$OMP Salt_1D,rho_1D,surfBuoyFlux2,ksfc,dh,hcorr) +!$OMP parallel do default(private) shared(G,GV,CS,EOS,uStar,Temp,Salt,u,v,h,GoRho, & +!$OMP Waves,buoyFlux) & ! loop over horizontal points on processor do j = G%jsc, G%jec @@ -1161,6 +1167,11 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) ! skip calling KPP for land points if (G%mask2dT(i,j)==0.) cycle + do k=1,G%ke + U_H(k) = 0.5 * (U(i,j,k)+U(i-1,j,k)) + V_H(k) = 0.5 * (V(i,j,k)+V(i,j-1,k)) + enddo + ! things independent of position within the column Coriolis = 0.25*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) & +(G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) @@ -1201,6 +1212,8 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfHsalt=0.0 surfHu =0.0 surfHv =0.0 + surfHuS =0.0 + surfHvS =0.0 hTot =0.0 do ktmp = 1,ksfc @@ -1215,18 +1228,33 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH surfHu = surfHu + 0.5*(u(i,j,ktmp)+u(i-1,j,ktmp)) * delH surfHv = surfHv + 0.5*(v(i,j,ktmp)+v(i,j-1,ktmp)) * delH + if (CS%Stokes_Mixing) then + surfHus = surfHus + 0.5*(WAVES%US_x(i,j,ktmp)+WAVES%US_x(i-1,j,ktmp)) * delH + surfHvs = surfHvs + 0.5*(WAVES%US_y(i,j,ktmp)+WAVES%US_y(i,j-1,ktmp)) * delH + endif enddo surfTemp = surfHtemp / hTot surfSalt = surfHsalt / hTot surfU = surfHu / hTot surfV = surfHv / hTot + surfUs = surfHus / hTot + surfVs = surfHvs / hTot ! vertical shear between present layer and ! surface layer averaged surfU,surfV. ! C-grid average to get Uk and Vk on T-points. Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + + if (CS%Stokes_Mixing) then + ! If momentum is mixed down the Stokes drift gradient, then + ! the Stokes drift must be included in the bulk Richardson number + ! calculation. + Uk = Uk + (0.5*(Waves%Us_x(i,j,k)+Waves%US_x(i-1,j,k)) -surfUs ) + Vk = Vk + (0.5*(Waves%Us_y(i,j,k)+Waves%Us_y(i,j-1,k)) -surfVs ) + endif + deltaU2(k) = Uk**2 + Vk**2 ! pressure, temp, and saln for EOS @@ -1254,6 +1282,19 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) enddo ! k-loop finishes + if (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) then + if (.not.(present(WAVES).and.associated(WAVES))) then + call MOM_error(FATAL,"Trying to use input WAVES information in KPP\n"//& + "without activating USEWAVES") + endif + !For now get Langmuir number based on prev. MLD (otherwise must compute 3d LA) + MLD_GUESS = max( 1., abs(CS%OBLdepthprev(i,j) ) ) + call get_Langmuir_Number( LA, G, GV, MLD_guess, surfFricVel, I, J, & + H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + WAVES%LangNum(i,j)=LA + endif + + ! compute in-situ density call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, 1, 3*G%ke, EOS) @@ -1283,11 +1324,56 @@ subroutine KPP_compute_BLD(CS, G, GV, h, Temp, Salt, u, v, EOS, uStar, buoyFlux) w_s=Ws_1d, & ! (out) Turbulent velocity scale profile (m/s) CVMix_kpp_params_user=CS%KPP_params ) + !Compute CVMix VT2 + Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & + zt_cntr=cellHeight(1:G%ke), & ! Depth of cell center (m) + ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers (m/s) + N_iface=N_1d, & ! Buoyancy frequency at interface (1/s) + CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + !Modify CVMix VT2 + IF (CS%LT_VT2_ENHANCEMENT) then + IF (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then + do k=1,G%ke + LangEnhVT2(k) = CS%KPP_VT2_ENH_FAC + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then + do k=1,G%ke + LangEnhVT2(k) = min(10.,sqrt(1.+(1.5*WAVES%LangNum(i,j))**(-2) + & + (5.4*WAVES%LangNum(i,j))**(-4))) + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_RW16) then + do k=1,G%ke + LangEnhVT2(k) = min(2.25, 1. + 1./WAVES%LangNum(i,j)) + enddo + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_LF17) then + CS%CS=cvmix_get_kpp_real('c_s',CS%KPP_params) + do k=1,G%ke + WST = (max(0.,-buoyflux(i,j,1))*(-cellHeight(k)))**(1./3.) + LangEnhVT2(k) = sqrt((0.15*WST**3. + 0.17*surfFricVel**3.* & + (1.+0.49*WAVES%LangNum(i,j)**(-2.))) / & + (0.2*ws_1d(k)**3/(CS%cs*CS%surf_layer_ext*CS%vonKarman**4.))) + enddo + else + !This shouldn't be reached. + !call MOM_error(WARNING,"Unexpected behavior in MOM_KPP, see error in Vt2") + LangEnhVT2(:) = 1.0 + endif + else + LangEnhVT2(:) = 1.0 + endif + + do k=1,G%ke + Vt2_1d(k)=Vt2_1d(k)*LangEnhVT2(k) + if (CS%id_EnhVt2 > 0) CS%EnhVt2(i,j,k)=LangEnhVT2(k) + enddo + ! Calculate Bulk Richardson number from eq (21) of LMD94 - BulkRi_1d = CVMix_kpp_compute_bulk_Richardson( & - cellHeight(1:G%ke), & ! Depth of cell center (m) - GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) - deltaU2, & ! Square of resolved velocity difference (m2/s2) + BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & + zt_cntr = cellHeight(1:G%ke), & ! Depth of cell center (m) + delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) (1/s) + delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference (m2/s2) + Vt_sqr_cntr=Vt2_1d, & ws_cntr=Ws_1d, & ! Turbulent velocity scale profile (m/s) N_iface=N_1d) ! Buoyancy frequency (1/s) From 90e8f930b1e50ba0b8e3f12c8e00f68a8136978d Mon Sep 17 00:00:00 2001 From: alperaltuntas Date: Wed, 16 May 2018 10:06:48 -0600 Subject: [PATCH 39/53] Update halo OBLdepth before smoothing --- src/parameterizations/vertical/MOM_KPP.F90 | 27 ++++++++++++++-------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 6ae93013ac..f98185685a 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -14,6 +14,7 @@ module MOM_KPP use MOM_grid, only : ocean_grid_type, isPointInCell use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS, Get_Langmuir_Number +use MOM_domains, only : pass_var use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real use CVMix_kpp, only : CVMix_coeffs_kpp @@ -1503,12 +1504,18 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) ! local - real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) - real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_original ! Original OBL depths computed by CVMix + real, dimension( G%ke ) :: cellHeight ! Cell center heights referenced to surface (m) (negative in ocean) + real, dimension( G%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface (m) (negative in ocean) + real :: wc, ww, we, wn, ws ! averaging weights for smoothing + real :: dh ! The local thickness used for calculating interface positions (m) + real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) integer :: i, j, k - real :: wc, ww, we, wn, ws ! averaging weights for smoothing - real :: dh ! The local thickness used for calculating interface positions (m) - real :: hcorr ! A cumulative correction arising from inflation of vanished layers (m) + + ! Update halos + call pass_var(CS%OBLdepth, G%Domain) + + OBLdepth_original = CS%OBLdepth ! apply smoothing on OBL depth do j = G%jsc, G%jec @@ -1524,11 +1531,11 @@ subroutine KPP_smooth_BLD(CS,G,GV,h) wn = 0.125 * G%mask2dT(i,j+1) wc = 1.0 - (ww+we+wn+ws) - CS%OBLdepth(i,j) = wc * CS%OBLdepth(i,j) & - + ww * CS%OBLdepth(i-1,j) & - + we * CS%OBLdepth(i+1,j) & - + ws * CS%OBLdepth(i,j-1) & - + wn * CS%OBLdepth(i,j+1) + CS%OBLdepth(i,j) = wc * OBLdepth_original(i,j) & + + ww * OBLdepth_original(i-1,j) & + + we * OBLdepth_original(i+1,j) & + + ws * OBLdepth_original(i,j-1) & + + wn * OBLdepth_original(i,j+1) enddo enddo From 02acd12398eec40a2f55b73ecfcdbaaa37d8e6b8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 16 May 2018 16:11:13 -0600 Subject: [PATCH 40/53] Doxygenize subroutine differential_diffuse_T_S --- .../vertical/MOM_diabatic_aux.F90 | 22 ++++++------------- 1 file changed, 7 insertions(+), 15 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 9588ac3a5c..82799d531a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -239,25 +239,17 @@ subroutine make_frazil(h, tv, G, GV, CS, p_surf) end subroutine make_frazil +!> Applies double diffusion to T & S, assuming no diapycal mass +!! fluxes, using a simple triadiagonal solver. subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) 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)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(vertvisc_type), intent(in) :: visc - real, intent(in) :: dt - -! This subroutine applies double diffusion to T & S, assuming no diapycal mass -! fluxes, using a simple triadiagonal solver. - -! Arguments: h - Layer thickness, in m or kg m-2. -! (in) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) visc - A structure containing vertical viscosities, bottom boundary -! layer properies, and related fields. -! (in) dt - Time increment, in s. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. + type(thermo_var_ptrs), intent(inout) :: tv !< pointers to any available modynamic fields. + !! Absent fields have NULL ptrs. + type(vertvisc_type), intent(in) :: visc !< structure containing vertical viscosities, + !! layer properies, and related fields. + real, intent(in) :: dt !< Time increment, in s. real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. From 507d34e350a3566cfd68bf15899f889f1b955e63 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Thu, 17 May 2018 16:35:53 -0600 Subject: [PATCH 41/53] First version of Double-diffusion via CVMix * Delete the old double-diffusion code --- .../vertical/MOM_cvmix_ddiff.F90 | 314 ++++++++++++++++++ .../vertical/MOM_diabatic_driver.F90 | 26 +- .../vertical/MOM_set_diffusivity.F90 | 282 +++------------- .../vertical/MOM_set_viscosity.F90 | 18 +- 4 files changed, 384 insertions(+), 256 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_cvmix_ddiff.F90 diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 new file mode 100644 index 0000000000..8e52c39849 --- /dev/null +++ b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 @@ -0,0 +1,314 @@ +!> Interface to CVMix double diffusion scheme. +module MOM_CVMix_ddiff + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field +use MOM_diag_mediator, only : post_data +use MOM_EOS, only : calculate_density_derivs +use MOM_variables, only : thermo_var_ptrs +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : openParameterBlock, closeParameterBlock +use MOM_debugging, only : hchksum +use MOM_grid, only : ocean_grid_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use cvmix_ddiff, only : cvmix_init_ddiff, CVMix_coeffs_ddiff +use cvmix_kpp, only : CVmix_kpp_compute_kOBL_depth +implicit none ; private + +#include + +public CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_is_used, compute_ddiff_coeffs + +!> Control structure including parameters for CVMix double diffusion. +type, public :: CVMix_ddiff_cs + + ! Parameters + real :: strat_param_max !< maximum value for the stratification parameter (nondim) + real :: kappa_ddiff_s !< leading coefficient in formula for salt-fingering regime + !! for salinity diffusion (m^2/s) + real :: ddiff_exp1 !< interior exponent in salt-fingering regime formula (nondim) + real :: ddiff_exp2 !< exterior exponent in salt-fingering regime formula (nondim) + real :: mol_diff !< molecular diffusivity (m^2/s) + real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime (nondim) + real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime (nondim) + real :: min_thickness !< Minimum thickness allowed (m) + character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & + !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") + logical :: debug !< If true, turn on debugging + + ! Daignostic handles and pointers + type(diag_ctrl), pointer :: diag => NULL() + integer :: id_KT_extra = -1, id_KS_extra = -1, id_R_rho = -1 + + ! Diagnostics arrays + real, allocatable, dimension(:,:,:) :: KT_extra !< double diffusion diffusivity for temp (m2/s) + real, allocatable, dimension(:,:,:) :: KS_extra !< double diffusion diffusivity for salt (m2/s) + real, allocatable, dimension(:,:,:) :: R_rho !< double-diffusion density ratio (nondim) + +end type CVMix_ddiff_cs + +character(len=40) :: mdl = "MOM_CVMix_ddiff" !< This module's name. + +contains + +!> Initialized the CVMix double diffusion module. +logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) + + type(time_type), intent(in) :: Time !< The current time. + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. + type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. + + ! Local variables +! real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. + +! This include declares and sets the variable "version". +#include "version_variable.h" + + if (associated(CS)) then + call MOM_error(WARNING, "CVMix_ddiff_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + ! Read parameters + call log_version(param_file, mdl, version, & + "Parameterization of mixing due to double diffusion processes via CVMix") + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_init, & + "If true, turns on double diffusive processes via CVMix. \n"// & + "Note that double diffusive processes on viscosity are ignored \n"// & + "in CVMix, see http://cvmix.github.io/ for justification.",& + default=.false.) + + if (.not. CVMix_ddiff_init) return + + call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + + call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, default=0.001, do_not_log=.True.) + + call openParameterBlock(param_file,'CVMIX_DDIFF') + + call get_param(param_file, mdl, "STRAT_PARAM_MAX", CS%strat_param_max, & + "The maximum value for the double dissusion stratification parameter", & + units="nondim", default=2.55) + + call get_param(param_file, mdl, "KAPPA_DDIFF_S", CS%kappa_ddiff_s, & + "Leading coefficient in formula for salt-fingering regime \n"// & + "for salinity diffusion.", units="m2 s-1", default=1.0e-4) + + call get_param(param_file, mdl, "DDIFF_EXP1", CS%ddiff_exp1, & + "Interior exponent in salt-fingering regime formula.", & + units="nondim", default=1.0) + + call get_param(param_file, mdl, "DDIFF_EXP2", CS%ddiff_exp2, & + "Exterior exponent in salt-fingering regime formula.", & + units="nondim", default=3.0) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM1", CS%kappa_ddiff_param1, & + "Exterior coefficient in diffusive convection regime.", & + units="nondim", default=0.909) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM2", CS%kappa_ddiff_param2, & + "Middle coefficient in diffusive convection regime.", & + units="nondim", default=4.6) + + call get_param(param_file, mdl, "KAPPA_DDIFF_PARAM3", CS%kappa_ddiff_param3, & + "Interior coefficient in diffusive convection regime.", & + units="nondim", default=-0.54) + + call get_param(param_file, mdl, "MOL_DIFF", CS%mol_diff, & + "Molecular diffusivity used in CVMix double diffusion.", & + units="m2 s-1", default=1.5e-6) + + call get_param(param_file, mdl, "DIFF_CONV_TYPE", CS%diff_conv_type, & + "type of diffusive convection to use. Options are Marmorino \n" //& + "and Caldwell 1976 (MC76) and Kelley 1988, 1990 (K90).", & + default="MC76") + + call closeParameterBlock(param_file) + + ! allocate arrays and set them to zero + ! GMM, dont need the following + !allocate(CS%KT_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KT_extra(:,:,:) = 0. + !allocate(CS%KS_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KS_extra(:,:,:) = 0. + + ! Register diagnostics + 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') + + CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & + 'Double-diffusive diffusivity for salinity', 'm2 s-1') + + CS%id_R_rho = register_diag_field('ocean_model','R_rho',diag%axesTi,Time, & + 'Double-diffusion density ratio', 'nondim') + if (CS%id_R_rho > 0) & + allocate(CS%R_rho( SZI_(G), SZJ_(G), SZK_(G)+1)); CS%R_rho(:,:,:) = 0.0 + + call cvmix_init_ddiff(strat_param_max=CS%strat_param_max, & + kappa_ddiff_s=CS%kappa_ddiff_s, & + ddiff_exp1=CS%ddiff_exp1, & + ddiff_exp2=CS%ddiff_exp2, & + mol_diff=CS%mol_diff, & + kappa_ddiff_param1=CS%kappa_ddiff_param1, & + kappa_ddiff_param2=CS%kappa_ddiff_param2, & + kappa_ddiff_param3=CS%kappa_ddiff_param3, & + diff_conv_type=CS%diff_conv_type) + +end function CVMix_ddiff_init + +!> Subroutine for computing vertical diffusion coefficients for the +!! double diffusion mixing parameterization. +subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) + + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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 +! real, dimension(:,:,:), pointer :: Kd_T +! real, dimension(:,:,:), pointer :: Kd_S + !! diffusivity for temp (m2/sec). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal + !! diffusivity for salt (m2/sec). + 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. +! real, dimension(:,:), optional, pointer :: hbl !< Depth of ocean boundary layer (m) + + ! local variables + real, dimension(SZK_(G)) :: & + cellHeight, & !< Height of cell centers (m) + dRho_dT, & !< partial derivatives of density wrt temp (kg m-3 degC-1) + dRho_dS, & !< partial derivatives of density wrt saln (kg m-3 PPT-1) + pres_int, & !< pressure at each interface (Pa) + temp_int, & !< temp and at interfaces (degC) + salt_int, & !< salt at at interfaces + alpha_dT, & !< alpha*dT across interfaces + beta_dS, & !< beta*dS across interfaces + dT, & !< temp. difference between adjacent layers (degC) + dS !< salt difference between adjacent layers + + real, dimension(SZK_(G)+1) :: iFaceHeight !< Height of interfaces (m) + integer :: kOBL !< level of OBL extent + real :: pref, g_o_rho0, rhok, rhokm1, dz, dh, hcorr + integer :: i, k + + ! initialize dummy variables + pres_int(:) = 0.0; temp_int(:) = 0.0; salt_int(:) = 0.0 + alpha_dT(:) = 0.0; beta_dS(:) = 0.0; dRho_dT(:) = 0.0 + dRho_dS(:) = 0.0; dT(:) = 0.0; dS(:) = 0.0 + + ! set Kd_T and Kd_S to zero to avoid passing values from previous call + Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 + + ! GMM, check this. + !if (.not. associated(hbl)) then + ! allocate(hbl(SZI_(G), SZJ_(G))); + ! hbl(:,:) = 0.0 + !endif + + do i = G%isc, G%iec + + ! skip calling at land points + if (G%mask2dT(i,j) == 0.) cycle + + pRef = 0. + pres_int(1) = pRef + ! we don't have SST and SSS, so let's use values at top-most layer + temp_int(1) = TV%T(i,j,1); salt_int(1) = TV%S(i,j,1) + do k=2,G%ke + ! pressure at interface + pres_int(k) = pRef + GV%H_to_Pa * h(i,j,k-1) + ! temp and salt at interface + ! for temp: (t1*h1 + t2*h2)/(h1+h2) + temp_int(k) = (TV%T(i,j,k-1)*h(i,j,k-1) + TV%T(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + salt_int(k) = (TV%S(i,j,k-1)*h(i,j,k-1) + TV%S(i,j,k)*h(i,j,k))/(h(i,j,k-1)+h(i,j,k)) + ! dT and dS + dT(k) = (TV%T(i,j,k-1)-TV%T(i,j,k)) + dS(k) = (TV%S(i,j,k-1)-TV%S(i,j,k)) + pRef = pRef + GV%H_to_Pa * h(i,j,k-1) + enddo ! k-loop finishes + + call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) + + ! GMM, explain need for -1 in front of alpha + ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case + ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + do k=1,G%ke + alpha_dT(k) = -1.0*drho_dT(k) * dT(k) + beta_dS(k) = drho_dS(k) * dS(k) + enddo + + if (CS%id_R_rho > 0.0) then + do k=1,G%ke + CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) + enddo + endif + + iFaceHeight(1) = 0.0 ! BBL is all relative to the surface + hcorr = 0.0 + ! compute heights at cell center and interfaces + do k=1,G%ke + dh = h(i,j,k) * GV%H_to_m ! Nominal thickness to use for increment + dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) + hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh + enddo + + ! gets index of the level and interface above hbl + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight,hbl(i,j)) + + call CVMix_coeffs_ddiff(Tdiff_out=Kd_T(i,j,:), & + Sdiff_out=Kd_S(i,j,:), & + strat_param_num=alpha_dT(:), & + strat_param_denom=beta_dS(:), & + nlev=G%ke, & + max_nlev=G%ke) + + !if (is_root_pe()) then + ! write(*,*)'drho_dT, alpha_dT', & + ! drho_dT(:), alpha_dT(:) + ! write(*,*)'drho_dS, beta_dS', & + ! drho_dS(:), beta_dS(:) + !endif + + ! Do not apply mixing due to convection within the boundary layer + !do k=1,kOBL + ! Kd_T(i,j,k) = 0.0 + ! Kd_S(i,j,k) = 0.0 + !enddo + + enddo ! i-loop + +end subroutine compute_ddiff_coeffs + +!> Reads the parameter "USE_CVMIX_DDIFF" and returns state. +!! This function allows other modules to know whether this parameterization will +!! be used without needing to duplicate the log entry. +logical function CVMix_ddiff_is_used(param_file) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + call get_param(param_file, mdl, "USE_CVMIX_DDIFF", CVMix_ddiff_is_used, & + default=.false., do_not_log = .true.) + +end function CVMix_ddiff_is_used + +!> Clear pointers and dealocate memory +subroutine CVMix_ddiff_end(CS) + type(CVMix_ddiff_cs), pointer :: CS ! Control structure + + deallocate(CS) + +end subroutine CVMix_ddiff_end + + +end module MOM_CVMix_ddiff diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index eea1eba16a..b109d3642a 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -9,7 +9,8 @@ module MOM_diabatic_driver use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats 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_CVMix_shear, only : cvmix_shear_is_used +use MOM_CVMix_shear, only : CVMix_shear_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used 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 @@ -90,8 +91,9 @@ module MOM_diabatic_driver !! in the surface boundary layer. logical :: use_kappa_shear !< If true, use the kappa_shear module to find the !! shear-driven diapycnal diffusivity. - logical :: use_cvmix_shear !< If true, use the CVMix module to find the + logical :: use_CVMix_shear !< If true, use the CVMix module to find the !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. @@ -244,7 +246,7 @@ module MOM_diabatic_driver 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 +integer :: id_clock_kpp, id_clock_CVMix_ddiff contains @@ -721,10 +723,10 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G ! a diffusivity and happen before KPP. But generally in MOM, we do not match ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. 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 cpu_clock_begin(id_clock_CVMix_ddiff) call differential_diffuse_T_S(h, tv, visc, dt, G, GV) - call cpu_clock_end(id_clock_differential_diff) + call cpu_clock_end(id_clock_CVMix_ddiff) 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) @@ -737,7 +739,6 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G enddo ; enddo ; enddo endif - endif @@ -1872,7 +1873,7 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, real :: Kd integer :: num_mode - logical :: use_temperature, differentialDiffusion + logical :: use_temperature type(vardesc) :: vd ! This "include" declares and sets the variable "version". @@ -1924,11 +1925,10 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, "If true, the diffusivity from ePBL is added to all\n"//& "other diffusivities. Otherwise, the larger of kappa-\n"//& "shear and ePBL diffusivities are used.", default=.true.) - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differentialDiffusion, & - "If true, apply parameterization of double-diffusion.", & - default=.false. ) + CS%use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) CS%use_kappa_shear = kappa_shear_is_used(param_file) - CS%use_cvmix_shear = cvmix_shear_is_used(param_file) + CS%use_CVMix_shear = CVMix_shear_is_used(param_file) + if (CS%bulkmixedlayer) then call get_param(param_file, mod, "ML_MIX_FIRST", CS%ML_mix_first, & "The fraction of the mixed layer mixing that is applied \n"//& @@ -2384,8 +2384,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, id_clock_sponge = cpu_clock_id('(Ocean sponges)', grain=CLOCK_MODULE) id_clock_tridiag = cpu_clock_id('(Ocean diabatic tridiag)', grain=CLOCK_ROUTINE) id_clock_pass = cpu_clock_id('(Ocean diabatic message passing)', grain=CLOCK_ROUTINE) - id_clock_differential_diff = -1 ; if (differentialDiffusion) & - id_clock_differential_diff = cpu_clock_id('(Ocean differential diffusion)', grain=CLOCK_ROUTINE) + id_clock_CVMix_ddiff = -1 ; if (CS%use_CVMix_ddiff) & + id_clock_CVMix_ddiff = cpu_clock_id('(Double diffusion)', grain=CLOCK_ROUTINE) ! initialize the auxiliary diabatic driver module call diabatic_aux_init(Time, G, GV, param_file, diag, CS%diabatic_aux_CSp, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index b9905977d5..f33bdea2a8 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -21,8 +21,10 @@ module MOM_set_diffusivity use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, vardesc, var_desc, MOM_read_data use MOM_kappa_shear, only : calculate_kappa_shear, kappa_shear_init, Kappa_shear_CS -use MOM_cvmix_shear, only : calculate_cvmix_shear, cvmix_shear_init, cvmix_shear_cs -use MOM_cvmix_shear, only : cvmix_shear_end +use MOM_CVMix_shear, only : calculate_CVMix_shear, CVMix_shear_init, CVMix_shear_cs +use MOM_CVMix_shear, only : CVMix_shear_end +use MOM_CVMix_ddiff, only : CVMix_ddiff_init, CVMix_ddiff_end, CVMix_ddiff_cs +use MOM_CVMix_ddiff, only : compute_ddiff_coeffs use MOM_bkgnd_mixing, only : calculate_bkgnd_mixing, bkgnd_mixing_init, bkgnd_mixing_cs use MOM_bkgnd_mixing, only : bkgnd_mixing_end, sfc_bkgnd_mixing use MOM_string_functions, only : uppercase @@ -129,18 +131,16 @@ module MOM_set_diffusivity ! shear-driven diapycnal diffusivity. logical :: use_cvmix_shear ! If true, use one of the CVMix modules to find ! shear-driven diapycnal diffusivity. - logical :: double_diffusion ! If true, enable double-diffusive mixing. + logical :: use_CVMix_ddiff ! If true, enable double-diffusive mixing via CVMix. logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that ! does not rely on a layer-formulation. - real :: Max_Rrho_salt_fingers ! max density ratio for salt fingering - real :: Max_salt_diff_salt_fingers ! max salt diffusivity for salt fingers (m2/s) - real :: Kv_molecular ! molecular visc for double diff convect (m2/s) character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(Kappa_shear_CS), pointer :: kappaShear_CSp => NULL() - type(cvmix_shear_cs), pointer :: cvmix_shear_csp => NULL() + type(CVMix_shear_cs), pointer :: CVMix_shear_csp => NULL() + type(CVMix_ddiff_cs), pointer :: CVMix_ddiff_csp => NULL() type(bkgnd_mixing_cs), pointer :: bkgnd_mixing_csp => NULL() type(int_tide_CS), pointer :: int_tide_CSp => NULL() type(tidal_mixing_cs), pointer :: tm_csp => NULL() @@ -158,11 +158,6 @@ module MOM_set_diffusivity integer :: id_N2 = -1 integer :: id_N2_z = -1 - integer :: id_KT_extra = -1 - integer :: id_KS_extra = -1 - integer :: id_KT_extra_z = -1 - integer :: id_KS_extra_z = -1 - end type set_diffusivity_CS type diffusivity_diags @@ -172,12 +167,9 @@ module MOM_set_diffusivity Kd_BBL => NULL(),& ! BBL diffusivity at interfaces (m2/s) Kd_work => NULL(),& ! layer integrated work by diapycnal mixing (W/m2) maxTKE => NULL(),& ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd => NULL(),& ! conversion rate (~1.0 / (G_Earth + dRho_lay)) + TKE_to_Kd => NULL() ! conversion rate (~1.0 / (G_Earth + dRho_lay)) ! between TKE dissipated within a layer and Kd ! in that layer, in m2 s-1 / m3 s-3 = s2 m-1 - KT_extra => NULL(),& ! double diffusion diffusivity for temp (m2/s) - KS_extra => NULL() ! double diffusion diffusivity for saln (m2/s) - end type diffusivity_diags ! Clocks @@ -226,17 +218,15 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! massless layers filled vertically by diffusion. real, dimension(SZI_(G),SZK_(G)) :: & - N2_lay, & ! squared buoyancy frequency associated with layers (1/s2) - maxTKE, & ! energy required to entrain to h_max (m3/s3) - TKE_to_Kd ! conversion rate (~1.0 / (G_Earth + dRho_lay)) between - ! TKE dissipated within a layer and Kd in that layer, in - ! m2 s-1 / m3 s-3 = s2 m-1. + N2_lay, & !< squared buoyancy frequency associated with layers (1/s2) + maxTKE, & !< energy required to entrain to h_max (m3/s3) + TKE_to_Kd !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between + !< TKE dissipated within a layer and Kd in that layer, in + !< m2 s-1 / m3 s-3 = s2 m-1. real, dimension(SZI_(G),SZK_(G)+1) :: & - N2_int, & ! squared buoyancy frequency associated at interfaces (1/s2) - dRho_int, & ! locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? - KT_extra, & ! double difusion diffusivity on temperature (m2/sec) - KS_extra ! double difusion diffusivity on salinity (m2/sec) + N2_int, & !< squared buoyancy frequency associated at interfaces (1/s2) + dRho_int !< locally ref potential density difference across interfaces (in s-2) smg: or kg/m3? real :: I_Rho0 ! inverse of Boussinesq density (m3/kg) real :: dissip ! local variable for dissipation calculations (W/m3) @@ -271,10 +261,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & use_EOS = associated(tv%eqn_of_state) - if ((CS%double_diffusion) .and. & + if ((CS%use_CVMix_ddiff) .and. & .not.(associated(visc%Kd_extra_T) .and. associated(visc%Kd_extra_S)) ) & call MOM_error(FATAL, "set_diffusivity: visc%Kd_extra_T and "//& - "visc%Kd_extra_S must be associated when DOUBLE_DIFFUSION is true.") + "visc%Kd_extra_S must be associated when USE_CVMIX_DDIFF is true.") ! Set Kd, Kd_int and Kv_slow to constant values. ! If nothing else is specified, this will be the value used. @@ -299,12 +289,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%id_TKE_to_Kd > 0) then allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 endif - if ((CS%id_KT_extra > 0) .or. (CS%id_KT_extra_z > 0)) then - allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 - endif - if ((CS%id_KS_extra > 0) .or. (CS%id_KS_extra_z > 0)) then - allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 - endif if ((CS%id_Kd_BBL > 0) .or. (CS%id_Kd_BBL_z > 0)) then allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 endif @@ -376,35 +360,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo endif - ! add background mixing + ! Add background mixing call calculate_bkgnd_mixing(h, tv, N2_lay, Kd, visc%Kv_slow, j, G, GV, CS%bkgnd_mixing_csp) - ! GMM, the following will go into the MOM_cvmix_double_diffusion module - if (CS%double_diffusion) then - call double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, KT_extra, KS_extra) - do K=2,nz ; do i=is,ie - if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering - Kd(i,j,k-1) = Kd(i,j,k-1) + 0.5*KT_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*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(i,j,k-1) = Kd(i,j,k-1) + 0.5*KS_extra(i,K) - Kd(i,j,k) = Kd(i,j,k) + 0.5*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 - visc%Kd_extra_S(i,j,k) = 0.0 - endif - enddo; enddo - if (associated(dd%KT_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KT_extra(i,j,K) = KT_extra(i,K) - enddo ; enddo ; endif - - if (associated(dd%KS_extra)) then ; do K=1,nz+1 ; do i=is,ie - dd%KS_extra(i,j,K) = KS_extra(i,K) - enddo ; enddo ; endif + ! Apply double diffusion + ! GMM, we need to pass HBL to compute_ddiff_coeffs, but it is not yet available. + if (CS%use_CVMix_ddiff) then + call compute_ddiff_coeffs(h, tv, G, GV, j, visc%Kd_extra_T, visc%Kd_extra_S, CS%CVMix_ddiff_csp) endif ! Add the input turbulent diffusivity. @@ -502,6 +464,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) + if (CS%use_CVMix_ddiff) then + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + 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.) @@ -539,17 +506,27 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif ! post diagnostics + + ! background mixing if (CS%bkgnd_mixing_csp%id_kd_bkgnd > 0) & call post_data(CS%bkgnd_mixing_csp%id_kd_bkgnd, CS%bkgnd_mixing_csp%kd_bkgnd, CS%bkgnd_mixing_csp%diag) if (CS%bkgnd_mixing_csp%id_kv_bkgnd > 0) & call post_data(CS%bkgnd_mixing_csp%id_kv_bkgnd, CS%bkgnd_mixing_csp%kv_bkgnd, CS%bkgnd_mixing_csp%diag) - if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + ! double diffusive mixing + if (CS%CVMix_ddiff_csp%id_KT_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KT_extra, visc%Kd_extra_T, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_KS_extra > 0) & + call post_data(CS%CVMix_ddiff_csp%id_KS_extra, visc%Kd_extra_S, CS%CVMix_ddiff_csp%diag) + if (CS%CVMix_ddiff_csp%id_R_rho > 0) & + call post_data(CS%CVMix_ddiff_csp%id_R_rho, CS%CVMix_ddiff_csp%R_rho, CS%CVMix_ddiff_csp%diag) - num_z_diags = 0 + if (CS%id_Kd_layer > 0) call post_data(CS%id_Kd_layer, Kd, CS%diag) + ! tidal mixing call post_tidal_diagnostics(G,GV,h,CS%tm_csp) + num_z_diags = 0 if (CS%tm_csp%Int_tide_dissipation .or. CS%tm_csp%Lee_wave_dissipation .or. & CS%tm_csp%Lowmode_itidal_dissipation) then @@ -573,26 +550,11 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & endif - if (CS%id_KT_extra > 0) call post_data(CS%id_KT_extra, dd%KT_extra, CS%diag) - if (CS%id_KS_extra > 0) call post_data(CS%id_KS_extra, dd%KS_extra, CS%diag) if (CS%id_Kd_BBL > 0) call post_data(CS%id_Kd_BBL, dd%Kd_BBL, CS%diag) - if (CS%id_KT_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KT_extra_z - z_ptrs(num_z_diags)%p => dd%KT_extra - endif - - if (CS%id_KS_extra_z > 0) then - num_z_diags = num_z_diags + 1 - z_ids(num_z_diags) = CS%id_KS_extra_z - z_ptrs(num_z_diags)%p => dd%KS_extra - endif - if (CS%id_Kd_BBL_z > 0) then num_z_diags = num_z_diags + 1 z_ids(num_z_diags) = CS%id_Kd_BBL_z - z_ptrs(num_z_diags)%p => dd%KS_extra endif if (num_z_diags > 0) & @@ -603,8 +565,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (associated(dd%Kd_user)) deallocate(dd%Kd_user) if (associated(dd%maxTKE)) deallocate(dd%maxTKE) if (associated(dd%TKE_to_Kd)) deallocate(dd%TKE_to_Kd) - if (associated(dd%KT_extra)) deallocate(dd%KT_extra) - if (associated(dd%KS_extra)) deallocate(dd%KS_extra) if (associated(dd%Kd_BBL)) deallocate(dd%Kd_BBL) if (showCallTree) call callTree_leave("set_diffusivity()") @@ -956,119 +916,6 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, CS, dRho_int, & end subroutine find_N2 -! GMM, the following will be moved to a new module - -!> This subroutine sets the additional diffusivities of temperature and -!! salinity due to double diffusion, using the same functional form as is -!! used in MOM4.1, and taken from an NCAR technical note (REF?) that updates -!! what was in Large et al. (1994). All the coefficients here should probably -!! be made run-time variables rather than hard-coded constants. -!! -!! \todo Find reference for NCAR tech note above. -subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, CS, Kd_T_dd, Kd_S_dd) - 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(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available - !! thermodynamic fields; absent fields have NULL - !! ptrs. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: T_f !< layer temp in C with the values in massless layers - !! filled vertically by diffusion. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: S_f !< Layer salinities in PPT with values in massless - !! layers filled vertically by diffusion. - integer, intent(in) :: j !< Meridional index upon which to work. - type(set_diffusivity_CS), pointer :: CS !< Module control structure. - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp (m2/sec). - real, dimension(SZI_(G),SZK_(G)+1), & - intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln (m2/sec). - -! Arguments: -! (in) tv - structure containing pointers to any available -! thermodynamic fields; absent fields have NULL ptrs -! (in) h - layer thickness (m or kg m-2) -! (in) T_f - layer temp in C with the values in massless layers -! filled vertically by diffusion -! (in) S_f - layer salinities in PPT with values in massless layers -! filled vertically by diffusion -! (in) G - ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) CS - module control structure -! (in) j - meridional index upon which to work -! (out) Kd_T_dd - interface double diffusion diapycnal diffusivity for temp (m2/sec) -! (out) Kd_S_dd - interface double diffusion diapycnal diffusivity for saln (m2/sec) - -! This subroutine sets the additional diffusivities of temperature and -! salinity due to double diffusion, using the same functional form as is -! used in MOM4.1, and taken from an NCAR technical note (###REF?) that updates -! what was in Large et al. (1994). All the coefficients here should probably -! be made run-time variables rather than hard-coded constants. - - real, dimension(SZI_(G)) :: & - dRho_dT, & ! partial derivatives of density wrt temp (kg m-3 degC-1) - dRho_dS, & ! partial derivatives of density wrt saln (kg m-3 PPT-1) - pres, & ! pressure at each interface (Pa) - Temp_int, & ! temp and saln at interfaces - Salin_int - - real :: alpha_dT ! density difference between layers due to temp diffs (kg/m3) - real :: beta_dS ! density difference between layers due to saln diffs (kg/m3) - - real :: Rrho ! vertical density ratio - real :: diff_dd ! factor for double-diffusion - real :: prandtl ! flux ratio for diffusive convection regime - - real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio - real, parameter :: dsfmax = 1.e-4 ! max diffusivity in case of salt fingering - real, parameter :: Kv_molecular = 1.5e-6 ! molecular viscosity (m2/sec) - - integer :: i, k, is, ie, nz - is = G%isc ; ie = G%iec ; nz = G%ke - - if (associated(tv%eqn_of_state)) then - do i=is,ie - pres(i) = 0.0 ; Kd_T_dd(i,1) = 0.0 ; Kd_S_dd(i,1) = 0.0 - Kd_T_dd(i,nz+1) = 0.0 ; Kd_S_dd(i,nz+1) = 0.0 - enddo - do K=2,nz - do i=is,ie - pres(i) = pres(i) + GV%H_to_Pa*h(i,j,k-1) - Temp_Int(i) = 0.5 * (T_f(i,j,k-1) + T_f(i,j,k)) - Salin_Int(i) = 0.5 * (S_f(i,j,k-1) + S_f(i,j,k)) - enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, & - dRho_dT(:), dRho_dS(:), is, ie-is+1, tv%eqn_of_state) - - do i=is,ie - alpha_dT = -1.0*dRho_dT(i) * (T_f(i,j,k-1) - T_f(i,j,k)) - beta_dS = dRho_dS(i) * (S_f(i,j,k-1) - S_f(i,j,k)) - - if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - Rrho = min(alpha_dT/beta_dS,Rrho0) - diff_dd = 1.0 - ((RRho-1.0)/(RRho0-1.0)) - diff_dd = dsfmax*diff_dd*diff_dd*diff_dd - Kd_T_dd(i,K) = 0.7*diff_dd - Kd_S_dd(i,K) = diff_dd - elseif ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection - Rrho = alpha_dT/beta_dS - diff_dd = Kv_molecular*0.909*exp(4.6*exp(-0.54*(1/Rrho-1))) - prandtl = 0.15*Rrho - if (Rrho > 0.5) prandtl = (1.85-0.85/Rrho)*Rrho - Kd_T_dd(i,K) = diff_dd - Kd_S_dd(i,K) = prandtl*diff_dd - else - Kd_T_dd(i,K) = 0.0 ; Kd_S_dd(i,K) = 0.0 - endif - enddo - enddo - endif - -end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & maxTKE, kb, G, GV, CS, Kd, Kd_int, Kd_BBL) @@ -2079,45 +1926,6 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - - ! GMM, the following should be moved to the DD module - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) - if (CS%double_diffusion) then - call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & - "Maximum density ratio for salt fingering regime.", & - default=2.55, units="nondim") - call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & - "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1") - call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & - "Molecular viscosity for calculation of fluxes under \n"//& - "double-diffusive convection.", default=1.5e-6, units="m2 s-1") - ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. - - CS%id_KT_extra = register_diag_field('ocean_model','KT_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1') - - CS%id_KS_extra = register_diag_field('ocean_model','KS_extra',diag%axesTi,Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1') - - if (associated(diag_to_Z_CSp)) then - vd = var_desc("KT_extra", "m2 s-1", & - "Double-Diffusive Temperature Diffusivity, interpolated to z", & - z_grid='z') - CS%id_KT_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("KS_extra", "m2 s-1", & - "Double-Diffusive Salinity Diffusivity, interpolated to z",& - z_grid='z') - CS%id_KS_extra_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - vd = var_desc("Kd_BBL", "m2 s-1", & - "Bottom Boundary Layer Diffusivity", z_grid='z') - CS%id_Kd_BBL_z = register_Zint_diag(vd, CS%diag_to_Z_CSp, Time) - endif - endif - if (CS%user_change_diff) then call user_change_diff_init(Time, G, param_file, diag, CS%user_change_diff_CSp) endif @@ -2131,7 +1939,10 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp id_clock_kappaShear = cpu_clock_id('(Ocean kappa_shear)', grain=CLOCK_MODULE) ! CVMix shear-driven mixing - CS%use_cvmix_shear = cvmix_shear_init(Time, G, GV, param_file, CS%diag, CS%cvmix_shear_csp) + CS%use_CVMix_shear = CVMix_shear_init(Time, G, GV, param_file, CS%diag, CS%CVMix_shear_csp) + + ! CVMix double diffusion mixing + CS%use_CVMix_ddiff = CVMix_ddiff_init(Time, G, GV, param_file, CS%diag, CS%CVMix_ddiff_csp) end subroutine set_diffusivity_init @@ -2146,8 +1957,11 @@ subroutine set_diffusivity_end(CS) if (CS%user_change_diff) & call user_change_diff_end(CS%user_change_diff_CSp) - if (CS%use_cvmix_shear) & - call cvmix_shear_end(CS%cvmix_shear_csp) + if (CS%use_CVMix_shear) & + call CVMix_shear_end(CS%CVMix_shear_csp) + + if (CS%use_CVMix_ddiff) & + call CVMix_ddiff_end(CS%CVMix_ddiff_csp) if (associated(CS)) deallocate(CS) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 18eb80f280..ee18094f7e 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -46,6 +46,7 @@ module MOM_set_visc use MOM_kappa_shear, only : kappa_shear_is_used use MOM_cvmix_shear, only : cvmix_shear_is_used use MOM_cvmix_conv, only : cvmix_conv_is_used +use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_io, only : vardesc, var_desc use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs @@ -1791,7 +1792,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) - use_kappa_shear = .false. ; use_cvmix_shear = .false. ; + use_kappa_shear = .false. ; use_cvmix_shear = .false. useKPP = .false. ; useEPBL = .false. ; use_cvmix_conv = .false. ; if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) @@ -1870,7 +1871,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) real :: Kv_background real :: omega_frac_dflt integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, i, j, n - logical :: use_kappa_shear, adiabatic, differential_diffusion, use_omega + logical :: use_kappa_shear, adiabatic, use_omega + logical :: use_CVMix_ddiff type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" @@ -1893,8 +1895,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) ! Set default, read and log parameters call log_version(param_file, mdl, version, "") - CS%RiNo_mix = .false. - use_kappa_shear = .false. ; differential_diffusion = .false. !; adiabatic = .false. ! Needed? -AJA + CS%RiNo_mix = .false. ; use_CVMix_ddiff = .false. + use_kappa_shear = .false. !; adiabatic = .false. ! Needed? -AJA call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& @@ -1921,11 +1923,9 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear - call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & - "If true, increase diffusivitives for temperature or salt \n"//& - "based on double-diffusive paramaterization from MOM4/KPP.", & - default=.false.) + use_CVMix_ddiff = CVMix_ddiff_is_used(param_file) endif + call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0) @@ -2067,7 +2067,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) Time, 'Rayleigh drag velocity at v points', 'm s-1') endif - if (differential_diffusion) then + if (use_CVMix_ddiff) then allocate(visc%Kd_extra_T(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_T = 0.0 allocate(visc%Kd_extra_S(isd:ied,jsd:jed,nz+1)) ; visc%Kd_extra_S = 0.0 endif From 81265e64ae209c0685de5d8b1cfbe22049533b61 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 08:09:41 -0600 Subject: [PATCH 42/53] Doxygenize MOM_diabatic_aux --- .../vertical/MOM_diabatic_aux.F90 | 132 +++++++----------- 1 file changed, 52 insertions(+), 80 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 82799d531a..89d16f8e87 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -340,27 +340,23 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) end subroutine differential_diffuse_T_S +!> Keep salinity from falling below a small but positive threshold +!! This occurs when the ice model attempts to extract more salt then +!! is actually available to it from the ocean. subroutine adjust_salt(h, tv, G, GV, 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(diabatic_aux_CS), intent(in) :: CS - -! Keep salinity from falling below a small but positive threshold -! This occurs when the ice model attempts to extract more salt then -! is actually available to it from the ocean. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. - real :: salt_add_col(SZI_(G),SZJ_(G)) ! The accumulated salt requirement - real :: S_min ! The minimum salinity - real :: mc ! A layer's mass kg m-2 . + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to any + !! available thermodynamic fields. + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by + !! a previous call to diabatic_driver_init. + + ! local variables + real :: salt_add_col(SZI_(G),SZJ_(G)) !< The accumulated salt requirement + real :: S_min !< The minimum salinity + real :: mc !< A layer's mass kg m-2 . integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -402,33 +398,29 @@ subroutine adjust_salt(h, tv, G, GV, CS) end subroutine adjust_salt +!> Insert salt from brine rejection into the first layer below +!! the mixed layer which both contains mass and in which the +!! change in layer density remains stable after the addition +!! of salt via brine rejection. subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) 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)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(inout) :: tv - type(forcing), intent(in) :: fluxes - integer, intent(in) :: nkmb - type(diabatic_aux_CS), intent(in) :: CS - real, intent(in) :: dt + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m + !! or kg m-2) + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to + !! any available hermodynamic fields. + type(forcing), intent(in) :: fluxes !< tructure containing pointers + !! any possible forcing fields + integer, intent(in) :: nkmb !< number of layers in the mixed and + !! buffer layers + type(diabatic_aux_CS), intent(in) :: CS !< control structure returned by a + !! previous call to diabatic_driver_init. + real, intent(in) :: dt !< time step between calls to this + !! function (s) ?? integer, intent(in) :: id_brine_lay -! Insert salt from brine rejection into the first layer below -! the mixed layer which both contains mass and in which the -! change in layer density remains stable after the addition -! of salt via brine rejection. - -! Arguments: h - Layer thickness, in m. -! (in/out) tv - A structure containing pointers to any available -! thermodynamic fields. Absent fields have NULL ptrs. -! (in) fluxes = A structure containing pointers to any possible -! forcing fields; unused fields have NULL ptrs. -! (in) nkmb - The number of layers in the mixed and buffer layers. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) CS - The control structure returned by a previous call to -! diabatic_driver_init. + ! local variables real :: salt(SZI_(G)) ! The amount of salt rejected from ! sea ice. [grams] real :: dzbr(SZI_(G)) ! cumulative depth over which brine is distributed @@ -531,10 +523,9 @@ subroutine insert_brine(h, tv, G, GV, fluxes, nkmb, CS, dt, id_brine_lay) end subroutine insert_brine +!> Simple tri-diagnonal solver for T and S. +!! "Simple" means it only uses arrays hold, ea and eb. subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) -! Simple tri-diagnonal solver for T and S -! "Simple" means it only uses arrays hold, ea and eb - ! Arguments type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: is, ie, js, je @@ -571,35 +562,22 @@ subroutine triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, T, S) enddo end subroutine triDiagTS - +!> Calculates u_h and v_h (velocities at thickness points), +!! optionally using the entrainments (in m) passed in as arguments. subroutine find_uv_at_h(u, v, h, u_h, v_h, G, GV, ea, eb) 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb -! This subroutine calculates u_h and v_h (velocities at thickness -! points), optionally using the entrainments (in m) passed in as arguments. - -! Arguments: u - Zonal velocity, in m s-1. -! (in) v - Meridional velocity, in m s-1. -! (in) h - Layer thickness, in m or kg m-2. -! (out) u_h - The zonal velocity at thickness points after -! entrainment, in m s-1. -! (out) v_h - The meridional velocity at thickness points after -! entrainment, in m s-1. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in, opt) ea - The amount of fluid entrained from the layer above within -! this time step, in units of m or kg m-2. Omitting ea is the -! same as setting it to 0. -! (in, opt) eb - The amount of fluid entrained from the layer below within -! this time step, in units of m or kg m-2. Omitting eb is the -! same as setting it to 0. ea and eb must either be both -! present or both absent. - + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: u_h, v_h !< zonal and meridional velocity at thickness + !! points entrainment, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: ea, eb !< The amount of fluid entrained + !! from the layer above within this time step + !! , in units of m or kg m-2. Omitting ea is the + !! same as setting it to 0. + + ! local variables real :: b_denom_1 ! The first term in the denominator of b1 in m or kg m-2. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected, in m or kg m-2. @@ -1306,26 +1284,20 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, dt, fluxes, optics, h, tv, & end subroutine applyBoundaryFluxesInOut +!> Initializes this module. subroutine diabatic_aux_init(Time, G, GV, param_file, diag, CS, useALEalgorithm, use_ePBL) type(time_type), intent(in) :: 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(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(diabatic_aux_CS), pointer :: CS - logical, intent(in) :: useALEalgorithm - logical, intent(in) :: use_ePBL - -! Arguments: -! (in) Time = current model time -! (in) G = ocean grid structure -! (in) GV - The ocean's vertical grid structure. -! (in) param_file = structure indicating the open file to parse for parameter values -! (in) diag = structure used to regulate diagnostic output -! (in/out) CS = pointer set to point to the control structure for this module -! (in) use_ePBL = If true, use the implicit energetics planetary boundary -! layer scheme to determine the diffusivity in the -! surface boundary layer. + type(diag_ctrl), target, intent(inout) :: diag !< structure used to regulate diagnostic output + type(diabatic_aux_CS), pointer :: CS !< pointer set to point to the ontrol structure for + !! this module + logical, intent(in) :: useALEalgorithm !< If True, uses ALE. + logical, intent(in) :: use_ePBL !< If true, use the implicit energetics + !! planetary boundary layer scheme to determine the + !! diffusivity in the surface boundary layer. + ! local variables type(vardesc) :: vd ! This "include" declares and sets the variable "version". From 05daededb4103ecd3a3c1fbd2fcefd13968f1278 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 08:10:36 -0600 Subject: [PATCH 43/53] Fix indentation --- src/parameterizations/vertical/MOM_set_diffusivity.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index f33bdea2a8..37696386be 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -465,8 +465,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & if (CS%useKappaShear) call hchksum(visc%Kd_shear,"Turbulent Kd",G%HI,haloshift=0) if (CS%use_CVMix_ddiff) then - call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) - call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T",G%HI,haloshift=0) + call hchksum(visc%Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S",G%HI,haloshift=0) endif if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then From d5ce7a4aa4d94a239e19d5b5330bcc41ac4a0ae3 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:54:27 -0600 Subject: [PATCH 44/53] Avoid NaNs when computing stratification parameter --- src/parameterizations/vertical/MOM_cvmix_ddiff.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 index 8e52c39849..da75caf1e3 100644 --- a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 @@ -250,6 +250,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) if (CS%id_R_rho > 0.0) then do k=1,G%ke CS%R_rho(i,j,k) = alpha_dT(k)/beta_dS(k) + ! avoid NaN's + if(CS%R_rho(i,j,k) /= CS%R_rho(i,j,k)) CS%R_rho(i,j,k) = 0.0 enddo endif From abd620c8c730143aae2bcd55c752741a1d602789 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:55:19 -0600 Subject: [PATCH 45/53] Move description to the end of the module --- .../vertical/MOM_diabatic_aux.F90 | 93 +++++++++---------- 1 file changed, 45 insertions(+), 48 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 89d16f8e87..fa0cca8681 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -2,53 +2,6 @@ module MOM_diabatic_aux ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - July 2000 * -!* Alistair Adcroft, and Stephen Griffies * -!* * -!* This program contains the subroutine that, along with the * -!* subroutines that it calls, implements diapycnal mass and momentum * -!* fluxes and a bulk mixed layer. The diapycnal diffusion can be * -!* used without the bulk mixed layer. * -!* * -!* diabatic first determines the (diffusive) diapycnal mass fluxes * -!* based on the convergence of the buoyancy fluxes within each layer. * -!* The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * -!* 1997) is used for combined diapycnal advection and diffusion, * -!* calculated implicitly and potentially with the Richardson number * -!* dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * -!* advection is fundamentally the residual of diapycnal diffusion, * -!* so the fully implicit upwind differencing scheme that is used is * -!* entirely appropriate. The downward buoyancy flux in each layer * -!* is determined from an implicit calculation based on the previously * -!* calculated flux of the layer above and an estimated flux in the * -!* layer below. This flux is subject to the following conditions: * -!* (1) the flux in the top and bottom layers are set by the boundary * -!* conditions, and (2) no layer may be driven below an Angstrom thick-* -!* ness. If there is a bulk mixed layer, the buffer layer is treat- * -!* ed as a fixed density layer with vanishingly small diffusivity. * -!* * -!* diabatic takes 5 arguments: the two velocities (u and v), the * -!* thicknesses (h), a structure containing the forcing fields, and * -!* the length of time over which to act (dt). The velocities and * -!* thickness are taken as inputs and modified within the subroutine. * -!* There is no limit on the time step. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v * -!* j x ^ x ^ x At >: u * -!* j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - 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 : post_data, register_diag_field, safe_alloc_ptr @@ -251,6 +204,7 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) !! layer properies, and related fields. real, intent(in) :: dt !< Time increment, in s. + ! local variables real, dimension(SZI_(G)) :: & b1_T, b1_S, & ! Variables used by the tridiagonal solvers of T & S, in H. d1_T, d1_S ! Variables used by the tridiagonal solvers, nondim. @@ -337,7 +291,6 @@ subroutine differential_diffuse_T_S(h, tv, visc, dt, G, GV) S(i,j,k) = S(i,j,k) + c1_S(i,k+1)*S(i,j,k+1) enddo ; enddo enddo - end subroutine differential_diffuse_T_S !> Keep salinity from falling below a small but positive threshold @@ -1420,4 +1373,48 @@ subroutine diabatic_aux_end(CS) end subroutine diabatic_aux_end +!> \namespace MOM_diabatic_aux +!! +!! This module contains the subroutines that, along with the * +!! subroutines that it calls, implements diapycnal mass and momentum * +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be * +!! used without the bulk mixed layer. * +!! * +!! diabatic first determines the (diffusive) diapycnal mass fluxes * +!! based on the convergence of the buoyancy fluxes within each layer. * +!! The dual-stream entrainment scheme of MacDougall and Dewar (JPO, * +!! 1997) is used for combined diapycnal advection and diffusion, * +!! calculated implicitly and potentially with the Richardson number * +!! dependent mixing, as described by Hallberg (MWR, 2000). Diapycnal * +!! advection is fundamentally the residual of diapycnal diffusion, * +!! so the fully implicit upwind differencing scheme that is used is * +!! entirely appropriate. The downward buoyancy flux in each layer * +!! is determined from an implicit calculation based on the previously * +!! calculated flux of the layer above and an estimated flux in the * +!! layer below. This flux is subject to the following conditions: * +!! (1) the flux in the top and bottom layers are set by the boundary * +!! conditions, and (2) no layer may be driven below an Angstrom thick-* +!! ness. If there is a bulk mixed layer, the buffer layer is treat- * +!! ed as a fixed density layer with vanishingly small diffusivity. * +!! * +!! diabatic takes 5 arguments: the two velocities (u and v), the * +!! thicknesses (h), a structure containing the forcing fields, and * +!! the length of time over which to act (dt). The velocities and * +!! thickness are taken as inputs and modified within the subroutine. * +!! There is no limit on the time step. * +!! * +!! A small fragment of the grid is shown below: * +!! * +!! j+1 x ^ x ^ x At x: q * +!! j+1 > o > o > At ^: v * +!! j x ^ x ^ x At >: u * +!! j > o > o > At o: h, T, S, buoy, ustar, ea, eb, etc. * +!! j-1 x ^ x ^ x * +!! i-1 i i+1 At x & ^: * +!! i i+1 At > & o: * +!! * +!! The boundaries always run through q grid points (x). * +!! * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_diabatic_aux From 152a7073db62e9b9b68023d2eb1dd8529414a7fd Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 13:56:00 -0600 Subject: [PATCH 46/53] Change cvmix to CVMix --- .../vertical/MOM_diabatic_driver.F90 | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index b109d3642a..abc0d664f5 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -23,8 +23,8 @@ module MOM_diabatic_driver use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS -use MOM_cvmix_conv, only : cvmix_conv_init, cvmix_conv_cs -use MOM_cvmix_conv, only : cvmix_conv_end, calculate_cvmix_conv +use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs +use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs @@ -95,7 +95,7 @@ module MOM_diabatic_driver !! shear-driven diapycnal diffusivity. logical :: use_CVMix_ddiff !< If true, use the CVMix double diffusion module. logical :: use_tidal_mixing !< If true, activate tidal mixing diffusivity. - logical :: use_cvmix_conv !< If true, use the CVMix module to get enhanced + logical :: use_CVMix_conv !< If true, use the CVMix module to get enhanced !! mixing due to convection. logical :: use_sponge !< If true, sponges may be applied anywhere in the !! domain. The exact location and properties of @@ -226,7 +226,7 @@ module MOM_diabatic_driver type(diag_to_Z_CS), pointer :: diag_to_Z_CSp => NULL() type(KPP_CS), pointer :: KPP_CSp => NULL() type(tidal_mixing_cs), pointer :: tidal_mixing_csp => NULL() - type(cvmix_conv_cs), pointer :: cvmix_conv_csp => NULL() + type(CVMix_conv_cs), pointer :: CVMix_conv_csp => NULL() type(diapyc_energy_req_CS), pointer :: diapyc_en_rec_CSp => NULL() type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass @@ -530,7 +530,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (CS%debug) then 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%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%debug) then @@ -680,13 +680,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) - if (CS%use_cvmix_conv) then - call calculate_cvmix_conv(h, tv, G, GV, CS%cvmix_conv_csp, Hml) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! do k=1,nz ; 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) + 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 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2349,9 +2349,9 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, CS%tidal_mixing_CSp) - ! CS%use_cvmix_conv is set to True if CVMix convection will be used, otherwise + ! CS%use_CVMix_conv is set to True if CVMix convection will be used, otherwise ! False. - CS%use_cvmix_conv = cvmix_conv_init(Time, G, GV, param_file, diag, CS%cvmix_conv_csp) + CS%use_CVMix_conv = CVMix_conv_init(Time, G, GV, param_file, diag, CS%CVMix_conv_csp) call entrain_diffusive_init(Time, G, GV, param_file, diag, CS%entrain_diffusive_CSp) @@ -2442,7 +2442,7 @@ subroutine diabatic_driver_end(CS) if (CS%use_tidal_mixing) call tidal_mixing_end(CS%tidal_mixing_CSp) - if (CS%use_cvmix_conv) call cvmix_conv_end(CS%cvmix_conv_csp) + if (CS%use_CVMix_conv) call CVMix_conv_end(CS%CVMix_conv_csp) if (CS%use_energetic_PBL) & call energetic_PBL_end(CS%energetic_PBL_CSp) From cc273629b858ddc197e2f6f43e75731d87cbac3f Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Fri, 18 May 2018 15:01:08 -0600 Subject: [PATCH 47/53] Clean up spaces and comments --- .../vertical/MOM_diabatic_driver.F90 | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index abc0d664f5..27ff1de4d9 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -484,13 +484,13 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G endif if (CS%ML_mix_first > 0.0) then -! This subroutine -! (1) Cools the mixed layer. -! (2) Performs convective adjustment by mixed layer entrainment. -! (3) Heats the mixed layer and causes it to detrain to -! Monin-Obukhov depth or minimum mixed layer depth. -! (4) Uses any remaining TKE to drive mixed layer entrainment. -! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + ! This subroutine: + ! (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) call find_uv_at_h(u, v, h, u_h, v_h, G, GV) call cpu_clock_begin(id_clock_mixedlayer) @@ -525,11 +525,12 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) endif - endif + endif ! end CS%bulkmixedlayer if (CS%debug) then 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) @@ -586,7 +587,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, G, G CS%int_tide_input%tideamp, CS%int_tide_input%Nb, dt, G, GV, CS%int_tide_CSp) endif if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") - endif + endif ! end CS%use_int_tides call cpu_clock_begin(id_clock_set_diffusivity) ! Sets: Kd, Kd_int, visc%Kd_extra_T, visc%Kd_extra_S From 70d88e4e52f9ef500b43583a2888d9d6acd41209 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Mon, 21 May 2018 17:05:14 -0600 Subject: [PATCH 48/53] Add a flag to control if visc%Kv_slow is used This commit adds a flag ADD_KV_SLOW (default is FALSE) that controls if the background vertical viscosity in the interior (i.e., tidal + background + shear + convenction) is addded when computing the coupling coefficient. The purpose of this flag is to be able to recover previous answers and it will likely be removed in the future since this option should always be true. --- src/core/MOM_variables.F90 | 3 + .../vertical/MOM_set_viscosity.F90 | 86 ++++++++++--------- .../vertical/MOM_vert_friction.F90 | 2 +- 3 files changed, 48 insertions(+), 43 deletions(-) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 09305eb9fb..02b0b622a3 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -233,6 +233,9 @@ module MOM_variables !! convection etc). TKE_turb => NULL() !< The turbulent kinetic energy per unit mass defined !! at the interfaces between each layer, in m2 s-2. + logical :: add_Kv_slow !< If True, adds Kv_slow when calculating the + !! 'coupling coefficient' (a[k]) at the interfaces. + !! This is done in find_coupling_coef. end type vertvisc_type !> The BT_cont_type structure contains information about the summed layer diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index c0b03e5832..ec1b09a5ad 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2,38 +2,6 @@ module MOM_set_visc ! This file is part of MOM6. See LICENSE.md for the license. -!********+*********+*********+*********+*********+*********+*********+** -!* * -!* By Robert Hallberg, April 1994 - October 2006 * -!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * -!* * -!* This file contains the subroutine that calculates various values * -!* related to the bottom boundary layer, such as the viscosity and * -!* thickness of the BBL (set_viscous_BBL). This would also be the * -!* module in which other viscous quantities that are flow-independent * -!* might be set. This information is transmitted to other modules * -!* via a vertvisc type structure. * -!* * -!* The same code is used for the two velocity components, by * -!* indirectly referencing the velocities and defining a handful of * -!* direction-specific defined variables. * -!* * -!* Macros written all in capital letters are defined in MOM_memory.h. * -!* * -!* A small fragment of the grid is shown below: * -!* * -!* j+1 x ^ x ^ x At x: q * -!* j+1 > o > o > At ^: v, frhatv, tauy * -!* j x ^ x ^ x At >: u, frhatu, taux * -!* j > o > o > At o: h * -!* j-1 x ^ x ^ x * -!* i-1 i i+1 At x & ^: * -!* i i+1 At > & o: * -!* * -!* The boundaries always run through q grid points (x). * -!* * -!********+*********+*********+*********+*********+*********+*********+** - use MOM_debugging, only : uvchksum, hchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr @@ -1859,16 +1827,8 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(set_visc_CS), pointer :: CS !< A pointer that is set to point to the control !! structure for this module type(ocean_OBC_type), pointer :: OBC -! Arguments: Time - The current model time. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical 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. -! (out) visc - A structure containing vertical viscosities and related -! fields. Allocated here. -! (in/out) CS - A pointer that is set to point to the control structure -! for this module + + ! local variables real :: Csmag_chan_dflt, smag_const1, TKE_decay_dflt, bulk_Ri_ML_dflt real :: Kv_background real :: omega_frac_dflt @@ -2020,6 +1980,15 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) + + call get_param(param_file, mdl, "ADD_KV_SLOW", visc%add_Kv_slow, & + "If true, the background vertical viscosity in the interior \n"//& + "(i.e., tidal + background + shear + convenction) is addded \n"// & + "when computing the coupling coefficient. The purpose of this \n"// & + "flag is to be able to recover previous answers and it will likely \n"// & + "be removed in the future since this option should always be true.", & + default=.false.) + 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) @@ -2117,4 +2086,37 @@ subroutine set_visc_end(visc, CS) deallocate(CS) end subroutine set_visc_end +!> \namespace MOM_set_visc +!!********+*********+*********+*********+*********+*********+*********+** +!!* * +!!* By Robert Hallberg, April 1994 - October 2006 * +!!* Quadratic Bottom Drag by James Stephens and R. Hallberg. * +!!* * +!!* This file contains the subroutine that calculates various values * +!!* related to the bottom boundary layer, such as the viscosity and * +!!* thickness of the BBL (set_viscous_BBL). This would also be the * +!!* module in which other viscous quantities that are flow-independent * +!!* might be set. This information is transmitted to other modules * +!!* via a vertvisc type structure. * +!!* * +!!* The same code is used for the two velocity components, by * +!!* indirectly referencing the velocities and defining a handful of * +!!* direction-specific defined variables. * +!!* * +!!* Macros written all in capital letters are defined in MOM_memory.h. * +!!* * +!!* A small fragment of the grid is shown below: * +!!* * +!!* j+1 x ^ x ^ x At x: q * +!!* j+1 > o > o > At ^: v, frhatv, tauy * +!!* j x ^ x ^ x At >: u, frhatu, taux * +!!* j > o > o > At o: h * +!!* j-1 x ^ x ^ x * +!!* i-1 i i+1 At x & ^: * +!!* i i+1 At > & o: * +!!* * +!!* The boundaries always run through q grid points (x). * +!!* * +!!********+*********+*********+*********+*********+*********+*********+** + end module MOM_set_visc diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index ad0d7fc90d..bafbe5eb59 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1195,7 +1195,7 @@ subroutine find_coupling_coef(a, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_m endif ! add "slow" varying vertical viscosity (e.g., from background, tidal etc) - if (associated(visc%Kv_slow)) then + 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 do K=2,nz ; do i=is,ie ; if (do_i(i)) then From 8877c17dccd111e4789f4553eb4e25befee6e091 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 08:32:43 -0600 Subject: [PATCH 49/53] Rename MOM_cvmix_ddiff.F90 -> MOM_CVMix_ddiff.F90 --- .../vertical/{MOM_cvmix_ddiff.F90 => MOM_CVMix_ddiff.F90} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/parameterizations/vertical/{MOM_cvmix_ddiff.F90 => MOM_CVMix_ddiff.F90} (100%) diff --git a/src/parameterizations/vertical/MOM_cvmix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 similarity index 100% rename from src/parameterizations/vertical/MOM_cvmix_ddiff.F90 rename to src/parameterizations/vertical/MOM_CVMix_ddiff.F90 From bf6c0030a308c3099fce3674a84a03ad16e358ba Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 08:41:39 -0600 Subject: [PATCH 50/53] Clean the ddiff code and improve comments --- .../vertical/MOM_CVMix_ddiff.F90 | 27 +++++-------------- 1 file changed, 6 insertions(+), 21 deletions(-) diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index da75caf1e3..7137aabfa6 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -64,9 +64,6 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. type(CVMix_ddiff_cs), pointer :: CS !< This module's control structure. - ! Local variables -! real :: prandtl_conv !< Turbulent Prandtl number used in convective instabilities. - ! This include declares and sets the variable "version". #include "version_variable.h" @@ -133,11 +130,6 @@ logical function CVMix_ddiff_init(Time, G, GV, param_file, diag, CS) call closeParameterBlock(param_file) - ! allocate arrays and set them to zero - ! GMM, dont need the following - !allocate(CS%KT_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KT_extra(:,:,:) = 0. - !allocate(CS%KS_extra(SZI_(G), SZJ_(G), SZK_(G)+1)); CS%KS_extra(:,:,:) = 0. - ! Register diagnostics CS%diag => diag @@ -173,8 +165,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in 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 -! real, dimension(:,:,:), pointer :: Kd_T -! real, dimension(:,:,:), pointer :: Kd_S !! diffusivity for temp (m2/sec). real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: Kd_S !< Interface double diffusion diapycnal !! diffusivity for salt (m2/sec). @@ -209,7 +199,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) ! set Kd_T and Kd_S to zero to avoid passing values from previous call Kd_T(:,j,:) = 0.0; Kd_S(:,j,:) = 0.0 - ! GMM, check this. + ! GMM, I am leaving some code commented below. We need to pass BLD to + ! this soubroutine to avoid adding diffusivity above that. This needs + ! to be done once we re-structure the order of the calls. !if (.not. associated(hbl)) then ! allocate(hbl(SZI_(G), SZJ_(G))); ! hbl(:,:) = 0.0 @@ -239,9 +231,9 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) call calculate_density_derivs(temp_int(:), salt_int(:), pres_int(:), drho_dT(:), drho_dS(:), 1, G%ke, TV%EQN_OF_STATE) - ! GMM, explain need for -1 in front of alpha - ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then ! salt finger case - ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then ! diffusive convection + ! The "-1.0" below is needed so that the following criteria is satisfied: + ! if ((alpha_dT > beta_dS) .and. (beta_dS > 0.0)) then "salt finger" + ! if ((alpha_dT < 0.) .and. (beta_dS < 0.) .and. (alpha_dT > beta_dS)) then "diffusive convection" do k=1,G%ke alpha_dT(k) = -1.0*drho_dT(k) * dT(k) beta_dS(k) = drho_dS(k) * dS(k) @@ -277,13 +269,6 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, j, Kd_T, Kd_S, CS) nlev=G%ke, & max_nlev=G%ke) - !if (is_root_pe()) then - ! write(*,*)'drho_dT, alpha_dT', & - ! drho_dT(:), alpha_dT(:) - ! write(*,*)'drho_dS, beta_dS', & - ! drho_dS(:), beta_dS(:) - !endif - ! Do not apply mixing due to convection within the boundary layer !do k=1,kOBL ! Kd_T(i,j,k) = 0.0 From 387f4e64bd246cef62569b087f1bf457c0b9810b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Tue, 22 May 2018 10:17:52 -0600 Subject: [PATCH 51/53] Add a legacy version of diabatic_driver A new input parameter has been added (USE_LEGACY_DIABATIC_DRIVER). If true, the model will use a legacy version of the diabatic driver (module MOM_legacy_diabatic_driver). This is temporary and is needed to avoid change in answers while MOM_diabatic_driver is been restructured. --- src/core/MOM.F90 | 18 +- .../vertical/MOM_diabatic_driver.F90 | 6 +- .../vertical/MOM_legacy_diabatic_driver.F90 | 1660 +++++++++++++++++ 3 files changed, 1680 insertions(+), 4 deletions(-) create mode 100644 src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 8ee4113f71..9b70b81415 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -52,6 +52,7 @@ module MOM use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS +use MOM_legacy_diabatic_driver,only : legacy_diabatic 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_diagnostics, only : calculate_diagnostic_fields, MOM_diagnostics_init @@ -197,6 +198,9 @@ module MOM 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 @@ -1151,8 +1155,14 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia, & endif call cpu_clock_begin(id_clock_diabatic) - call diabatic(u, v, h, tv, CS%Hml, fluxes, CS%visc, CS%ADp, CS%CDp, & - dtdia, Time_end_thermo, G, GV, CS%diabatic_CSp, Waves=Waves) + 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, 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, CS%diabatic_CSp, Waves=Waves) + endif fluxes%fluxes_used = .true. call cpu_clock_end(id_clock_diabatic) @@ -1627,6 +1637,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& "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 the a legacy version of the diabatic subroutine. \n"//& + "This is temporary and is needed 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 \n"//& "the gravity wave adjustment to h. This is a fragile feature and \n"//& diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 259abcfadc..6316fd40e6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -84,7 +84,10 @@ module MOM_diabatic_driver public adiabatic_driver_init !> Control structure for this module -type, public:: diabatic_CS ; private +! GMM, I've made the following type public so it work with the legacy version of +! diabatic. This type should be made private once the legacy code is deleted. +!type, public:: diabatic_CS; private +type, public:: diabatic_CS 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 @@ -1917,7 +1920,6 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! Set default, read and log parameters call log_version(param_file, mod, version, & "The following parameters are used for diabatic processes.") - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& diff --git a/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 new file mode 100644 index 0000000000..739c74c80c --- /dev/null +++ b/src/parameterizations/vertical/MOM_legacy_diabatic_driver.F90 @@ -0,0 +1,1660 @@ +!> This routine drives the diabatic/dianeutral physics for MOM. +!! This is a legacy module that will be deleted in the near future. +module MOM_legacy_diabatic_driver + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_bulk_mixed_layer, only : bulkmixedlayer, bulkmixedlayer_init, bulkmixedlayer_CS +use MOM_debugging, only : hchksum +use MOM_checksum_packages, only : MOM_state_chksum, MOM_state_stats +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_CVMix_shear, only : CVMix_shear_is_used +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_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 +use MOM_diag_mediator, only : diag_grid_storage, diag_grid_storage_init, diag_grid_storage_end +use MOM_diag_mediator, only : diag_copy_diag_to_storage, diag_copy_storage_to_diag +use MOM_diag_mediator, only : diag_save_grids, diag_restore_grids +use MOM_diag_to_Z, only : diag_to_Z_CS, register_Zint_diag, calc_Zint_diags +use MOM_diapyc_energy_req, only : diapyc_energy_req_init, diapyc_energy_req_end +use MOM_diapyc_energy_req, only : diapyc_energy_req_calc, diapyc_energy_req_test, diapyc_energy_req_CS +use MOM_CVMix_conv, only : CVMix_conv_init, CVMix_conv_cs +use MOM_CVMix_conv, only : CVMix_conv_end, calculate_CVMix_conv +use MOM_domains, only : pass_var, To_West, To_South, To_All, Omit_Corners +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type +use MOM_tidal_mixing, only : tidal_mixing_init, tidal_mixing_cs +use MOM_tidal_mixing, only : tidal_mixing_end +use MOM_energetic_PBL, only : energetic_PBL, energetic_PBL_init +use MOM_energetic_PBL, only : energetic_PBL_end, energetic_PBL_CS +use MOM_energetic_PBL, only : energetic_PBL_get_MLD +use MOM_entrain_diffusive, only : entrainment_diffusive, entrain_diffusive_init +use MOM_entrain_diffusive, only : entrain_diffusive_end, entrain_diffusive_CS +use MOM_EOS, only : calculate_density, calculate_TFreeze +use MOM_EOS, only : calculate_specific_vol_derivs +use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg +use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint +use MOM_file_parser, only : get_param, log_version, param_file_type, read_param +use MOM_forcing_type, only : forcing, MOM_forcing_chksum +use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint +use MOM_geothermal, only : geothermal, geothermal_init, geothermal_end, geothermal_CS +use MOM_grid, only : ocean_grid_type +use MOM_io, only : vardesc, var_desc +use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init +use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type +use MOM_interface_heights, only : find_eta +use MOM_internal_tides, only : propagate_int_tide +use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS +use MOM_kappa_shear, only : kappa_shear_is_used +use MOM_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate +use MOM_KPP, only : KPP_end, KPP_get_BLD +use MOM_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln +use MOM_opacity, only : opacity_init, set_opacity, opacity_end, opacity_CS +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 : operator(-), set_time +use MOM_time_manager, only : operator(<=), time_type ! for testing itides (BDM) +use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS +use MOM_tracer_diabatic, only : tracer_vertdiff +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs +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 +use MOM_diabatic_driver, only : diabatic_CS + +implicit none ; private + +#include + +public legacy_diabatic + +! 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 legacy_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + G, GV, CS, WAVES) + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< meridional velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< thickness (m for Bouss / kg/m2 for non-Bouss) + type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields + !! unused have NULL ptrs + real, dimension(:,:), pointer :: Hml !< active mixed layer depth + 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 (seconds) + 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 + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & + ea, & ! amount of fluid entrained from the layer above within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + eb, & ! amount of fluid entrained from the layer below within + ! one time step (m for Bouss, kg/m^2 for non-Bouss) + Kd, & ! diapycnal diffusivity of layers (m^2/sec) + h_orig, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + h_prebound, & ! initial layer thicknesses (m for Bouss, kg/m^2 for non-Bouss) + hold, & ! layer thickness before diapycnal entrainment, and later + ! the initial layer thicknesses (if a mixed layer is used), + ! (m for Bouss, kg/m^2 for non-Bouss) + dSV_dT, & ! The partial derivatives of specific volume with temperature + dSV_dS, & ! and salinity in m^3/(kg K) and m^3/(kg ppt). + cTKE, & ! convective TKE requirements for each layer in J/m^2. + u_h, & ! zonal and meridional velocities at thickness points after + v_h ! entrainment (m/s) + + 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/s3), 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. + 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 (m for Bouss and kg/m^2 for non-Bouss) + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), target :: & + Kd_int, & ! diapycnal diffusivity of interfaces (m^2/s) + Kd_heat, & ! diapycnal diffusivity of heat (m^2/s) + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers (m^2/s) + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces (m^2/s) + eta, & ! Interface heights before diapycnal mixing, in m. + Tdif_flx, & ! diffusive diapycnal heat flux across interfaces (K m/s) + Tadv_flx, & ! advective diapycnal heat flux across interfaces (K m/s) + Sdif_flx, & ! diffusive diapycnal salt flux across interfaces (ppt m/s) + Sadv_flx ! advective diapycnal salt flux across interfaces (ppt m/s) + + ! 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 ! (m for Bouss and kg/m^2 for non-Bouss). 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 laye (nondimensional) + + real :: p_ref_cv(SZI_(G)) ! Reference pressure for the potential + ! density which defines the coordinate + ! variable, set to P_Ref, in 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 + ! the entrainment - usually sqrt(Kd*dt). + + real :: b_denom_1 ! The first term in the denominator of b1 + ! (m for Bouss, kg/m^2 for non-Bouss) + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: h_neglect2 ! h_neglect^2 (m^2 for Bouss, kg^2/m^4 for non-Bouss) + real :: add_ent ! Entrainment that needs to be added when mixing tracers + ! (m for Bouss and kg/m^2 for non-Bouss) + real :: eaval ! eaval is 2*ea at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: hval ! hval is 2*h at velocity grid points (m for Bouss, kg/m^2 for non-Bouss) + real :: h_tr ! h_tr is h at tracer points with a tiny thickness + ! added to ensure positive definiteness (m for Bouss, kg/m^2 for non-Bouss) + real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is + ! coupled to the bottom within a timestep (m) + + real :: htot(SZIB_(G)) ! The summed thickness from the bottom, in m. + 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 units = m for Bouss, kg/m^2 for non-Bouss). + real :: dt_mix ! amount of time over which to apply mixing (seconds) + real :: Idt ! inverse time step (1/s) + + type(p3d) :: z_ptrs(7) ! pointers to diagnostics to be interpolated to depth + integer :: num_z_diags ! number of diagnostics to be interpolated to depth + integer :: z_ids(7) ! id numbers of diagnostics to be interpolated to depth + 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 + + 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 in m2/s + + 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 + + + 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, GV%g_Earth, G, GV, eta) + 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 + 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, 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, CS%diapyc_en_rec_CSp) + + + call cpu_clock_begin(id_clock_set_diffusivity) + call set_BBL_TKE(u, v, h, fluxes, visc, G, GV, 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 - set_time(int(floor(0.5*dt+0.5))), 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 (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 +!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_orig,h,eaml,ebml) + do k=1,nz ; do j=js,je ; do i=is,ie + h_orig(i,j,k) = h(i,j,k) ; eaml(i,j,k) = 0.0 ; ebml(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) + 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_opacity 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) + + if (CS%bulkmixedlayer) then + if (CS%debug) then + call MOM_forcing_chksum("Before mixedlayer", fluxes, G, haloshift=0) + endif + + if (CS%ML_mix_first > 0.0) then +! This subroutine +! (1) Cools the mixed layer. +! (2) Performs convective adjustment by mixed layer entrainment. +! (3) Heats the mixed layer and causes it to detrain to +! Monin-Obukhov depth or minimum mixed layer depth. +! (4) Uses any remaining TKE to drive mixed layer entrainment. +! (5) Possibly splits buffer layer into two isopycnal layers (when using isopycnal coordinate) + call find_uv_at_h(u, v, h, u_h, v_h, G, GV) + + 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, & + eaml,ebml, G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, 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, & + G, GV, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + endif + + ! 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) + call cpu_clock_end(id_clock_mixedlayer) + if (CS%debug) then + call MOM_state_chksum("After mixedlayer ", u, v, h, G, GV, haloshift=0) + call MOM_forcing_chksum("After mixedlayer", fluxes, G, haloshift=0) + endif + if (showCallTree) call callTree_waypoint("done with 1st bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('1st bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + endif + + if (CS%debug) then + 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) + 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) + 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 + + 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, & + 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, 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, 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, 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, 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 + call set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, CS%optics, visc, dt, G, GV, CS%set_diff_CSp, Kd, 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, haloshift=0) + call MOM_thermovar_chksum("after set_diffusivity ", tv, G) + call hchksum(Kd, "after set_diffusivity Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int",G%HI,haloshift=0) + endif + + + if (CS%useKPP) then + call cpu_clock_begin(id_clock_kpp) + ! 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, 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. + ! MOM6 implementation of KPP matches the boundary layer to zero interior diffusivity, + ! since the matching to nonzero interior diffusivity can be problematic. + ! Changes: Kd_int. Sets: KPP_NLTheat, KPP_NLTscalar + +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,Kd_heat) +!$OMP do + 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 + if (associated(visc%Kd_extra_S)) then +!$OMP do + 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 do + 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 +!$OMP end parallel + + call KPP_compute_BLD(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux) + + call KPP_calculate(CS%KPP_CSp, G, GV, h, tv%T, tv%S, u, v, tv%eqn_of_state, & + fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, & + CS%KPP_NLTscalar, Waves=Waves) +!$OMP parallel default(none) shared(is,ie,js,je,nz,Kd_salt,Kd_int,visc,CS,G,Kd_heat,Hml) + + if (associated(Hml)) then + call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G) + call pass_var(Hml, G%domain, halo=1) + endif + + if (.not. CS%KPPisPassive) then +!$OMP do + 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 do + 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 do + 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 +!$OMP end parallel + 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, haloshift=0) + call MOM_thermovar_chksum("after KPP", tv, G) + call hchksum(Kd, "after KPP Kd",G%HI,haloshift=0) + call hchksum(Kd_Int, "after KPP Kd_Int",G%HI,haloshift=0) + endif + + endif ! endif for KPP + + ! Add vertical diff./visc. due to convection (computed via CVMix) + if (CS%use_CVMix_conv) then + call calculate_CVMix_conv(h, tv, G, GV, CS%CVMix_conv_csp, Hml) + + !!!!!!!! GMM, the following needs to be checked !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do k=1,nz ; 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) + 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, 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 using matching within the KPP scheme, then this step needs to provide + ! a diffusivity and happen before KPP. But generally in MOM, we do not match + ! KPP boundary layer to interior, so this diffusivity can be computed when convenient. + 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_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 + 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 + + + ! 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%m_to_H**2) * dt * hval * 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, CS%entrain_diffusive_CSp, & + ea, eb, kb, Kd_Lay=Kd, 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) + + if (CS%debug) then + call MOM_forcing_chksum("after calc_entrain ", fluxes, G, 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, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after calc_entrain eb", 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 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, 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, & + 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) + 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%m_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) + 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) + + 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) + endif + + else + call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, 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, 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 + ! against instances where entrainment drives a layer to + ! negative thickness. This situation will never happen if + ! enough iterations are permitted in Calculate_Entrainment. + ! Even if too few iterations are allowed, it is still guarded + ! against. In other words the checks are probably unnecessary. + !$OMP parallel do default(shared) + do j=js,je + do i=is,ie + hold(i,j,1) = h(i,j,1) + h(i,j,1) = h(i,j,1) + (eb(i,j,1) - ea(i,j,2)) + hold(i,j,nz) = h(i,j,nz) + h(i,j,nz) = h(i,j,nz) + (ea(i,j,nz) - eb(i,j,nz-1)) + if (h(i,j,1) <= 0.0) then + h(i,j,1) = GV%Angstrom + endif + if (h(i,j,nz) <= 0.0) then + h(i,j,nz) = GV%Angstrom + endif + enddo + do k=2,nz-1 ; do i=is,ie + hold(i,j,k) = h(i,j,k) + h(i,j,k) = h(i,j,k) + ((ea(i,j,k) - eb(i,j,k-1)) + & + (eb(i,j,k) - ea(i,j,k+1))) + if (h(i,j,k) <= 0.0) then + h(i,j,k) = GV%Angstrom + endif + enddo ; enddo + enddo + ! Checks for negative thickness may have changed layer thicknesses + call diag_update_remap_grids(CS%diag) + + 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, 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) + + + ! Here, T and S are updated according to ea and eb. + ! If using the bulk mixed layer, T and S are also updated + ! by surface fluxes (in fluxes%*). + ! This is a very long block. + if (CS%bulkmixedlayer) then + + if (associated(tv%T)) then + call cpu_clock_begin(id_clock_tridiag) + ! Temperature and salinity (as state variables) are treated + ! differently from other tracers to insure massless layers that + ! are lighter than the mixed layer have temperatures and salinities + ! that correspond to their prescribed densities. + if (CS%massless_match_targets) then + !$OMP parallel do default (shared) private(h_tr,b1,d1,c1,b_denom_1) + do j=js,je + do i=is,ie + h_tr = hold(i,j,1) + h_neglect + b1(i) = 1.0 / (h_tr + eb(i,j,1)) + d1(i) = h_tr * b1(i) + tv%T(i,j,1) = b1(i) * (h_tr*tv%T(i,j,1)) + tv%S(i,j,1) = b1(i) * (h_tr*tv%S(i,j,1)) + enddo + do k=2,nkmb ; do i=is,ie + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + if (k kb(i,j)) then + c1(i,k) = eb(i,j,k-1) * b1(i) + h_tr = hold(i,j,k) + h_neglect + b_denom_1 = h_tr + d1(i)*ea(i,j,k) + b1(i) = 1.0 / (b_denom_1 + eb(i,j,k)) + d1(i) = b_denom_1 * b1(i) + tv%T(i,j,k) = b1(i) * (h_tr*tv%T(i,j,k) + ea(i,j,k)*tv%T(i,j,k-1)) + tv%S(i,j,k) = b1(i) * (h_tr*tv%S(i,j,k) + ea(i,j,k)*tv%S(i,j,k-1)) + elseif (eb(i,j,k) < eb(i,j,k-1)) then ! (note that k < kb(i,j)) + ! The bottommost buffer layer might entrain all the mass from some + ! of the interior layers that are thin and lighter in the coordinate + ! density than that buffer layer. The T and S of these newly + ! massless interior layers are unchanged. + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%T(i,j,k) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + b1(i) * (eb(i,j,k-1) - eb(i,j,k)) * tv%S(i,j,k) + endif + enddo ; enddo + + do k=nz-1,nkmb,-1 ; do i=is,ie + if (k >= kb(i,j)) then + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + endif + enddo ; enddo + do i=is,ie ; if (kb(i,j) <= nz) then + tv%T(i,j,nkmb) = tv%T(i,j,nkmb) + c1(i,kb(i,j))*tv%T(i,j,kb(i,j)) + tv%S(i,j,nkmb) = tv%S(i,j,nkmb) + c1(i,kb(i,j))*tv%S(i,j,kb(i,j)) + endif ; enddo + do k=nkmb-1,1,-1 ; do i=is,ie + tv%T(i,j,k) = tv%T(i,j,k) + c1(i,k+1)*tv%T(i,j,k+1) + tv%S(i,j,k) = tv%S(i,j,k) + c1(i,k+1)*tv%S(i,j,k+1) + enddo ; enddo + enddo ! end of j loop + else ! .not. massless_match_targets + ! This simpler form allows T & S to be too dense for the layers + ! between the buffer layers and the interior. + ! Changes: T, S + 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) + else + call triDiagTS(G, GV, is, ie, js, je, hold, ea, eb, tv%T, tv%S) + endif + endif ! massless_match_targets + call cpu_clock_end(id_clock_tridiag) + + endif ! endif for associated(T) + if (CS%debugConservation) call MOM_state_stats('BML tridiag', u, v, h, tv%T, tv%S, G) + + if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then + ! The mixed layer code has already been called, but there is some needed + ! bookkeeping. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js,je ; do i=is,ie + hold(i,j,k) = h_orig(i,j,k) + ea(i,j,k) = ea(i,j,k) + eaml(i,j,k) + eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) + enddo ; enddo ; enddo + if (CS%debug) then + call hchksum(ea, "after ea = ea + eaml",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "after eb = eb + ebml",G%HI,haloshift=0, scale=GV%H_to_m) + endif + endif + + if (CS%ML_mix_first < 1.0) then + ! Call the mixed layer code now, perhaps for a second time. + ! This subroutine (1) Cools the mixed layer. + ! (2) Performs convective adjustment by mixed layer entrainment. + ! (3) Heats the mixed layer and causes it to detrain to + ! Monin-Obukhov depth or minimum mixed layer depth. + ! (4) Uses any remaining TKE to drive mixed layer entrainment. + ! (5) Possibly splits the buffer layer into two isopycnal layers. + + 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)) + 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, CS%bulkmixedlayer_CSp, CS%optics, & + Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + + if (CS%salt_reject_below_ML) & + call insert_brine(h, tv, G, GV, fluxes, nkmb, CS%diabatic_aux_CSp, dt_mix, & + CS%id_brine_lay) + + ! 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) + + call cpu_clock_end(id_clock_mixedlayer) + if (showCallTree) call callTree_waypoint("done with 2nd bulkmixedlayer (diabatic)") + if (CS%debugConservation) call MOM_state_stats('2nd bulkmixedlayer', u, v, h, tv%T, tv%S, G) + endif + + else ! following block for when NOT using BULKMIXEDLAYER + + + ! calculate change in temperature & salinity due to dia-coordinate surface diffusion + if (associated(tv%T)) then + + if (CS%debug) then + call hchksum(ea, "before triDiagTS ea ",G%HI,haloshift=0, scale=GV%H_to_m) + call hchksum(eb, "before triDiagTS eb ",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 + + ! 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) + 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 + 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 + + 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) + + + endif ! endif for the BULKMIXEDLAYER block + + + 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) + call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) + 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 + + ! Whenever thickness changes let the diag manager know, as the + ! target grids for vertical remapping may need to be regenerated. + call diag_update_remap_grids(CS%diag) + + ! diagnostics + if ((CS%id_Tdif > 0) .or. (CS%id_Tdif_z > 0) .or. & + (CS%id_Tadv > 0) .or. (CS%id_Tadv_z > 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(i,j,k) + eb(i,j,k-1))) * & + (tv%T(i,j,k-1) - tv%T(i,j,k)) + Tadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(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_Sdif_z > 0) .or. & + (CS%id_Sadv > 0) .or. (CS%id_Sadv_z > 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(i,j,k) + eb(i,j,k-1))) * & + (tv%S(i,j,k-1) - tv%S(i,j,k)) + Sadv_flx(i,j,K) = (Idt * (ea(i,j,k) - eb(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 = sqrt(dt*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(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, + ! perhaps a molecular diffusivity. + add_ent = ((dt * CS%Kd_min_tr) * GV%m_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)) + if (htot(i) < Tr_ea_BBL) then + add_ent = max(0.0, add_ent, & + (Tr_ea_BBL - htot(i)) - min(ea(i,j,k),eb(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(i,j,k-1) + add_ent + eatr(i,j,k) = ea(i,j,k) + add_ent + else + 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%m_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 + eatr(i,j,k) = eatr(i,j,k) + add_ent + endif ; endif + enddo ; enddo + do i=is,ie ; eatr(i,j,1) = ea(i,j,1) ; enddo + + 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 + + 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(i,j,nz) ; eatr(i,j,1) = ea(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 + add_ent = ((dt * visc%Kd_extra_S(i,j,k)) * GV%m_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 = 0.0 + endif + ebtr(i,j,k-1) = eb(i,j,k-1) + add_ent + 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 + + 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 + + endif ! (CS%mix_boundary_tracers) + + + + call cpu_clock_end(id_clock_tracers) + + + ! 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, CS%ALE_sponge_CSp, CS%Time) + 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 + 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 + + +! Save the diapycnal mass fluxes as a diagnostic field. + if (associated(CDp%diapyc_vel)) then + !$OMP parallel do default(shared) + do j=js,je + do K=2,nz ; do i=is,ie + CDp%diapyc_vel(i,j,K) = Idt * (GV%H_to_m * (ea(i,j,k) - eb(i,j,k-1))) + enddo ; enddo + do i=is,ie + CDp%diapyc_vel(i,j,1) = 0.0 + CDp%diapyc_vel(i,j,nz+1) = 0.0 + enddo + enddo + endif + +! For momentum, it is only the net flux that homogenizes within +! the mixed layer. Vertical viscosity that is proportional to the +! mixed layer turbulence is applied elsewhere. + if (CS%bulkmixedlayer) then + if (CS%debug) then + call hchksum(ea, "before net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "before net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + !$OMP parallel do default(shared) private(net_ent) + do j=js,je + do K=2,GV%nkml ; do i=is,ie + net_ent = ea(i,j,k) - eb(i,j,k-1) + ea(i,j,k) = max(net_ent, 0.0) + eb(i,j,k-1) = max(-net_ent, 0.0) + enddo ; enddo + enddo + if (CS%debug) then + call hchksum(ea, "after net flux rearrangement ea",G%HI, scale=GV%H_to_m) + call hchksum(eb, "after net flux rearrangement eb",G%HI, scale=GV%H_to_m) + endif + endif + +! Initialize halo regions of ea, eb, and hold to default values. + !$OMP parallel do default(shared) + do k=1,nz + do i=is-1,ie+1 + hold(i,js-1,k) = GV%Angstrom ; ea(i,js-1,k) = 0.0 ; eb(i,js-1,k) = 0.0 + hold(i,je+1,k) = GV%Angstrom ; ea(i,je+1,k) = 0.0 ; eb(i,je+1,k) = 0.0 + enddo + do j=js,je + hold(is-1,j,k) = GV%Angstrom ; ea(is-1,j,k) = 0.0 ; eb(is-1,j,k) = 0.0 + hold(ie+1,j,k) = GV%Angstrom ; ea(ie+1,j,k) = 0.0 ; eb(ie+1,j,k) = 0.0 + enddo + enddo + + call cpu_clock_begin(id_clock_pass) + if (G%symmetric) then ; dir_flag = To_All+Omit_Corners + else ; dir_flag = To_West+To_South+Omit_Corners ; endif + call create_group_pass(CS%pass_hold_eb_ea, hold, G%Domain, dir_flag, halo=1) + 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 + 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 + 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 + 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 + 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 + + 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) + + 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) + + if (CS%id_ea > 0) call post_data(CS%id_ea, ea, CS%diag) + if (CS%id_eb > 0) call post_data(CS%id_eb, eb, CS%diag) + + 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) + + 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, CS%diag, & + id_N2subML=CS%id_subMLN2, id_MLDsq=CS%id_mlotstsq) + endif + if (CS%id_MLD_0125 > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_0125, h, tv, 0.125, G, GV, CS%diag) + endif + if (CS%id_MLD_user > 0) then + call diagnoseMLDbyDensityDifference(CS%id_MLD_user, h, tv, CS%MLDdensityDifference, G, GV, 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) + + num_z_diags = 0 + if (CS%id_Kd_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Kd_z ; z_ptrs(num_z_diags)%p => Kd_int + endif + if (CS%id_Tdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tdif_z ; z_ptrs(num_z_diags)%p => Tdif_flx + endif + if (CS%id_Tadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Tadv_z ; z_ptrs(num_z_diags)%p => Tadv_flx + endif + if (CS%id_Sdif_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sdif_z ; z_ptrs(num_z_diags)%p => Sdif_flx + endif + if (CS%id_Sadv_z > 0) then + num_z_diags = num_z_diags + 1 + z_ids(num_z_diags) = CS%id_Sadv_z ; z_ptrs(num_z_diags)%p => Sadv_flx + endif + + if (num_z_diags > 0) & + call calc_Zint_diags(h, z_ptrs, z_ids, num_z_diags, G, GV, CS%diag_to_Z_CSp) + + if (CS%debugConservation) call MOM_state_stats('leaving diabatic', u, v, h, tv%T, tv%S, G) + if (showCallTree) call callTree_leave("diabatic()") + +end subroutine legacy_diabatic + +!> This routine diagnoses tendencies from application of diabatic diffusion +!! using ALE algorithm. Note that layer thickness is not altered by +!! diabatic diffusion. +subroutine diagnose_diabatic_diff_tendency(tv, h, temp_old, saln_old, dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to diabatic physics + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to diabatic physics (PPT) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + work_3d(:,:,:) = 0.0 + work_2d(:,:) = 0.0 + + + ! temperature tendency + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_temp_tend > 0) then + call post_data(CS%id_diabatic_diff_temp_tend, work_3d, CS%diag, alt_h = h) + endif + + ! heat tendency + if (CS%id_diabatic_diff_heat_tend > 0 .or. CS%id_diabatic_diff_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * tv%C_p * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_heat_tend > 0) then + call post_data(CS%id_diabatic_diff_heat_tend, work_3d, CS%diag, alt_h = h) + endif + if (CS%id_diabatic_diff_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_heat_tend_2d, work_2d, CS%diag) + endif + endif + + ! salinity tendency + if (CS%id_diabatic_diff_saln_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_diabatic_diff_saln_tend, work_3d, CS%diag, alt_h = h) + endif + + ! salt tendency + if (CS%id_diabatic_diff_salt_tend > 0 .or. CS%id_diabatic_diff_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = h(i,j,k) * GV%H_to_kg_m2 * CS%ppt2mks * work_3d(i,j,k) + enddo ; enddo ; enddo + if (CS%id_diabatic_diff_salt_tend > 0) then + call post_data(CS%id_diabatic_diff_salt_tend, work_3d, CS%diag, alt_h = h) + endif + if (CS%id_diabatic_diff_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_diabatic_diff_salt_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_diabatic_diff_tendency + + +!> This routine diagnoses tendencies from application of boundary fluxes. +!! These impacts are generally 3d, in particular for penetrative shortwave. +!! Other fluxes contribute 3d in cases when the layers vanish or are very thin, +!! in which case we distribute the flux into k > 1 layers. +subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & + dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: temp_old !< temperature prior to boundary flux application + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + work_3d(:,:,:) = 0.0 + work_2d(:,:) = 0.0 + + ! Thickness tendency + if (CS%id_boundary_forcing_h_tendency > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (h(i,j,k) - h_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_h_tendency, work_3d, CS%diag, alt_h = h_old) + endif + + ! temperature tendency + if (CS%id_boundary_forcing_temp_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%T(i,j,k)-temp_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_temp_tend, work_3d, CS%diag, alt_h = h_old) + endif + + ! heat tendency + if (CS%id_boundary_forcing_heat_tend > 0 .or. CS%id_boundary_forcing_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * tv%C_p * Idt * (h(i,j,k) * tv%T(i,j,k) - h_old(i,j,k) * temp_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_boundary_forcing_heat_tend > 0) then + call post_data(CS%id_boundary_forcing_heat_tend, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_boundary_forcing_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_boundary_forcing_heat_tend_2d, work_2d, CS%diag) + endif + endif + + ! salinity tendency + if (CS%id_boundary_forcing_saln_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = (tv%S(i,j,k)-saln_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_boundary_forcing_saln_tend, work_3d, CS%diag, alt_h = h_old) + endif + + ! salt tendency + if (CS%id_boundary_forcing_salt_tend > 0 .or. CS%id_boundary_forcing_salt_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + work_3d(i,j,k) = GV%H_to_kg_m2 * CS%ppt2mks * Idt * (h(i,j,k) * tv%S(i,j,k) - h_old(i,j,k) * saln_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_boundary_forcing_salt_tend > 0) then + call post_data(CS%id_boundary_forcing_salt_tend, work_3d, CS%diag, alt_h = h_old) + endif + if (CS%id_boundary_forcing_salt_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + work_3d(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_boundary_forcing_salt_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_boundary_forcing_tendency + + +!> This routine diagnoses tendencies for temperature and heat from frazil formation. +!! This routine is called twice from within subroutine diabatic; at start and at +!! end of the diabatic processes. The impacts from frazil are generally a function +!! of depth. Hence, when checking heat budget, be sure to remove HFSIFRAZIL from HFDS in k=1. +subroutine diagnose_frazil_tendency(tv, h, temp_old, dt, G, GV, CS) + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(diabatic_CS), pointer :: CS !< module control structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to frazil formation + real, intent(in) :: dt !< time step (sec) + + real, dimension(SZI_(G),SZJ_(G)) :: work_2d + real :: Idt + integer :: i, j, k, is, ie, js, je, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Idt = 1/dt + + ! temperature tendency + if (CS%id_frazil_temp_tend > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%frazil_temp_diag(i,j,k) = Idt * (tv%T(i,j,k)-temp_old(i,j,k)) + enddo ; enddo ; enddo + call post_data(CS%id_frazil_temp_tend, CS%frazil_temp_diag(:,:,:), CS%diag) + endif + + ! heat tendency + if (CS%id_frazil_heat_tend > 0 .or. CS%id_frazil_heat_tend_2d > 0) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%frazil_heat_diag(i,j,k) = GV%H_to_kg_m2 * tv%C_p * h(i,j,k) * Idt * (tv%T(i,j,k)-temp_old(i,j,k)) + enddo ; enddo ; enddo + if (CS%id_frazil_heat_tend > 0) call post_data(CS%id_frazil_heat_tend, CS%frazil_heat_diag(:,:,:), CS%diag) + + ! As a consistency check, we must have + ! FRAZIL_HEAT_TENDENCY_2d = HFSIFRAZIL + if (CS%id_frazil_heat_tend_2d > 0) then + do j=js,je ; do i=is,ie + work_2d(i,j) = 0.0 + do k=1,nz + work_2d(i,j) = work_2d(i,j) + CS%frazil_heat_diag(i,j,k) + enddo + enddo ; enddo + call post_data(CS%id_frazil_heat_tend_2d, work_2d, CS%diag) + endif + endif + +end subroutine diagnose_frazil_tendency + + +!> \namespace mom_diabatic_driver +!! +!! By Robert Hallberg, Alistair Adcroft, and Stephen Griffies +!! +!! This program contains the subroutine that, along with the +!! subroutines that it calls, implements diapycnal mass and momentum +!! fluxes and a bulk mixed layer. The diapycnal diffusion can be +!! used without the bulk mixed layer. +!! +!! \section section_diabatic Outline of MOM diabatic +!! +!! * diabatic first determines the (diffusive) diapycnal mass fluxes +!! based on the convergence of the buoyancy fluxes within each layer. +!! +!! * The dual-stream entrainment scheme of MacDougall and Dewar (JPO, +!! 1997) is used for combined diapycnal advection and diffusion, +!! calculated implicitly and potentially with the Richardson number +!! dependent mixing, as described by Hallberg (MWR, 2000). +!! +!! * Diapycnal advection is the residual of diapycnal diffusion, +!! so the fully implicit upwind differencing scheme that is used is +!! entirely appropriate. +!! +!! * The downward buoyancy flux in each layer is determined from +!! an implicit calculation based on the previously +!! calculated flux of the layer above and an estimated flux in the +!! layer below. This flux is subject to the following conditions: +!! (1) the flux in the top and bottom layers are set by the boundary +!! conditions, and (2) no layer may be driven below an Angstrom thick- +!! ness. If there is a bulk mixed layer, the buffer layer is treated +!! as a fixed density layer with vanishingly small diffusivity. +!! +!! diabatic takes 5 arguments: the two velocities (u and v), the +!! thicknesses (h), a structure containing the forcing fields, and +!! the length of time over which to act (dt). The velocities and +!! thickness are taken as inputs and modified within the subroutine. +!! There is no limit on the time step. + +end module MOM_legacy_diabatic_driver From 198d75559a5f7ef65c566a3f56f9c641286329e8 Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 May 2018 11:14:06 -0600 Subject: [PATCH 52/53] Delete visc%kv_slow=0 since this is done in set_diffusivity --- src/parameterizations/vertical/MOM_diabatic_driver.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 882ed8cb26..698243a7f6 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -387,9 +387,6 @@ 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 - ! visc%Kv_slow must be set to zero - visc%Kv_slow(:,:,:) = 0.0 - if (nz == 1) return showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic(), MOM_diabatic_driver.F90") From 720dbc04da0cd278d6c2fe6f56aa2edc0c14e90b Mon Sep 17 00:00:00 2001 From: Gustavo Marques Date: Wed, 23 May 2018 11:25:31 -0600 Subject: [PATCH 53/53] Doxygenize set_diff + read background kinematic viscosity --- .../vertical/MOM_set_diffusivity.F90 | 201 ++++++++++-------- 1 file changed, 109 insertions(+), 92 deletions(-) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9835c19912..903868795a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -45,95 +45,94 @@ module MOM_set_diffusivity public set_diffusivity_end type, public :: set_diffusivity_CS ; private - logical :: debug ! If true, write verbose checksums for debugging. - - logical :: bulkmixedlayer ! If true, a refined bulk mixed layer is used with - ! GV%nk_rho_varies variable density mixed & buffer - ! layers. - real :: FluxRi_max ! The flux Richardson number where the stratification is - ! large enough that N2 > omega2. The full expression for - ! the Flux Richardson number is usually - ! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. - logical :: bottomdraglaw ! If true, the bottom stress is calculated with a - ! drag law c_drag*|u|*u. - logical :: BBL_mixing_as_max ! If true, take the maximum of the diffusivity - ! from the BBL mixing and the other diffusivities. - ! Otherwise, diffusivities from the BBL_mixing is - ! added. - logical :: use_LOTW_BBL_diffusivity ! If true, use simpler/less precise, BBL diffusivity. - logical :: LOTW_BBL_use_omega ! If true, use simpler/less precise, BBL diffusivity. - real :: BBL_effic ! efficiency with which the energy extracted - ! by bottom drag drives BBL diffusion (nondim) - real :: cdrag ! quadratic drag coefficient (nondim) - real :: IMax_decay ! inverse of a maximum decay scale for - ! bottom-drag driven turbulence, (1/m) - - real :: Kd ! interior diapycnal diffusivity (m2/s) - real :: Kd_min ! minimum diapycnal diffusivity (m2/s) - real :: Kd_max ! maximum increment for diapycnal diffusivity (m2/s) - ! Set to a negative value to have no limit. - real :: Kd_add ! uniform diffusivity added everywhere without - ! filtering or scaling (m2/s) - real :: Kv ! interior vertical viscosity (m2/s) - real :: Kdml ! mixed layer diapycnal diffusivity (m2/s) - ! when bulkmixedlayer==.false. - real :: Hmix ! mixed layer thickness (meter) when - ! bulkmixedlayer==.false. + logical :: debug !< If true, write verbose checksums for debugging. + + logical :: bulkmixedlayer !< If true, a refined bulk mixed layer is used with + !! GV%nk_rho_varies variable density mixed & buffer + !! layers. + real :: FluxRi_max !< The flux Richardson number where the stratification is + !! large enough that N2 > omega2. The full expression for + !! the Flux Richardson number is usually + !! FLUX_RI_MAX*N2/(N2+OMEGA2). The default is 0.2. + logical :: bottomdraglaw !< If true, the bottom stress is calculated with a + !! drag law c_drag*|u|*u. + logical :: BBL_mixing_as_max !< If true, take the maximum of the diffusivity + !! from the BBL mixing and the other diffusivities. + !! Otherwise, diffusivities from the BBL_mixing is + !! added. + logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. + logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. + real :: BBL_effic !< efficiency with which the energy extracted + !! by bottom drag drives BBL diffusion (nondim) + real :: cdrag !< quadratic drag coefficient (nondim) + real :: IMax_decay !< inverse of a maximum decay scale for + !! bottom-drag driven turbulence, (1/m) + real :: Kv !< The interior vertical viscosity (m2/s) + real :: Kd !< interior diapycnal diffusivity (m2/s) + real :: Kd_min !< minimum diapycnal diffusivity (m2/s) + real :: Kd_max !< maximum increment for diapycnal diffusivity (m2/s) + !! Set to a negative value to have no limit. + real :: Kd_add !< uniform diffusivity added everywhere without + !! filtering or scaling (m2/s) + real :: Kdml !< mixed layer diapycnal diffusivity (m2/s) + !! when bulkmixedlayer==.false. + real :: Hmix !< mixed layer thickness (meter) when + !! bulkmixedlayer==.false. type(diag_ctrl), pointer :: diag ! structure to regulate diagn output timing - logical :: limit_dissipation ! If enabled, dissipation is limited to be larger - ! than the following: - real :: dissip_min ! Minimum dissipation (W/m3) - real :: dissip_N0 ! Coefficient a in minimum dissipation = a+b*N (W/m3) - real :: dissip_N1 ! Coefficient b in minimum dissipation = a+b*N (J/m3) - real :: dissip_N2 ! Coefficient c in minimum dissipation = c*N2 (W m-3 s2) - real :: dissip_Kd_min ! Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 - - real :: TKE_itide_max ! maximum internal tide conversion (W m-2) - ! available to mix above the BBL - real :: omega ! Earth's rotation frequency (s-1) - logical :: ML_radiation ! allow a fraction of TKE available from wind work - ! to penetrate below mixed layer base with a vertical - ! decay scale determined by the minimum of - ! (1) The depth of the mixed layer, or - ! (2) An Ekman length scale. - ! Energy availble to drive mixing below the mixed layer is - ! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if - ! ML_rad_TKE_decay is true, this is further reduced by a factor - ! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is - ! calculated the same way as in the mixed layer code. - ! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), - ! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 - ! is the rotation rate of the earth squared. - real :: ML_rad_kd_max ! Maximum diapycnal diffusivity due to turbulence - ! radiated from the base of the mixed layer (m2/s) - real :: ML_rad_efold_coeff ! non-dim coefficient to scale penetration depth - real :: ML_rad_coeff ! coefficient, which scales MSTAR*USTAR^3 to - ! obtain energy available for mixing below - ! mixed layer base (nondimensional) - 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. - real :: ustar_min ! A minimum value of ustar to avoid numerical - ! problems (m/s). If the value is small enough, - ! this parameter should not affect the solution. - real :: TKE_decay ! ratio of natural Ekman depth to TKE decay scale (nondim) - real :: mstar ! ratio of friction velocity cubed to - ! TKE input to the mixed layer (nondim) - logical :: ML_use_omega ! If true, use absolute rotation rate instead - ! of the vertical component of rotation when - ! setting the decay scale for mixed layer turbulence. - real :: ML_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 f^2 ~= (1-of)*f^2 + of*4*omega^2. - logical :: user_change_diff ! If true, call user-defined code to change diffusivity. - logical :: useKappaShear ! If true, use the kappa_shear module to find the - ! shear-driven diapycnal diffusivity. - logical :: use_CVMix_shear ! If true, use one of the CVMix modules to find - ! shear-driven diapycnal diffusivity. - logical :: use_CVMix_ddiff ! If true, enable double-diffusive mixing via CVMix. - logical :: simple_TKE_to_Kd ! If true, uses a simple estimate of Kd/TKE that - ! does not rely on a layer-formulation. + logical :: limit_dissipation !< If enabled, dissipation is limited to be larger + !! than the following: + real :: dissip_min !< Minimum dissipation (W/m3) + real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N (W/m3) + real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N (J/m3) + real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 (W m-3 s2) + real :: dissip_Kd_min !< Minimum Kd (m2/s) with dissipatio Rho0*Kd_min*N^2 + + real :: TKE_itide_max !< maximum internal tide conversion (W m-2) + !! available to mix above the BBL + real :: omega !< Earth's rotation frequency (s-1) + logical :: ML_radiation !< allow a fraction of TKE available from wind work + !! to penetrate below mixed layer base with a vertical + !! decay scale determined by the minimum of + !! (1) The depth of the mixed layer, or + !! (2) An Ekman length scale. + !! Energy availble to drive mixing below the mixed layer is + !! given by E = ML_RAD_COEFF*MSTAR*USTAR**3. Optionally, if + !! ML_rad_TKE_decay is true, this is further reduced by a factor + !! of exp(-h_ML*Idecay_len_TkE), where Idecay_len_TKE is + !! calculated the same way as in the mixed layer code. + !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), + !! where N2 is the squared buoyancy frequency (s-2) and OMEGA2 + !! is the rotation rate of the earth squared. + real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence + !! radiated from the base of the mixed layer (m2/s) + real :: ML_rad_efold_coeff !< non-dim coefficient to scale penetration depth + real :: ML_rad_coeff !< coefficient, which scales MSTAR*USTAR^3 to + !! obtain energy available for mixing below + !! mixed layer base (nondimensional) + 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. + real :: ustar_min !< A minimum value of ustar to avoid numerical + !! problems (m/s). If the value is small enough, + !! this parameter should not affect the solution. + real :: TKE_decay !< ratio of natural Ekman depth to TKE decay scale (nondim) + real :: mstar !! ratio of friction velocity cubed to + !! TKE input to the mixed layer (nondim) + logical :: ML_use_omega !< If true, use absolute rotation rate instead + !! of the vertical component of rotation when + !! setting the decay scale for mixed layer turbulence. + real :: ML_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 f^2 ~= (1-of)*f^2 + of*4*omega^2. + logical :: user_change_diff !< If true, call user-defined code to change diffusivity. + logical :: useKappaShear !< If true, use the kappa_shear module to find the + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_shear !< If true, use one of the CVMix modules to find + !! shear-driven diapycnal diffusivity. + logical :: use_CVMix_ddiff !< If true, enable double-diffusive mixing via CVMix. + logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that + !! does not rely on a layer-formulation. character(len=200) :: inputdir type(user_change_diff_CS), pointer :: user_change_diff_CSp => NULL() @@ -177,6 +176,17 @@ module MOM_set_diffusivity contains +!> Sets the interior vertical diffusion of scalars due to the following processes: +!! 1) Shear-driven mixing: two options, Jackson et at. and KPP interior; +!! 2) Background mixing via CVMix (Bryan-Lewis profile) or the scheme described by +!! Harrison & Hallberg, JPO 2008; +!! 3) Double-diffusion aplpied via CVMix; +!! 4) Tidal mixing: many options available, see MOM_tidal_mixing.F90; +!! In addition, this subroutine has the option to set the interior vertical +!! viscosity associated with processes 2-4 listed above, which is stored in +!! visc%Kv_slow. Vertical viscosity due to shear-driven mixing is passed via +!! visc%Kv_shear +!! GMM, TODO: add contribution from tidal mixing into visc%Kv_slow subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & G, GV, CS, Kd, Kd_int) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -188,9 +198,9 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: u_h + intent(in) :: u_h !< zonal thickness transport m^2/s. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: v_h + intent(in) :: v_h !< meridional thickness transport m^2/s. type(thermo_var_ptrs), intent(inout) :: tv !< Structure with pointers to thermodynamic !! fields. Out is for tv%TempxPmE. type(forcing), intent(in) :: fluxes !< Structure of surface fluxes that may be @@ -270,7 +280,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(:,:,:) = CS%Kd Kd_int(:,:,:) = CS%Kd - visc%Kv_slow(:,:,:) = CS%Kv + if (associated(visc%Kv_slow)) visc%Kv_slow(:,:,:) = CS%Kv ! Set up arrays for diagnostics. @@ -331,6 +341,10 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & elseif (CS%use_CVMix_shear) then !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,CS%CVMix_shear_csp) + if (CS%debug) then + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear",G%HI) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear",G%HI) + endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0. ! needed if calculate_kappa_shear is not enabled endif @@ -342,8 +356,6 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! set surface diffusivities (CS%bkgnd_mixing_csp%Kd_sfc) call sfc_bkgnd_mixing(G, CS%bkgnd_mixing_csp) -! GMM, fix OMP calls below - !$OMP parallel do default(none) shared(is,ie,js,je,nz,G,GV,CS,h,tv,T_f,S_f,fluxes,dd, & !$OMP Kd,visc, & !$OMP Kd_int,dt,u,v,Omega2) & @@ -1826,6 +1838,11 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! set params releted to the background mixing call bkgnd_mixing_init(Time, G, GV, param_file, CS%diag, CS%bkgnd_mixing_csp) + call get_param(param_file, mdl, "KV", CS%Kv, & + "The background kinematic viscosity in the interior. \n"//& + "The molecular value, ~1e-6 m2 s-1, may be used.", & + units="m2 s-1", fail_if_missing=.true.) + call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//&