Merge pull request #97 from mnlevy1981/more_updates_from_wlarge

Additional changes to StokesMOST
CVMix · Oct 12, 2024 · 5e3d0ce · 5e3d0ce
2 parents eba2b7f + 5fb6230
commit 5e3d0ce
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 32 deletions.
diff --git a/bld/CompileFlags.mak b/bld/CompileFlags.mak
@@ -20,7 +20,7 @@ else
 endif
 
 ifeq ($(FC_TMP),gfortran)
-  FCFLAGS = -O2 -ffree-form -J $(OBJ_DIR) -cpp -Wall -Werror
+  FCFLAGS = -g -Og -Wall -Wno-maybe-uninitialized -Werror -fbacktrace -ffpe-trap=zero,overflow -fcheck=bounds -J $(OBJ_DIR)
 endif
 
 ifeq ($(FC_TMP),pgf90)

diff --git a/src/shared/cvmix_kpp.F90 b/src/shared/cvmix_kpp.F90
@@ -208,6 +208,9 @@ module cvmix_kpp
       real(cvmix_r8) :: RWHGK_ENTR_COEF,& ! Coefficient and exponent from
                         RWHGK_ENTR_EXP    ! RWHGK16 Langmuir parameterization
 
+      real(cvmix_r8) :: CVt2              ! Tunable parameter for convection entrainment
+                                          ! (Only used with StokesMOST)
+
   end type cvmix_kpp_params_type
 
 !EOP
@@ -480,10 +483,11 @@ subroutine cvmix_init_kpp(ri_crit, minOBLdepth, maxOBLdepth, minVtsqr,      &
     end if
 
     if (present(lStokesMOST)) then
-       call cvmix_put_kpp('lStokesMOST',lStokesMOST , CVmix_kpp_params_user)
+       call cvmix_put_kpp('lStokesMOST', lStokesMOST, CVmix_kpp_params_user)
     else
       call cvmix_put_kpp('lStokesMOST', .false., CVmix_kpp_params_user)
     end if
+    call cvmix_put_kpp('CVt2', 2.6_cvmix_r8, CVmix_kpp_params_user)
 
     if (present(lEkman)) then
       call cvmix_put_kpp('lEkman', lEkman, CVmix_kpp_params_user)
@@ -1316,6 +1320,8 @@ subroutine cvmix_put_kpp_real(varname, val, CVmix_kpp_params_user)
         CVmix_kpp_params_out%surf_layer_ext = val
       case ('Cv')
         CVmix_kpp_params_out%Cv = val
+      case ('CVt2')
+        CVmix_kpp_params_out%CVt2 = val
       case ('nonlocal_coeff')
         CVmix_kpp_params_out%nonlocal_coeff = val
       case ('c_CT')
@@ -1500,6 +1506,8 @@ function cvmix_get_kpp_real(varname, CVmix_kpp_params_user)
         cvmix_get_kpp_real = CVmix_kpp_params_get%surf_layer_ext
       case ('Cv')
         cvmix_get_kpp_real = CVmix_kpp_params_get%Cv
+      case ('CVt2')
+        cvmix_get_kpp_real = CVmix_kpp_params_get%CVt2
       case ('c_CT')
         cvmix_get_kpp_real = CVmix_kpp_params_get%c_CT
       case ('c_ST')
@@ -2593,7 +2601,7 @@ function cvmix_kpp_compute_unresolved_shear(zt_cntr, ws_cntr, N_iface,      &
 
     ! Local variables
     integer :: kt, nlev
-    real(cvmix_r8) :: Cv, Vtc
+    real(cvmix_r8) :: Cv, Vtc, beta, xbeta, ybeta   ! pure convection entrainment rule
     logical :: lwstar          ! use wstar rather than w_s
     real(cvmix_r8) :: wstar    ! convective velocity scale
     real(cvmix_r8) :: ws_wstar ! ratio in limit of pure convection
@@ -2651,36 +2659,30 @@ function cvmix_kpp_compute_unresolved_shear(zt_cntr, ws_cntr, N_iface,      &
     end if
 
   if ( CVmix_kpp_params_in%lStokesMOST ) then
-    if (present(N_iface)) then
-      lwstar   = .false.   !  .true.
-
-      ws_wstar = CVmix_kpp_params_in%vonkarman * real(25,cvmix_r8) ! *  &
-      ws_wstar = CVmix_kpp_params_in%vonkarman * ws_wstar**(cvmix_one/real(3,cvmix_r8))
-
-
-      Vtc = sqrt(0.2_cvmix_r8 *3.8409_cvmix_r8 /ws_wstar) /CVmix_kpp_params_in%Ri_crit
-
-      Cv = 1.4_cvmix_r8
-
-      do kt=1,nlev
-        if (lwstar ) then
-          wstar = (MAX(0.0 , zt_cntr(kt) * bfsfc(kt) ))**(cvmix_one/real(3,cvmix_r8))
-          cvmix_kpp_compute_unresolved_shear(kt) = &
-               -zt_cntr(kt) * N_iface(kt) * Cv * Vtc * wstar
-        else
-          cvmix_kpp_compute_unresolved_shear(kt) = &
-               -zt_cntr(kt) * N_iface(kt) * Cv * Vtc * ws_cntr(kt) / ws_wstar
-        end if
+    lwstar   = .false.   !  .true.
+    ws_wstar = CVmix_kpp_params_in%vonkarman * cvmix_one * real(25,cvmix_r8) ! *  &
+    ws_wstar = CVmix_kpp_params_in%vonkarman * ws_wstar**(cvmix_one/real(3,cvmix_r8))
+
+    do kt=1,nlev
+      xbeta = MAX( cvmix_zero , MIN( (300._cvmix_r8-100._cvmix_r8) , (-zt_cntr(kt) - 100._cvmix_r8) ) )
+      xbeta = xbeta / (300._cvmix_r8-100._cvmix_r8)
+      ybeta = (cvmix_one - xbeta*xbeta)**2
+      beta  = ybeta * 0.2_cvmix_r8
+      Vtc = sqrt( beta *3.8409_cvmix_r8 /ws_wstar) /CVmix_kpp_params_in%Ri_crit
+      if (lwstar ) then
+        wstar = (MAX(0.0 , zt_cntr(kt) * bfsfc(kt) ))**(cvmix_one/real(3,cvmix_r8))
+        cvmix_kpp_compute_unresolved_shear(kt) = &
+             -zt_cntr(kt) * N_cntr(kt)  * CVmix_kpp_params_in%CVt2 * Vtc * wstar
+      else
+        cvmix_kpp_compute_unresolved_shear(kt) = &
+             -zt_cntr(kt) * N_cntr(kt)  * CVmix_kpp_params_in%CVt2 * Vtc * ws_cntr(kt) / ws_wstar
+      end if
 
-        if (cvmix_kpp_compute_unresolved_shear(kt).lt.                       &
-                CVmix_kpp_params_in%minVtsqr) then
-              cvmix_kpp_compute_unresolved_shear(kt) = CVmix_kpp_params_in%minVtsqr
-        end if
-      enddo
-    else
-     print*, "ERROR: StokesMOST package requires N_iface in cvmix_kpp_compute_unresolved_shear "
-        stop 1
-    end if
+      if (cvmix_kpp_compute_unresolved_shear(kt).lt.                       &
+              CVmix_kpp_params_in%minVtsqr) then
+            cvmix_kpp_compute_unresolved_shear(kt) = CVmix_kpp_params_in%minVtsqr
+      end if
+    enddo
   else    ! not lStokesMOST
 
     ! options for Langmuir enhanced entrainment