Permalink
Cannot retrieve contributors at this time
| !--------------------------------------------------------------------------------- | |
| ! Purpose: | |
| ! | |
| ! !DESCRIPTION: | |
| ! This subroutine calculates the full suite of mixing diagram variables when | |
| ! given a time series of of surface fluxes, surface 2m state variables, and | |
| ! boundary layer height. Mixing diagram variables returned are surface bowen | |
| ! ratio, entrainment bowen ratio, advection ratios, and the various latent and | |
| ! sensible heat fluxes associated with those ratios. The utility is to characterize | |
| ! the coupling between surface fluxes and top of boundary layer fluxes in tandem | |
| ! with knowledge regarding soil moisture state. More details regarding motivation | |
| ! can be found in the references below. | |
| ! | |
| ! References: Santanello et al. 2009, A Modeling and Observational Framework | |
| ! for Diagnosing Local Land-Atmosphere Coupling on Diurnal Time Scales | |
| ! | |
| ! Santanello et al. 2011, Diagnosing the Sensitivity of Local | |
| ! Land-Atmosphere Coupling via the Soil Moisture-Boundary Layer Interaction | |
| ! | |
| ! ** Comprehensive Evaluation ** | |
| ! Santanello et al. 2013, Diagnosing the Nature of L-A Coupling: | |
| ! A Case Study of Dry/Wet Extremes in the U.S. Southern Great Plains | |
| ! | |
| ! Author and Revision History: | |
| ! Original Author of NCL scripts -- Jatin Kala on Nov 2013 | |
| ! Converted to F90 module -- A.B. Tawfik on Apr 2015 | |
| ! | |
| !--------------------------------------------------------------------------------- | |
| module Mixing_Diag_Mod | |
| ! | |
| ! subroutine name | |
| ! | |
| public mixing_diag | |
| !--------------------------------------------------------------------------------- | |
| contains | |
| !--------------------------------------------------------------------------------- | |
| !--------------------------------------------------------------------------------- | |
| ! | |
| ! subroutines: calculates mixing diagram variables using the INCREMENTAL more precise approach | |
| ! Assumes left most dimension is time | |
| ! Output can be dimensioned: | |
| ! (hours, spatial dimension like lat/lon) or (days, spatial dimension like lat/lon) | |
| ! This depends on the "average_daily" control switch below. By default | |
| ! "average_daily = .true." which calcualte average flux quantities for each day | |
| !--------------------------------------------------------------------------------- | |
| subroutine mixing_diag ( dim2 , ntim , steps_per_day , & | |
| t2m , psfc , q2m , pbl_h , shf , lhf , dt , & | |
| shf_ent , lhf_ent , shf_sfc, lhf_sfc, shf_tot, lhf_tot, evapf , & | |
| lcl_deficit, missing ) | |
| implicit none | |
| ! | |
| ! Input/Output Variables | |
| ! | |
| integer, intent(in ) :: dim2 ! *** missing value - useful for obs | |
| integer, intent(in ) :: ntim ! *** total number of time slices | |
| integer, intent(in ) :: steps_per_day ! *** number of time steps per day | |
| real(4), intent(in ) :: dt ! *** time increment of the hours dimension [seconds] | |
| real(4), intent(in ) :: missing ! *** missing value - useful for obs | |
| real(4), intent(in ), dimension(ntim,dim2) :: t2m, q2m, psfc ! *** 2m quantities - (days,hours) [K], [kg/kg], [Pa] | |
| real(4), intent(in ), dimension(ntim,dim2) :: pbl_h ! *** boundary layer height - (days,hours) [m] | |
| real(4), intent(in ), dimension(ntim,dim2) :: shf, lhf ! *** surface fluxes- dimensioned (days,hours) [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: shf_ent ! *** entrainment flux of sensible heat [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: lhf_ent ! *** entrainment flux of latent heat [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: shf_sfc ! *** surface flux of sensible heat [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: lhf_sfc ! *** surface flux of latent heat [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: shf_tot ! *** Total flux of sensible heat [W/m2] | |
| real(4), intent(out ), dimension(ntim,dim2) :: lhf_tot ! *** Total flux of latent heat [W/m2] | |
| real(4), intent(out ), dimension(ntim/steps_per_day,dim2), optional :: evapf ! *** daily evaporative fraction [unitless] | |
| real(4), intent(out ), dimension(ntim,dim2) , optional :: lcl_deficit ! *** lifted condensation level deficit (lcl - pbl) [m] | |
| ! | |
| ! Local variables | |
| ! | |
| real(4), parameter :: p_ref=1e5 , Lv=2.5e6, cp=1005.7 | |
| real(4), parameter :: grav = 9.81, Rd=287.04, ep = 0.622, R_cp=Rd/cp | |
| integer :: nday | |
| real(4), dimension(ntim,dim2) :: rho | |
| real(4), dimension(ntim,dim2) :: bowen_s | |
| real(4), dimension(ntim,dim2) :: cp_theta_final | |
| real(4), dimension(ntim,dim2) :: cp_theta_initial | |
| real(4), dimension(ntim,dim2) :: cp_theta | |
| real(4), dimension(ntim,dim2) :: cp_deltaT | |
| real(4), dimension(ntim,dim2) :: Lv_qhum_initial | |
| real(4), dimension(ntim,dim2) :: Lv_qhum_final | |
| real(4), dimension(ntim,dim2) :: Lv_qhum | |
| real(4), dimension(ntim,dim2) :: Lv_q_0 | |
| real(4), dimension(ntim,dim2) :: cp_T_0 | |
| real(4), dimension(ntim,dim2) :: lhf0 | |
| real(4), dimension(ntim,dim2) :: shf0 | |
| real(4), dimension(ntim,dim2) :: lhfi0 | |
| real(4), dimension(ntim,dim2) :: shfi0 | |
| real(4), dimension(ntim,dim2) :: lhfs0 | |
| real(4), dimension(ntim,dim2) :: shfs0 | |
| real(4), dimension(ntim,dim2) :: theta | |
| real(4), dimension(ntim,dim2) :: tsat | |
| real(4), dimension(ntim,dim2) :: plcl | |
| real(4), dimension(ntim,dim2) :: hlcl | |
| real(4), dimension(ntim,dim2) :: tvirt | |
| real(4), dimension(ntim/steps_per_day ,dim2) :: shf_sum | |
| real(4), dimension(ntim/steps_per_day ,dim2) :: lhf_sum | |
| real(4), dimension(ntim/steps_per_day,steps_per_day,dim2) :: shf_day | |
| real(4), dimension(ntim/steps_per_day,steps_per_day,dim2) :: lhf_day | |
| !----------------------------------------------------------------------------- | |
| !-------------------------------------------- | |
| !--- Initialization and preliminary calculations | |
| !-------------------------------------------- | |
| !-------------------------------- | |
| !-- initialize output arrays | |
| !-------------------------------- | |
| shf_ent = missing | |
| lhf_ent = missing | |
| shf_sfc = missing | |
| lhf_sfc = missing | |
| shf_tot = missing | |
| lhf_tot = missing | |
| if( present(evapf ) ) evapf = missing | |
| if( present(lcl_deficit) ) lcl_deficit = missing | |
| !-------------------------------- | |
| !-- initialize working arrays | |
| !-------------------------------- | |
| nday = ntim/steps_per_day | |
| bowen_s = missing | |
| rho = missing | |
| Lv_qhum = missing | |
| cp_theta = missing | |
| shf0 = missing | |
| lhf0 = missing | |
| shfi0 = missing | |
| lhfi0 = missing | |
| shfs0 = missing | |
| lhfs0 = 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 | |
| !----------------------------------------------------------------------------------- | |
| !-- Approximate air density (kg/m3) | |
| !----------------------------------------------------------------------------------- | |
| where( t2m.ne.missing .and. psfc.ne.missing .and. q2m.ne.missing ) | |
| rho = psfc / (Rd * t2m * ((1. + (q2m/ep)) / (1. + q2m))) | |
| endwhere | |
| !----------------------------------------------------------------------------------- | |
| !-- 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( lhf.ne.0 .and. shf.ne.missing .and. lhf.ne.missing ) bowen_s = shf/lhf | |
| !-------------------------------------------- | |
| !--- Proceed to calculating output variables | |
| !-------------------------------------------- | |
| !----------------------------------------------------------------------------------- | |
| !-- Surface heat and moisture vector components (see Eq 1 in Santanello et al. 2009) | |
| !----------------------------------------------------------------------------------- | |
| where( shf.ne.missing .and. rho.ne.missing .and. pbl_h.ne.missing .and. rho*pbl_h.ne.0 ) | |
| cp_deltaT = (shf*dt) / (rho*pbl_h) | |
| elsewhere | |
| cp_deltaT = missing | |
| endwhere | |
| !----------------------------------------------------------------------------------- | |
| !-- Define the start and end times of the increment for sensible and latent heat | |
| !----------------------------------------------------------------------------------- | |
| cp_theta_initial(2:,:) = cp_theta(:ntim-1,:) !*** start of time increment | |
| cp_theta_final = cp_theta !*** end of time increment | |
| Lv_qhum_initial (2:,:) = Lv_qhum (:ntim-1,:) !*** start of time increment | |
| Lv_qhum_final = Lv_qhum !*** 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 | |
| !-------------------------------------------------- | |
| ! output arrays | |
| !-------------------------------------------------- | |
| !********************************************************************************* | |
| !****** | |
| !****** --- STEPWISE --- | |
| !****** Hourly mixing diagram variables (based on dt, so not exactly hourly) | |
| !****** | |
| !********************************************************************************* | |
| !-------------------------------------------------- | |
| ! Calculate Heat budget in Wm-2 | |
| !-------------------------------------------------- | |
| where( cp_theta_final.ne.missing .and. rho.ne.missing .and. pbl_h.ne.missing .and. cp_T_0.ne.missing ) | |
| shf0 = (((cp * ((cp_theta_final/cp) - & | |
| (cp_theta_initial/cp)))) * (rho * pbl_h))/(dt) | |
| shfi0 = (((cp * ((cp_theta_final/cp) - & | |
| (cp_T_0 /cp)))) * (rho * pbl_h))/(dt) | |
| endwhere | |
| !-------------------------------------------------- | |
| !**** Total sensible heat Wm-2 | |
| !-------------------------------------------------- | |
| shf_tot = shf0 | |
| !-------------------------------------------------- | |
| !**** Entrainment sensible heat Wm-2 | |
| !-------------------------------------------------- | |
| shf_ent = shfi0 | |
| !-------------------------------------------------- | |
| !**** Surface sensible heat Wm-2 | |
| !-------------------------------------------------- | |
| where( cp_theta_initial.ne.missing .and. rho.ne.missing .and. pbl_h.ne.missing .and. cp_T_0.ne.missing ) | |
| shfs0 = (((cp * ((cp_T_0 /cp) - & | |
| (cp_theta_initial/cp)))) * (rho * pbl_h))/(dt) | |
| endwhere | |
| shf_sfc = shfs0 | |
| !-------------------------------------------------- | |
| !Calculate Moisture Budget in Wm-2 | |
| !-------------------------------------------------- | |
| where( Lv_qhum_final.ne.missing .and. rho.ne.missing .and. pbl_h.ne.missing .and. Lv_q_0.ne.missing ) | |
| lhf0 = (((Lv * ((Lv_qhum_final/Lv) - & | |
| (Lv_qhum_initial/Lv)))) * (rho * pbl_h))/(dt) | |
| lhfi0 = (((Lv * ((Lv_qhum_final/Lv) - & | |
| (Lv_q_0 /Lv)))) * (rho * pbl_h))/(dt) | |
| endwhere | |
| !-------------------------------------------------- | |
| !**** Total latent heat Wm-2 | |
| !-------------------------------------------------- | |
| lhf_tot = lhf0 | |
| !-------------------------------------------------- | |
| !**** Entrainment latent heat Wm-2 | |
| !-------------------------------------------------- | |
| lhf_ent = lhfi0 | |
| !-------------------------------------------------- | |
| !**** Surface latent heat Wm-2 | |
| !-------------------------------------------------- | |
| where( Lv_qhum_initial.ne.missing .and. rho.ne.missing .and. pbl_h.ne.missing .and. Lv_q_0.ne.missing ) | |
| lhfs0 = (((Lv * ((Lv_q_0 /Lv) - & | |
| (Lv_qhum_initial/Lv)))) * (rho * pbl_h))/(dt) | |
| endwhere | |
| lhf_sfc = lhfs0 | |
| !----------------------------------------------------------------------------------- | |
| !-- Calculate daily surface evaporative fraction (unitless) | |
| !-- Evap Fraction is calculated by summing the LH and SH fluxes throughout the | |
| !-- day and then calculate a divide the cumulative LH daily flux by the sum of | |
| !-- sensible and latent heat flux sums | |
| !----------------------------------------------------------------------------------- | |
| if( present(evapf) ) then | |
| shf_day = missing | |
| lhf_day = missing | |
| shf_sum = missing | |
| lhf_sum = missing | |
| shf_day = reshape( shf, (/nday,steps_per_day,dim2/) ) | |
| lhf_day = reshape( lhf, (/nday,steps_per_day,dim2/) ) | |
| shf_sum = sum(shf_day, DIM = 2, MASK = shf_day.ne.missing .and. lhf_day.ne.missing ) | |
| lhf_sum = sum(lhf_day, DIM = 2, MASK = shf_day.ne.missing .and. lhf_day.ne.missing ) | |
| where( lhf_sum+shf_sum.ne.0 .and. shf_sum.ne.missing .and. lhf_sum.ne.missing ) | |
| evapf = lhf_sum/(shf_sum+lhf_sum) | |
| endwhere | |
| end if | |
| !----------------------------------------------------------------------------------- | |
| !-- Calculate LCL Deficit (meters) | |
| !-- The LCL deficit is defined as the difference between the lifted condensation level | |
| !-- and the boundary layer height. When the LCL deficit in negative then a necessary but | |
| !-- criterion for convective initiation is met. | |
| !-- LCL is calculated using the Bolton 1980 empirical relationships | |
| !-- David Bolton, 1980: The Computation of Equivalent Potential Temperature. | |
| !-- Mon. Wea. Rev., 108, 1046–1053. | |
| !-- To convert from pressure of LCL to height use the hypsometric equation | |
| !-- Note one assumption made here that is consistent with the mixing diagram assumption | |
| !-- is that 2m temperature (t2m) is representative of the mean boundary layer temperature | |
| !----------------------------------------------------------------------------------- | |
| if( present(lcl_deficit) ) then | |
| theta = missing | |
| tsat = missing | |
| plcl = missing | |
| hlcl = missing | |
| tvirt = missing | |
| where( t2m .ne.missing .and. psfc.ne.missing ) theta = t2m * (1e5/psfc)**R_cp | |
| where( theta.ne.missing .and. q2m .ne.missing ) | |
| tsat = 55. + (2840./ (3.5*log(theta) - log(1e6*q2m/(622.+(1e3*q2m))) - 4.805)) | |
| endwhere | |
| where( theta.ne.missing .and. tsat.ne.missing ) plcl = 1e3 * (tsat/theta) ** 3.4965 | |
| where( t2m .ne.missing .and. q2m .ne.missing ) tvirt = t2m * (1. + (0.61*q2m)) | |
| where( tvirt.ne.missing .and. plcl.ne.missing .and. psfc.ne.missing ) | |
| hlcl = (Rd*tvirt) / (grav) * log((psfc/1e2)/plcl) | |
| endwhere | |
| where( hlcl.ne.missing .and. pbl_h.ne.missing ) lcl_deficit = hlcl - pbl_h | |
| end if | |
| return | |
| end subroutine mixing_diag | |
| end module Mixing_Diag_Mod |