Merge pull request NCAR#1147 from scrasmussen/ufs-dev-PR287

ufs-dev PR#287

Author: grantfirl

physics/GWD/drag_suite.F90

@@ -1731,7 +1731,7 @@ subroutine drag_suite_psl(                                           &
    real(kind=kind_phys),parameter       :: odmax  = 10.
    real(kind=kind_phys),parameter       :: cdmin  = 0.0
    integer              :: komax(im),kbmax(im),kblk(im)
-   real(kind=kind_phys)                 :: hmax(im)
+   real(kind=kind_phys)                 :: href(im),hmax(im)
    real(kind=kind_phys)                 :: cd
    real(kind=kind_phys)                 :: zblk,tautem
    real(kind=kind_phys)                 :: pe,ke
@@ -1916,6 +1916,7 @@ subroutine drag_suite_psl(                                           &
 !  initialize array for flow-blocking drag
 !
    taufb(1:im,1:km+1) = 0.0
+   href(1:im) = 0.0
    hmax(1:im) = 0.0
    komax(1:im) = 0
    kbmax(1:im) = 0
@@ -2000,11 +2001,13 @@ subroutine drag_suite_psl(                                           &
 !
    do i = its,im
      hmax(i) = max(elvmax(i),zlowtop(i))
+     href(i) = max(hmax(i),hpbl(i))
    enddo
 !
    do i = its,im
 !!!     kbl(i)   = max(kpbl(i), klowtop(i))    ! do not use pbl height for the time being...
-     kbl(i)   = max(komax(i), klowtop(i))    
+     kbl(i)   = max(komax(i), klowtop(i))
+     kbl(i)   = max(kbl(i), kpbl(i))    
      kbl(i)   = max(min(kbl(i),kpblmax),kpblmin)
    enddo
 !
@@ -2109,7 +2112,7 @@ subroutine drag_suite_psl(                                           &
 !
 !  no drag when sub-oro is too small..
 !
-         ldrag(i) = hmax(i).le.hmt_min
+         ldrag(i) = href(i).le.hmt_min
 !
 !  no drag when critical level in the base layer
 !