Merge pull request #316 from matsbn/feature-hybrid_enhancements3

Hybrid coordinate enhancements 3
NorESMhub · Dec 1, 2023 · f5dd74d · f5dd74d
2 parents cca8d11 + a0bfb39
commit f5dd74d
Show file tree

Hide file tree

Showing 4 changed files with 43 additions and 33 deletions.
diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml
@@ -65,8 +65,8 @@
     <type>char</type>
     <valid_values>isopyc_bulkml,cntiso_hybrid</valid_values>
     <default_value>isopyc_bulkml</default_value>
-    <group>run_component_blom</group>
-    <file>env_run.xml</file>
+    <group>build_component_blom</group>
+    <file>env_build.xml</file>
     <desc>Vertical coordinate type of BLOM</desc>
   </entry>
 

diff --git a/phy/mod_cmnfld_routines.F90 b/phy/mod_cmnfld_routines.F90
@@ -1,5 +1,5 @@
 ! ------------------------------------------------------------------------------
-! Copyright (C) 2015-2022 Mats Bentsen, Mehmet Ilicak
+! Copyright (C) 2015-2023 Mats Bentsen, Mehmet Ilicak
 !
 ! This file is part of BLOM.
 !
@@ -825,34 +825,56 @@ subroutine cmnfld_nnslope_cntiso_hybrid(m, n, mm, nn, k1m, k1n)
       integer, intent(in) :: m, n, mm, nn, k1m, k1n
 
       real(r8) :: bfsqm
-      integer :: i, j, k, l
+      integer :: i, j, knnsl, k, l
 
       call xctilr(nslpx, 1, kk, 2, 2, halo_uv)
       call xctilr(nslpy, 1, kk, 2, 2, halo_vv)
 
-   !$omp parallel do private(k, l, i, bfsqm)
+   !$omp parallel do private(l, i, knnsl, k, bfsqm)
       do j = - 1, jj + 2
-         do k = 1, kk
-            do l = 1, isu(j)
-            do i = max(0, ifu(j, l)), min(ii + 2, ilu(j, l))
-               bfsqm = .5_r8*(bfsqf(i - 1, j, k) + bfsqf(i, j, k))
-               nnslpx(i, j, k) = sqrt(bfsqm)*nslpx(i, j, k)
+         do l = 1, isu(j)
+         do i = max(0, ifu(j, l)), min(ii + 2, ilu(j, l))
+            knnsl = 1
+            nnslpx(i, j, 1) = 0._r8
+            do k = 2, kk
+               if (p(i    , j, k) < p(i - 1, j, kk + 1) .and. &
+                   p(i - 1, j, k) < p(i    , j, kk + 1)) then
+                  bfsqm = .5_r8*(bfsqf(i - 1, j, k) + bfsqf(i, j, k))
+                  nnslpx(i, j, k) = sqrt(bfsqm)*nslpx(i, j, k)
+                  knnsl = k
+               else
+                  exit
+               endif
             enddo
+            do k = knnsl + 1, kk
+               nnslpx(i, j, k) = nnslpx(i, j, knnsl)
             enddo
          enddo
+         enddo
       enddo
    !$omp end parallel do
 
-   !$omp parallel do private(k, l, i, bfsqm)
+   !$omp parallel do private(l, i, knnsl, k, bfsqm)
       do j = 0, jj + 2
-         do k = 1, kk
-            do l = 1, isv(j)
-            do i = max(- 1, ifv(j, l)), min(ii + 2, ilv(j, l))
-               bfsqm = .5_r8*(bfsqf(i, j - 1, k) + bfsqf(i, j, k))
-               nnslpy(i, j, k) = sqrt(bfsqm)*nslpy(i, j, k)
+         do l = 1, isv(j)
+         do i = max(- 1, ifv(j, l)), min(ii + 2, ilv(j, l))
+            knnsl = 1
+            nnslpy(i, j, 1) = 0._r8
+            do k = 2, kk
+               if (p(i, j    , k) < p(i, j - 1, kk + 1) .and. &
+                   p(i, j - 1, k) < p(i, j    , kk + 1)) then
+                  bfsqm = .5_r8*(bfsqf(i, j - 1, k) + bfsqf(i, j, k))
+                  nnslpy(i, j, k) = sqrt(bfsqm)*nslpy(i, j, k)
+                  knnsl = k
+               else
+                  exit
+               endif
             enddo
+            do k = knnsl + 1, kk
+               nnslpy(i, j, k) = nnslpy(i, j, knnsl)
             enddo
          enddo
+         enddo
       enddo
    !$omp end parallel do
 

diff --git a/phy/mod_difest.F b/phy/mod_difest.F
@@ -1650,13 +1650,7 @@ subroutine difest_lateral_hyb(m,n,mm,nn,k1m,k1n)
                     egrup(i)=egrlo
                     if (edsprs.or.edanis) then
                       if (eddf2d) then
-                        if (p(i,j,k+1).gt.
-     .                      min(p(i-1,j,kk+1),p(i+1,j,kk+1),
-     .                          p(i,j-1,kk+1),p(i,j+1,kk+1))) then
-                          q=0.
-                        else
-                          q=max(0.,p(i,j,k+1)-p(i,j,k))
-                        endif
+                        q=max(0.,p(i,j,k+1)-p(i,j,k))
                       else
                         q=max(0.,min(p(i,j,kfil(i,j))+dpgrav,
      .                               p(i,j,k+1))-p(i,j,k))
@@ -1765,13 +1759,7 @@ subroutine difest_lateral_hyb(m,n,mm,nn,k1m,k1n)
 c --- --------- anisotrophy if requested.
 c
                 if (eddf2d) then
-                  if (p(i,j,k+1).gt.
-     .                min(p(i-1,j,kk+1),p(i+1,j,kk+1),
-     .                    p(i,j-1,kk+1),p(i,j+1,kk+1))) then
-                    q=0.
-                  else
-                    q=max(0.,p(i,j,k+1)-p(i,j,k))
-                  endif
+                  q=max(0.,p(i,j,k+1)-p(i,j,k))
                 else
 c
 c --- ----------- Only consider a region below the first physical layer

diff --git a/phy/mod_vcoord.F90 b/phy/mod_vcoord.F90
@@ -1,5 +1,5 @@
 ! ------------------------------------------------------------------------------
-! Copyright (C) 2021-2022 Mats Bentsen, Mehmet Ilicak
+! Copyright (C) 2021-2023 Mats Bentsen, Mehmet Ilicak
 !
 ! This file is part of BLOM.
 !
@@ -622,7 +622,7 @@ subroutine cntiso_regrid_nudge_jslice(p_src, p_dst, i_lb, i_ub, j, j_rs, nn)
                            /(p_src(kl+1,i) - p_src(kl,i))
             if (sigmar_1d(kt) > sig_pmin(kt)) then
                ktzmin = max(2, kt - dktzu)
-               ktzmax = min(ksmx(i), kdmx(i), kt + dktzl)
+               ktzmax = min(ksmx(i) + 1, kt + dktzl)
                if (ktzmin < kt .and. ktzmax - ktzmin > 1) tzfound = .true.
                exit
             endif
@@ -748,7 +748,7 @@ subroutine cntiso_regrid_nudge_jslice(p_src, p_dst, i_lb, i_ub, j, j_rs, nn)
             if (d > 0._r8) then
                do k = ktzmin, ktzmax-1
                   rk = k - ktzmin + ckt
-                  p_dst(k,i) = a + rk*(b + rk*(c + rk*d))
+                  p_dst(k,i) = max(p_dst(k,i), a + rk*(b + rk*(c + rk*d)))
                enddo
             endif
          endif