Permalink
Cannot retrieve contributors at this time
!--------------------------------------------------------------------------------- | |
! Purpose: | |
! | |
! !DESCRIPTION: | |
! Separates the surface flux contribution (evaporative fraction) from | |
! the non-evaporative contribution to changes in relative humidity at the top of the | |
! boundary layer. Terms quantifying dry air entrainment, boundary layer growth, and | |
! boundary layer heating contribution to relative humidity changes at the top of the | |
! boundary layer are also returned. | |
! | |
! !NOTES: | |
! The module works ONLY if you have the heat entrainment ratio. This can be estimated | |
! by using the Mixing Diagram incremental method (See Santanello et al. 2009 | |
! Section 2 b.2) | |
! | |
! References: Ek and Mahrt 1994, Daytime Evolution of Relative humidity at the | |
! Boundary Layer Top | |
! | |
! Ek and Holtslag 2004, Influence of Soil Moisture on Boundary Layer Cloud | |
! Development | |
! | |
! Author and Revision History: | |
! Original Code -- A.B. Tawfik on Apr 2015 | |
! | |
!--------------------------------------------------------------------------------- | |
module RH_Tend_Mod | |
! | |
! subroutine name | |
! | |
public rh_tend_calc ! the main RH-tendency interface | |
!--------------------------------------------------------------------------------- | |
contains | |
!--------------------------------------------------------------------------------- | |
!--------------------------------------------------------------------------------- | |
! | |
! subroutines: main relative humidity tendency calculation routine | |
! | |
!--------------------------------------------------------------------------------- | |
subroutine rh_tend_calc ( nlev , ntim , & | |
tmp_in , qhum_in, hgt_in, press_in, & | |
pbl_h , shf , lhf , dt , & | |
ef , ne , & | |
pbl_heating , pbl_growth, dry_entrain, & | |
dRH_estimate, missing ) | |
implicit none | |
! | |
! Input/Output Variables | |
! | |
integer, intent(in ) :: ntim, nlev | |
real(4), intent(in ) :: missing ! *** missing value - useful for obs | |
real(4), intent(in ) :: dt ! *** time increment of the hours dimension [seconds] | |
real(4), intent(in ), dimension(ntim,nlev) :: press_in ! *** pressure - (time,nlev) [Pa] | |
real(4), intent(in ), dimension(ntim,nlev) :: hgt_in ! *** height - (time,nlev) [m] | |
real(4), intent(in ), dimension(ntim,nlev) :: tmp_in ! *** temperature - (time,nlev) [K] | |
real(4), intent(in ), dimension(ntim,nlev) :: qhum_in ! *** specific humidity - (time,nlev) [kg/kg] | |
real(4), intent(in ), dimension(ntim) :: pbl_h ! *** boundary layer height - (time) [m] | |
real(4), intent(in ), dimension(ntim) :: shf, lhf ! *** surface energy fluxes - (time) [W/m2] | |
real(4), intent(out ), dimension(ntim) :: ef ! *** evaporative fraction - (time) [unitless] | |
real(4), intent(out ), dimension(ntim) :: ne ! *** non-evaporative term - (time) [unitless] | |
real(4), intent(out ), dimension(ntim) :: pbl_growth ! *** PBL growth contribution to d(RH)/dt [%/s] | |
real(4), intent(out ), dimension(ntim) :: pbl_heating ! *** PBL heating contribution to d(RH)/dt [%/s] | |
real(4), intent(out ), dimension(ntim) :: dry_entrain ! *** Dry air entrainment to d(RH)/dt [%/s] | |
real(4), intent(out ), dimension(ntim) :: dRH_estimate ! *** d(RH)/dt estimated by RH-tend method [%/s] | |
! | |
! Local variables | |
! | |
real(4), parameter :: p_ref = 1e5 , Lv = 2.5e6 , cp = 1005.7, Rd = 287.04 | |
real(4), parameter :: grav = 9.81 , Lv_cp = Lv/cp , R_cp = Rd/cp | |
real(4), parameter :: Rv = 461.5 | |
real(4), parameter :: pi = 4.*atan(1.), cp_g=cp/grav, Lv_g=Lv/grav | |
real(4), parameter :: r2d = 180./pi | |
real(4), parameter :: by100 = 1e2 | |
real(4), parameter :: t0 = 273.15, ep=0.622, es0=6.11, a=17.269, b=35.86 | |
real(4), parameter :: onemep = 1 - ep | |
integer :: tt, zz | |
real(4), dimension(ntim,nlev) :: psfc_2d | |
real(4), dimension(ntim,nlev) :: pblh_2d | |
real(4), dimension(ntim,nlev) :: pot_k | |
real(4), dimension(ntim,nlev) :: tmp_k | |
real(4), dimension(ntim,nlev) :: press | |
real(4), dimension(ntim,nlev) :: qhum | |
real(4), dimension(ntim,nlev) :: hgt | |
real(4), dimension(ntim,nlev) :: qsat | |
real(4), dimension(ntim,nlev) :: logp | |
integer, dimension(ntim) :: iabove_pbl, ibelow_pbl | |
real(4), dimension(ntim) :: psfc | |
real(4), dimension(ntim) :: C_theta | |
real(4), dimension(ntim) :: delta_q | |
real(4), dimension(ntim) :: g_theta | |
real(4), dimension(ntim) :: pbl_theta | |
real(4), dimension(ntim) :: pbl_t | |
real(4), dimension(ntim) :: pbl_q | |
real(4), dimension(ntim) :: pbl_qs | |
real(4), dimension(ntim) :: pbl_p | |
real(4), dimension(ntim) :: pblh_diff | |
real(4), dimension(ntim) :: relh | |
real(4), dimension(ntim) :: c_1 | |
real(4), dimension(ntim) :: c_2 | |
real(4), dimension(ntim) :: pbl_h0 | |
real(4), dimension(ntim) :: pblh_mid | |
real(4), dimension(ntim) :: lhf0 | |
real(4), dimension(ntim) :: shf0 | |
real(4), dimension(ntim) :: rho | |
real(4), dimension(ntim) :: rho2m | |
real(4), dimension(ntim) :: q2m | |
real(4), dimension(ntim) :: t2m | |
real(4), dimension(ntim) :: bowen_s | |
real(4), dimension(ntim) :: cp_theta_final | |
real(4), dimension(ntim) :: cp_theta_initial | |
real(4), dimension(ntim) :: cp_theta | |
real(4), dimension(ntim) :: cp_deltaT | |
real(4), dimension(ntim) :: Lv_qhum_initial | |
real(4), dimension(ntim) :: Lv_qhum_final | |
real(4), dimension(ntim) :: Lv_qhum | |
real(4), dimension(ntim) :: Lv_q_0 | |
real(4), dimension(ntim) :: cp_T_0 | |
real(4), dimension(ntim) :: shf_ent | |
real(4), dimension(ntim,nlev) :: pbl_diff | |
real(4), dimension(ntim) :: p_up, t_up, q_up, s_up, h_up | |
real(4), dimension(ntim) :: p_lo, t_lo, q_lo, s_lo, h_lo | |
integer, dimension(ntim) :: num_above, num_below, i_below, i_above | |
character(len=24), parameter :: FMT1 = "(9(F12.4,2x))" | |
character(len=23), parameter :: FMT2 = "(4(I4,2x), 6(F12.4,2x))" | |
!----------------------------------------------------------------------------- | |
!-------------------------------------------- | |
!--- Initialization and preliminary calculations | |
!-------------------------------------------- | |
!-- | |
!-- initialize output arrays | |
!-- | |
ef = missing | |
ne = missing | |
pbl_growth = missing | |
pbl_heating = missing | |
dry_entrain = missing | |
dRH_estimate = missing | |
!----------------------------------------------------------------------------- | |
!-- Check input arrays to make sure all are NOT missing | |
!----------------------------------------------------------------------------- | |
if( all(tmp_in .eq.missing) .or. all(qhum_in.eq.missing) .or. & | |
all(press_in.eq.missing) .or. all(hgt_in .eq.missing) .or. & | |
all( pbl_h.eq.missing) .or. all( lhf.eq.missing) .or. & | |
all( shf.eq.missing) ) then | |
return | |
end if | |
!-- | |
!-- initialize working arrays | |
!-- | |
rho = missing | |
C_theta = missing | |
delta_q = missing | |
g_theta = missing | |
pbl_t = missing | |
pbl_q = missing | |
pbl_qs = missing | |
pbl_p = missing | |
pbl_theta = missing | |
pblh_2d = missing | |
relh = missing | |
c_1 = missing | |
c_2 = missing | |
psfc_2d = missing | |
psfc = missing | |
pot_k = missing | |
pbl_h0 = missing | |
pblh_mid = missing | |
pbl_diff = missing | |
pblh_diff = missing | |
shf0 = missing | |
lhf0 = missing | |
ibelow_pbl = -1 | |
iabove_pbl = -1 | |
bowen_s = missing | |
shf_ent = missing | |
rho2m = missing | |
q2m = missing | |
t2m = missing | |
Lv_qhum = missing | |
cp_theta = missing | |
cp_T_0 = missing | |
Lv_q_0 = missing | |
Lv_qhum_initial = missing | |
Lv_qhum_final = missing | |
cp_theta_initial = missing | |
cp_theta_final = missing | |
p_up = missing | |
t_up = missing | |
s_up = missing | |
q_up = missing | |
h_up = missing | |
p_lo = missing | |
t_lo = missing | |
s_lo = missing | |
q_lo = missing | |
h_lo = missing | |
pbl_p = missing | |
pbl_q = missing | |
pbl_qs = missing | |
pbl_t = missing | |
tmp_k = missing | |
press = missing | |
qhum = missing | |
hgt = missing | |
tmp_k = tmp_in | |
press = press_in | |
qhum = qhum_in | |
hgt = hgt_in | |
!------------------------------------------------------------------ | |
!-- -- | |
!-- Set surface pressure and remove strange zeros as a check -- | |
!-- -- | |
!------------------------------------------------------------------ | |
where( press.eq.0 ) press = missing | |
psfc = press(:,1) | |
t2m = tmp_k(:,1) | |
q2m = qhum (:,1) | |
!---------------------------------------------------------------------------------- | |
!-- Approximate air density (kg/m3) | |
!---------------------------------------------------------------------------------- | |
where( t2m.ne.missing .and. psfc.ne.missing .and. q2m.ne.missing ) | |
rho2m = psfc / (Rd * t2m * ((1. + (q2m/ep)) / (1. + q2m))) | |
endwhere | |
!------------------------------------------------------------------ | |
!-- -- | |
!-- Map to 2D and remove pressures greater than surface -- | |
!-- Useful for models on constant pressure fields but with a -- | |
!-- surface pressure output field -- | |
!-- -- | |
!------------------------------------------------------------------ | |
do zz=1,nlev | |
psfc_2d(:,zz) = psfc | |
pblh_2d(:,zz) = pbl_h | |
end do | |
where( press.gt.psfc_2d ) | |
tmp_k = missing | |
press = missing | |
hgt = missing | |
qhum = missing | |
endwhere | |
!----------------------------------------------------------------------------- | |
!-- Check input arrays to make sure all are NOT missing | |
!-- NEEDS to be done again just in case observational data are incorrect | |
!-- and there are pressure measurement errors (as can be seen in ARM BE) | |
!----------------------------------------------------------------------------- | |
if( all(tmp_k.eq.missing) .or. all(qhum.eq.missing) .or. & | |
all(press.eq.missing) .or. all( hgt.eq.missing) .or. & | |
all(pbl_h.eq.missing) .or. all( lhf.eq.missing) .or. & | |
all( shf.eq.missing) ) then | |
return | |
end if | |
!--------------------------------------------------------------- | |
!-- -- | |
!-- Calculate temperature, humidity, and pressure at the PBL -- | |
!-- -- | |
!--------------------------------------------------------------- | |
!-- Calculate log of pressure | |
where( press.ne.missing ) logp = log(press) | |
!-- Calucalte the saturation specific humidity (kg/kg) | |
where( press.ne.missing ) press = press/1e2 | |
where( tmp_k.ne.missing .and. press.ne.missing ) | |
qsat = by100*0.01 *(ep* (es0*exp((a*( tmp_k-t0))/( tmp_k-b))) ) / & | |
(press-onemep*(es0*exp((a*( tmp_k-t0))/( tmp_k-b)))) | |
qsat = qsat/(1.+qsat) | |
endwhere | |
where( press.ne.missing ) press = press*1e2 | |
!-- Height difference between boundary layer and height | |
where( pblh_2d.ne.missing .and. hgt.ne.missing ) pbl_diff = pblh_2d - hgt | |
!----- Find the point where the sign first turns negative from the ground up | |
!*** Lowest height above the PBL *** | |
num_above = 0 | |
num_above = count(pbl_diff.ne.missing .and. pbl_diff.le.0, DIM = 2) | |
i_above = minloc( hgt, DIM = 2, MASK = pbl_diff.ne.missing .and. pbl_diff.le.0 ) | |
!*** Highest height below the PBL *** | |
num_below = 0 | |
num_below = count(pbl_diff.ne.missing .and. pbl_diff.gt.0, DIM = 2) | |
i_below = maxloc( hgt, DIM = 2, MASK = pbl_diff.ne.missing .and. pbl_diff.gt.0 ) | |
!--- Get the upper and lower bounds for each variable to be calc'd at the BCL | |
do tt=1,ntim | |
if( i_above(tt).eq.0 .or. i_below(tt).eq.0 ) then | |
cycle | |
end if | |
p_up(tt) = logp (tt,i_above(tt)) | |
t_up(tt) = tmp_k (tt,i_above(tt)) | |
s_up(tt) = qsat (tt,i_above(tt)) | |
q_up(tt) = qhum (tt,i_above(tt)) | |
h_up(tt) = pbl_diff(tt,i_above(tt)) | |
p_lo(tt) = logp (tt,i_below(tt)) | |
t_lo(tt) = tmp_k (tt,i_below(tt)) | |
s_lo(tt) = qsat (tt,i_below(tt)) | |
q_lo(tt) = qhum (tt,i_below(tt)) | |
h_lo(tt) = pbl_diff(tt,i_below(tt)) | |
end do | |
!--- Calculate pressure, sp. humidity, sat. sp. humid, and temp at PBL | |
where( p_up .ne.missing .and. h_up .ne.missing ) pbl_p = exp( p_up - ((p_up-p_lo)/(h_up-h_lo))*h_up ) | |
where( q_up .ne.missing .and. h_up .ne.missing ) pbl_q = ( q_up - ((q_up-q_lo)/(h_up-h_lo))*h_up ) | |
where( s_up .ne.missing .and. h_up .ne.missing ) pbl_qs = ( s_up - ((s_up-s_lo)/(h_up-h_lo))*h_up ) | |
where( t_up .ne.missing .and. h_up .ne.missing ) pbl_t = ( t_up - ((t_up-t_lo)/(h_up-h_lo))*h_up ) | |
where( pbl_q.ne.missing .and. pbl_qs.ne.missing ) relh = (pbl_q/pbl_qs) | |
!-- | |
!-- Potential temperature for the profile and at the PBL [K] | |
!-- Reference pressure is at the surface and NOT 1000 hPa | |
!-- | |
where( tmp_k.ne.missing .and. press.ne.missing ) pot_k = tmp_k * ((psfc_2d/press))**(R_cp) | |
where( pbl_t.ne.missing .and. pbl_p.ne.missing ) pbl_theta = pbl_t * ((psfc /pbl_p))**(R_cp) | |
!------------------------------------------------------- | |
!-- -- | |
!-- BEGIN SECTION -- | |
!-- Estimate heat entrainment ratio for each timestep -- | |
!-- using the mixing diagram stepwise method -- | |
!-- calc'd using mixing_diagram.f90 reduce routine -- | |
!-- Based off of Santanello et al. 2009 -- | |
!-- -- | |
!------------------------------------------------------- | |
!******* SHIFT FLUXES to get C_theta using mixing space | |
pbl_h0(:ntim-1) = pbl_h(2:) | |
shf0 (:ntim-1) = shf (2:) | |
lhf0 (:ntim-1) = lhf (2:) | |
!---------------------------------------------------------------------------------- | |
!-- Calculate 2-m potential temperature * specific heat capacity (J/kg) | |
!---------------------------------------------------------------------------------- | |
! where( t2m.ne.missing .and. psfc.ne.missing ) cp_theta = cp * (t2m * ((p_ref/psfc))**(R_cp)) | |
where( t2m.ne.missing .and. psfc.ne.missing ) cp_theta = cp * t2m | |
!---------------------------------------------------------------------------------- | |
!-- Calculate 2-m specific humidity * latent heat of vaporization (J/kg) | |
!---------------------------------------------------------------------------------- | |
where( q2m.ne.missing ) Lv_qhum = Lv * q2m | |
!---------------------------------------------------------------------------------- | |
!-- Calculate surface bowen ratio (unitless) | |
!---------------------------------------------------------------------------------- | |
where( lhf0.ne.0 .and. shf0.ne.missing .and. lhf0.ne.missing ) bowen_s = shf0/lhf0 | |
!---------------------------------------------------------------------------------- | |
!-- Surface heat and moisture vector components (see Eq 1 in Santanello et al. 2009) | |
!---------------------------------------------------------------------------------- | |
where( shf0.ne.missing .and. rho2m.ne.missing .and. pbl_h0.ne.missing .and. rho2m*pbl_h0.ne.0 ) | |
cp_deltaT = (shf0*dt) / (rho2m*pbl_h0) | |
elsewhere | |
cp_deltaT = missing | |
endwhere | |
!---------------------------------------------------------------------------------- | |
!-- Define the start and end times of the increment for sensible and latent heat | |
!---------------------------------------------------------------------------------- | |
cp_theta_initial = cp_theta !*** start of time increment | |
cp_theta_final(:ntim-1) = cp_theta(2:) !*** end of time increment | |
Lv_qhum_initial = Lv_qhum !*** start of time increment | |
Lv_qhum_final (:ntim-1) = Lv_qhum (2:) !*** end of time increment | |
where( Lv_qhum_initial.ne.missing .and. cp_deltaT.ne.missing .and. bowen_s.ne.missing ) | |
Lv_q_0 = Lv_qhum_initial + (cp_deltaT/bowen_s) | |
end where | |
where( cp_theta_initial.ne.missing .and. cp_deltaT.ne.missing ) | |
cp_T_0 = cp_theta_initial + cp_deltaT | |
end where | |
!-------------------------------------------------- | |
! Calculate Entrainment Heat Flux in Wm-2 | |
! !!! THIS IS WITHOUT THE ADVECTION VECTOR !!! | |
! !!! Entrainment ratio could incorrectly !!! | |
! !!! estimated in windy conditions !!! | |
!-------------------------------------------------- | |
where( cp_theta_final.ne.missing .and. rho2m.ne.missing .and. pbl_h0.ne.missing .and. cp_T_0.ne.missing ) | |
shf_ent = (((cp * ((cp_theta_final/cp) - & | |
(cp_T_0 /cp)))) * (rho2m * pbl_h0))/(dt) | |
endwhere | |
where( shf_ent(:ntim-1).ne.missing .and. shf0(:ntim-1).ne.missing .and. shf0(:ntim-1).ne.0 ) | |
C_theta(2:) = shf_ent(:ntim-1)/shf0(:ntim-1) | |
endwhere | |
!------------------------------------------------------- | |
!-- -- | |
!-- END OF Entrainment SECTION -- | |
!-- used to calculate C_theta (entrainment ratio) -- | |
!-- -- | |
!------------------------------------------------------- | |
!------------------------------------------------------- | |
!-- | |
!-- Get Midpoint average in time | |
!-- | |
!------------------------------------------------------- | |
shf0 = missing | |
lhf0 = missing | |
where( pbl_t(2:).ne.missing .and. pbl_t(:ntim-1).ne.missing ) | |
pbl_t (2:) = 0.5 * (pbl_t (1:ntim-1) + pbl_t (2:)) | |
endwhere | |
where( pot_k(2:,:).ne.missing .and. pot_k(:ntim-1,:).ne.missing ) | |
pot_k (2:,:) = 0.5 * (pot_k (1:ntim-1,:) + pot_k (2:,:)) | |
endwhere | |
where( pblh_2d(2:,:).ne.missing .and. pblh_2d(:ntim-1,:).ne.missing ) | |
pblh_2d (2:,:) = 0.5 * (pblh_2d(1:ntim-1,:) + pblh_2d(2:,:)) | |
endwhere | |
where( hgt(2:,:).ne.missing .and. hgt(:ntim-1,:).ne.missing ) | |
hgt (2:,:) = 0.5 * (hgt (1:ntim-1,:) + hgt (2:,:)) | |
endwhere | |
where( qhum(2:,:).ne.missing .and. qhum(:ntim-1,:).ne.missing ) | |
qhum (2:,:) = 0.5 * (qhum (1:ntim-1,:) + qhum (2:,:)) | |
endwhere | |
where( pbl_h(2:).ne.missing .and. pbl_h(:ntim-1).ne.missing ) | |
pblh_mid (2:) = 0.5 * (pbl_h (1:ntim-1) + pbl_h (2:)) | |
endwhere | |
where( pbl_p(2:).ne.missing .and. pbl_p(:ntim-1).ne.missing ) | |
pbl_p (2:) = 0.5 * (pbl_p (1:ntim-1) + pbl_p (2:)) | |
endwhere | |
where( pbl_q(2:).ne.missing .and. pbl_q(:ntim-1).ne.missing ) | |
pbl_q (2:) = 0.5 * (pbl_q (1:ntim-1) + pbl_q (2:)) | |
endwhere | |
where( pbl_qs(2:).ne.missing .and. pbl_qs(:ntim-1).ne.missing ) | |
pbl_qs (2:) = 0.5 * (pbl_qs (1:ntim-1) + pbl_qs (2:)) | |
endwhere | |
where( pbl_theta(2:).ne.missing .and. pbl_theta(:ntim-1).ne.missing ) | |
pbl_theta(2:) = 0.5 * (pbl_theta(1:ntim-1) + pbl_theta(2:)) | |
endwhere | |
where( relh(2:).ne.missing .and. relh(:ntim-1).ne.missing ) | |
relh (2:) = 0.5 * (relh (1:ntim-1) + relh (2:)) | |
endwhere | |
where( shf(2:).ne.missing .and. shf(:ntim-1).ne.missing ) | |
shf0 (2:) = 0.5 * (shf (1:ntim-1) + shf (2:)) | |
endwhere | |
where( lhf(2:).ne.missing .and. lhf(:ntim-1).ne.missing ) | |
lhf0 (2:) = 0.5 * (lhf (1:ntim-1) + lhf (2:)) | |
endwhere | |
where( psfc(2:).ne.missing .and. psfc(:ntim-1).ne.missing ) | |
psfc (2:) = 0.5 * (psfc (1:ntim-1) + psfc (2:)) | |
endwhere | |
psfc (1) = missing | |
pbl_t (1) = missing | |
pbl_p (1) = missing | |
pbl_q (1) = missing | |
pbl_qs (1) = missing | |
pbl_theta(1) = missing | |
relh (1) = missing | |
shf0 (1) = missing | |
lhf0 (1) = missing | |
C_theta (1) = missing | |
pot_k (1,:) = missing | |
hgt (1,:) = missing | |
qhum (1,:) = missing | |
pblh_2d (1,:) = missing | |
!-- | |
!-- Approximate air density at the PBL (kg/m3) | |
!-- | |
where( pbl_t.ne.missing .and. pbl_p.ne.missing .and. pbl_q.ne.missing ) | |
rho = pbl_p / (Rd * pbl_t * ((1. + (pbl_q/ep)) / (1. + pbl_q))) | |
endwhere | |
!---------------------------------- | |
!-- -- | |
!-- Evaporative Fraction Section -- | |
!-- ef -- | |
!---------------------------------- | |
!-- | |
!-- Equation 2 in Ek and Holtslag 2004 | |
!-- | |
where( lhf0.ne.missing .and. shf0.ne.missing .and. lhf0+shf0.ne.0 ) ef = lhf0 / (shf0+lhf0) | |
!----------------------------- | |
!-- -- | |
!-- Non-Evaporative Section -- | |
!-- ne -- | |
!----------------------------- | |
!-- | |
!-- Calculate the C_1 and C_2 term from Equation A8 from Ek and Holtslag 2004 | |
!-- | |
where( pbl_qs.ne.missing .and. pbl_t.ne.missing .and. psfc.ne.missing .and. pbl_p.ne.missing ) | |
c_1 = (Lv/Rv) * (pbl_qs/(pbl_t**2)) * (pbl_p/psfc)**R_cp | |
endwhere | |
where( pbl_qs.ne.missing .and. pbl_t.ne.missing ) | |
c_2 = ((Lv/Rv * (pbl_qs/(pbl_t**2))) - (cp/Rd * pbl_qs/pbl_t)) * (grav/cp) | |
endwhere | |
!-- | |
!-- Calculate vertical gradient of potential temperature above PBL - g_theta [K] | |
!-- *** AND *** | |
!-- Calculate change in specific humidity across the PBL - delta_q [kg/kg] | |
!-- | |
iabove_pbl = minloc( hgt, DIM = 2, MASK = hgt.gt.pblh_2d .and. hgt.ne.missing ) | |
ibelow_pbl = maxloc( hgt, DIM = 2, MASK = hgt.lt.pblh_2d .and. hgt.ne.missing ) | |
do tt=1,ntim | |
if( iabove_pbl(tt).eq.0 .or. ibelow_pbl(tt).eq.0 ) then | |
cycle | |
end if | |
if( pot_k(tt,iabove_pbl(tt)).ne.missing .and. pbl_theta(tt).ne.missing ) then | |
g_theta(tt) = pot_k(tt,iabove_pbl(tt)) - pbl_theta(tt) | |
end if | |
if( qhum(tt,iabove_pbl(tt)).ne.missing .and. qhum(tt,ibelow_pbl(tt)).ne.missing ) then | |
delta_q(tt) = qhum(tt,iabove_pbl(tt)) - qhum(tt,ibelow_pbl(tt)) | |
end if | |
end do | |
!-- | |
!-- Equation 3 in Ek and Holtslag 2004 | |
!-- | |
!*** Dry air entrainment term | |
where( delta_q.ne.missing .and. pblh_mid.ne.missing .and. & | |
g_theta.ne.missing .and. pblh_mid*g_theta.ne.0 ) | |
dry_entrain = delta_q/(pblh_mid*g_theta) | |
endwhere | |
!*** PBL growth term | |
where( relh .ne.missing .and. c_2 .ne.missing .and. & | |
g_theta.ne.missing .and. g_theta.ne.0 ) | |
pbl_growth = relh * c_2 / g_theta | |
endwhere | |
!*** PBL heating term | |
where( relh .ne.missing .and. c_1 .ne.missing ) | |
pbl_heating = relh * c_1 | |
endwhere | |
!*** Non-evaporative term (sum of the above terms multiplied by an entrainment ratio) | |
where( C_theta .ne.missing .and. dry_entrain.ne.missing .and. & | |
pbl_growth.ne.missing .and. pbl_heating.ne.missing ) | |
ne = Lv_cp * (1. + C_theta) * ( dry_entrain + pbl_growth - pbl_heating ) | |
endwhere | |
!-- PBL heating contribution to Change in RH (unitless) | |
where( C_theta.ne.missing .and. pbl_heating.ne.missing ) | |
pbl_heating = Lv_cp * (1. + C_theta) * ( -1. * relh * c_1 ) | |
endwhere | |
!-- PBL growth contribution to Change in RH (unitless) | |
where( C_theta.ne.missing .and. pbl_growth.ne.missing ) | |
pbl_growth = Lv_cp * (1. + C_theta) * ( relh * c_2 / g_theta ) | |
endwhere | |
!-- Dry air entrainment contribution to Change in RH (unitless) | |
where( C_theta.ne.missing .and. dry_entrain.ne.missing ) | |
dry_entrain = Lv_cp * (1. + C_theta) * ( delta_q/(pblh_mid*g_theta) ) | |
endwhere | |
!*** Estimate Relative Humidity Change (%/hr) | |
where( ef .ne.missing .and. ne .ne.missing .and. pblh_mid.ne.missing .and. & | |
rho.ne.missing .and. lhf0.ne.missing .and. pbl_qs .ne.missing ) | |
dRH_estimate = ((shf0+lhf0) / (rho*Lv*pblh_mid*pbl_qs)) * (ef + ne*(1.-ef)) * 3600. * 1e2 | |
endwhere | |
return | |
end subroutine rh_tend_calc | |
end module RH_Tend_Mod |