isba_fluxes_meb.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     ##########################################################################
      SUBROUTINE isba_fluxes_meb(                                                             &
           prhoa,                                                                             &
           psigma_f,psigma_fn,                                                                &
           pemis_n,                                                                           &
           prnet_v,prnet_g,prnet_n,                                                           &
           pswnet_v,pswnet_g,pswnet_n,                                                        &
           plwnet_v,plwnet_g,plwnet_n,                                                        &
           plwnet_v_dtv,plwnet_v_dtg,plwnet_v_dtn,                                            &
           plwnet_g_dtv,plwnet_g_dtg,plwnet_g_dtn,                                            &
           plwnet_n_dtv,plwnet_n_dtg,plwnet_n_dtn,                                            &
           pthrma_ta,pthrmb_ta,pthrma_tc,pthrmb_tc,                                           &
           pthrma_tg,pthrmb_tg,pthrma_tv,pthrmb_tv,pthrma_tn,pthrmb_tn,                       &
           pqsat_g,pqsat_v,pqsati_n,                                                          &
           pff,ppsn,ppsna,ppsncv,pfrozen1,pffrozen,                                           &
           pleg_delta,plegi_delta,phug,phugi,phvg,phvn,                                       &
           pflxc_c_a,pflxc_g_c,pflxc_vg_c,pflxc_vn_c,pflxc_n_c,pflxc_n_a,                     &
           pflxc_mom,pflxc_v_c,phvgs,phvns,                                                   &
           ptg,ptv,ptn,                                                                       &
           pdqsat_g,pdqsat_v,pdqsati_n,                                                       & 
           ptc,pqc,pta_ic,pqa_ic,                                                             &
           pdelta_v,                                                                          &
           pdeltat_g,pdeltat_v,pdeltat_n,                                                     &
           psw_up,psw_rad,plw_rad,                                                            &
           prnet,plw_up,                                                                      &
           ph_c_a,ph_v_c,ph_g_c,ph_n_c,ph_n_a,ph_n,ph,                                        &
           ple_c_a,ple_v_c,ple_g_c,ple_n_c,                                                   &
           pevap_c_a,plev_v_c,pevap_g_c,pevap_n_c,pevap_n_a,                                  &
           pevap,psubl,pletr_v_c,pler_v_c,pleg,plegi,                                         &
           ple_flood,plei_flood,ples,plel,                                                    &
           pevapn,ples_v_c,pletr,pler,plev,ple,plei,pts_rad,pemis,plstt                       )
!     ##########################################################################
!
!!****  *ISBA_FLXUES_MEB*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates the implicit fluxes for implicit or explicit atmospheric
!     coupling and fluxes needed by hydrology, soil and snow routines.
!     finally, compute soil phase changes.
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    Noilhan and Planton (1989)
!!    Belair (1995)
!!    * to be done * (2011)
!!      
!!    AUTHOR
!!    ------
!!
!!      A. Boone           * Meteo-France *
!!      P. Samuelsson      * SMHI *
!!      S. Gollvik         * SMHI * 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    22/01/11 
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_par,       ONLY : xemissoil, xemisveg
USE modd_csts,           ONLY : xlvtt, xlstt, xstefan
!
USE modi_isba_emis_meb
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:),   INTENT(IN)   :: prhoa
!                                     PRHOA = reference level air density (kg m-3)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pswnet_v, pswnet_g, pswnet_n
!                                     PSWNET_G = Understory-ground net SW radiation explicit term (W m-2)
!                                     PSWNET_V = Vegetation canopy net SW radiation explicit term (W m-2)
!                                     PSWNET_N = Ground-based snow net SW radiation explicit term (W m-2)
!
REAL, DIMENSION(:),   INTENT(IN)   :: psigma_f, psigma_fn, pemis_n
!
REAL, DIMENSION(:),   INTENT(IN)   :: plwnet_v_dtv, plwnet_v_dtg, plwnet_v_dtn
!                                     PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN = Vegetation canopy net LW radiation 
!                                     derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: plwnet_g_dtv, plwnet_g_dtg, plwnet_g_dtn
!                                     PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN = Understory-ground net LW radiation 
!                                          derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: plwnet_n_dtv, plwnet_n_dtg, plwnet_n_dtn
!                                     PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN = Ground-based snow net LW radiation 
!                                          derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pthrma_ta, pthrmb_ta, pthrma_tc, pthrmb_tc,                     &
                                      pthrma_tg, pthrmb_tg, pthrma_tv, pthrmb_tv, pthrma_tn, pthrmb_tn
!                                     PTHRMA_TA                                                    (J kg-1 K-1)
!                                     PTHRMB_TA = linear transform coefficinets for atmospheric
!                                                 thermal variable for lowest atmospheric level.   (J kg-1)
!                                                 Transform T to dry static energy or enthalpy.
!                                     PTHRMA_TC                                                    (J kg-1 K-1)
!                                     PTHRMB_TC = linear transform coefficinets for atmospheric
!                                                 thermal variable for canopy air                  (J kg-1)
!                                                 Transform T to dry static energy or enthalpy.
!                                     PTHRMA_TG,V,N                                                (J kg-1 K-1)
!                                     PTHRMB_TG,V,N = linear transform coefficinets for atmospheric
!                                                 thermal variable for surfaces (G, V, and N)      (J kg-1)
!                                                 Transform T to dry static energy or enthalpy.
!
REAL, DIMENSION(:),   INTENT(IN)   :: pqsat_g, pqsat_v, pqsati_n
!                                     PQSAT_G  = saturation specific humidity for understory surface    (kg kg-1)
!                                     PQSAT_V  = saturation specific humidity for the vegetation canopy (kg kg-1)
!                                     PQSATI_N = saturation specific humidity over ice for the snowpack (kg kg-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pff, ppsn, ppsna, ppsncv, pfrozen1, pffrozen, plstt
!                                     PFF      = total flooded fraction                                        (-) 
!                                     PPSN     = fraction of snow on ground and understory vegetation          (-)
!                                     PPSNA    = fraction of vegetation canopy buried by ground-based snowpack (-)
!                                     PPSNCV   = fraction of vegetation canopy covered by intercepted snow     (-)
!                                     PFROZEN1 = frozen fraction of surface ground layer                       (-)
!                                     PFFROZEN = frozen fraction of flooded zone                               (-)
!                                     PLSTT    = effecitve latent heat of sublimation                       (J/kg)
!
!
REAL, DIMENSION(:),   INTENT(IN)   :: pleg_delta, plegi_delta, phugi, phug, phvg, phvn
!                                     PHUG = relative humidity of the soil                                     (-)                         
!                                     PHVG = Halstead coefficient of non-buried (snow) canopy vegetation       (-)                         
!                                     PHVN = Halstead coefficient of paritally-buried (snow) canopy vegetation (-)                         
!
REAL, DIMENSION(:),   INTENT(IN)   :: pflxc_c_a, pflxc_g_c, pflxc_vg_c, pflxc_vn_c, pflxc_n_c, pflxc_n_a,   &
                                      pflxc_v_c, pflxc_mom
!                                     PFLXC_C_A  = Flux form heat transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
!                                     PFLXC_G_C  = As above, but for : ground-understory to canopy air           (kg m-2 s-1)
!                                     PFLXC_VG_C = As above, but for : non-snow buried canopy to canopy air      (kg m-2 s-1)
!                                     PFLXC_VN_C = As above, but for : partially snow-buried canopy air to canopy 
!                                                  air                                                           (kg m-2 s-1)
!                                     PFLXC_V_C  = As above, but for : bulk vegetation canopy to canopy air      (kg m-2 s-1)
!                                     PFLXC_N_C  = As above, but for : ground-based snow to atmosphere           (kg m-2 s-1)
!                                     PFLXC_N_A  = As above, but for : ground-based snow to canopy air           (kg m-2 s-1)
!                                     PFLXC_MOM  = flux form drag transfer coefficient: canopy air to atmosphere (kg m-2 s-1)
!
REAL, DIMENSION(:,:), INTENT(IN)   :: ptn
!                                     PTN    = Ground-based snow temperature profile (K)
!
REAL, DIMENSION(:),   INTENT(IN)   :: ptv
!                                     PTV    = Vegetation canopy temperature (K)
!
REAL, DIMENSION(:,:), INTENT(IN)   :: ptg
!                                     PTG    = Soil temperature profile (K)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pdqsat_g, pdqsat_v, pdqsati_n
!                                     PQSAT_G  = saturation specific humidity derivative for understory 
!                                                surface               (kg kg-1 K-1)
!                                     PQSAT_V  = saturation specific humidity derivative for the vegetation 
!                                                canopy                (kg kg-1 K-1)
!                                     PQSATI_N = saturation specific humidity derivative over ice for the 
!                                                ground-based snowpack (kg kg-1 K-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: phvgs, phvns
!                                     PHVGS     = Dimensionless pseudo humidity factor for computing vapor
!                                                 fluxes from the non-buried part of the canopy to the canopy air    (-)
!                                     PHVNS     = Dimensionless pseudo humidity factor for computing vapor
!                                                 fluxes from the partly-buried part of the canopy to the canopy air (-)
!
REAL, DIMENSION(:),   INTENT(IN)   :: ptc, pqc, pta_ic, pqa_ic
!                                     PTC       = Canopy air space temperature       (K)
!                                     PQC       = Canopy air space specific humidity (kg kg-1)
!                                     PTA_IC    = Near-ground air temperature        (K)
!                                     PQA_IC    = Near-ground air specific humidity  (kg kg-1)
!
REAL, DIMENSION(:),   INTENT(IN)   :: psw_up, psw_rad, plw_rad
!                                     PSW_UP  = total upwelling shortwave radiation from the surface at the atmosphere (W m-2)
!                                     PSW_RAD = downwelling shortwave radiation from the atmosphere above the canopy  (W m-2)
!                                     PLW_RAD = downwelling longwave radiation from the atmosphere above the canopy  (W m-2)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pdelta_v
!                                     PDELTA_V = Explicit canopy interception fraction                 (-)
!
REAL, DIMENSION(:),   INTENT(IN)   :: pdeltat_v, pdeltat_n, pdeltat_g
!                                     PDELTAT_V = Time change in vegetation canopy temperature (K)
!                                     PDELTAT_N = Time change in snowpack surface temperature  (K)
!                                     PDELTAT_G = Time change in soil surface temperature      (K)
!
REAL, DIMENSION(:),   INTENT(INOUT):: plwnet_v, plwnet_g, plwnet_n
!                                     PLWNET_G = Understory-ground net LW radiation implicit term output (W m-2)
!                                     PLWNET_V = Vegetation canopy net LW radiation implicit term output (W m-2)
!                                     PLWNET_N = Ground-based snow net LW radiation implicit term output (W m-2)
!
REAL, DIMENSION(:),   INTENT(OUT)  :: prnet_v, prnet_g, prnet_n
!                                     PRNET_G = Understory-ground net radiation (W m-2)
!                                     PRNET_V = Vegetation canopy net radiation (W m-2)
!                                     PRNET_N = Ground-based snow net radiation (W m-2)
!
REAL, DIMENSION(:),   INTENT(OUT)  :: prnet, plw_up  
!                                     PRNET   = total net radiation of snow, understory and canopy (W m-2)
!                                     PLW_UP  = total net longwave upwelling radiation to the atmosphere  (W m-2)
!
REAL, DIMENSION(:),   INTENT(OUT)  :: ph_c_a, ph_v_c, ph_g_c, ph_n_c, ph_n, ph, ph_n_a
!                                     PH_C_A  = Sensible heat flux: canopy air space to overlying atmosphere (W m-2)
!                                     PH_V_C  = Sensible heat flux: vegetation canopy to canopy air space  (W m-2)
!                                     PH_G_C  = Sensible heat flux: understory (soil & vegetation) to canopy air space  (W m-2)
!                                     PH_N_C  = Sensible heat flux: ground based snowpack to canopy air space  (W m-2)
!                                     PH_N    = Sensible heat flux: ground based snowpack to both canopy air space and overlying atmosphere (W m-2)
!                                     PH      = Sensible heat flux: total net sensible heat flux from surface to atmosphere (W m-2)
!                                     PH_N_A  = Sensible heat flux: ground based snowpack to overlying atmosphere (W m-2)
!
REAL, DIMENSION(:),   INTENT(OUT)  ::  ple_c_a, ple_v_c, ple_g_c, ple_n_c
!                                     PLE_C_A = Latent heat flux: canopy air space to overlying atmosphere (W m-2)
!                                     PLE_V_C = Latent heat flux: vegetation canopy to canopy air space  (W m-2)
!                                     PLE_G_C = Latent heat flux: understory (soil & vegetation) to canopy air space  (W m-2)
!                                     PLE_N_C = Latent heat flux: ground based snowpack to canopy air space  (W m-2)
!
REAL, DIMENSION(:),   INTENT(OUT)  :: pevap_c_a, plev_v_c, pevap_g_c, pevap_n_c, pevap_n_a,            &  
                                      pevap, psubl, pevapn
!                                     PEVAP_C_A = Water flux: canopy air space to overlying atmosphere (kg m-2 s-1)
!                                     PLEV_V_C  = Water flux: vegetation canopy to canopy air space (kg m-2 s-1)
!                                     PEVAP_G_C = Water flux: understory (soil & vegetation) to canopy air space (kg m-2 s-1)
!                                     PEVAP_N_C = Water flux: ground based snowpack to canopy air space (kg m-2 s-1)
!                                     PEVAP_N_A = Water flux: ground based snowpack to overlying atmosphere (kg m-2 s-1)
!                                     PEVAP     = Water flux: total net water flux from surface to atmosphere  (kg m-2 s-1)
!                                     PSUBL     = Water flux: total sublimation flux (kg/m2/s)
!                                     PEVAPN    = Water flux: ground based snowpack to both canopy air space and overlying atmosphere (kg m-2 s-1)
!
REAL, DIMENSION(:),   INTENT(OUT)  :: pletr_v_c, pler_v_c, pleg, plegi, ple_flood,        &
                                      plei_flood, ples, plel, ples_v_c, pletr, plev, ple, plei, pler
!                                     PLETR_V_C   = Latent heat flux: transpiration from the canopy (overstory) vegetation to canopy air (W m-2)
!                                     PLER_V_C    = Latent heat flux: evaporation of intercepted water from the canopy (overstory) vegetation to canopy air (W m-2)
!                                     PLES_V_C    = Latent heat flux: sublimation of canopy intercepted snowpack to canopy air (W m-2)
!                                     PLEG        = Latent heat flux: baresoil evaporation (W m-2)
!                                     PLEGI       = Latent heat flux: baresoil sublimation (W m-2)
!                                     PLE_FLOOD   = Latent heat flux: evaporation from flooded areas (W m-2)
!                                     PLEI_FLOOD  = Latent heat flux: sublimation from ice-covered flooded areas (W m-2)
!                                     PLEL        = Latent heat flux: net evaporation from ground-based snowpack to canopy air and overlying atmosphere (W m-2)
!                                     PLES        = Latent heat flux: net sublimation from ground-based snowpack to canopy air and overlying atmosphere (W m-2)
!                                     PLETR       = Latent heat flux: net transpiration from understory and overstory (canopy) (W m-2)
!                                     PLEV        = Latent heat flux: net evapotranspiration from understory and canopy vegetation (W m-2)
!                                     PLE         = Latent heat flux: net evapotranspiration (W m-2)
!                                     PLEI        = Latent heat flux: net sublimation (W m-2)
!                                     PLER        = Latent heat flux: net evaporation from intercepted water from understory and canopy vegetation (W m-2) 
!
REAL, DIMENSION(:),   INTENT(OUT)  :: pts_rad, pemis
!                                     PTS_RAD     = Net surface radiative temperature: computed using aggregated effective sfc emissivity 
!                                                   backed out from LWup: this is done to ensure cosistency between LWup, Ts_rad and effective sfc Emis (K) 
!                                     PEMIS       = effective (aggregated) net surface emissivity (-)
!
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(SIZE(PTV))         :: zfff, zwork
!                                     ZFFF  = working variables to help distinguish between soil and snow hydrolology and intercepted water reservoirs (-)
!                                     ZWORK = working array
!
REAL, DIMENSION(SIZE(PTV))         :: zsair, zsairc
!                                     ZSAIR   = atmospheric value of the therodynamic variable
!                                     ZSAIRC  = canopy air value of the therodynamic variable
!
REAL, DIMENSION(SIZE(PTV))         :: zevap_v_c
!                                     ZEVAP_V_C = Water flux: Evapotranspiration vapor flux from the vegetation canopy (kg m-2 s-1)
!
REAL, DIMENSION(SIZE(PTV))         :: zqsatn_v, zqsatin_n, zqsatn_g
!                                     ZQSATN_V  = saturation specific humidity (over water) for the vegetation canopy (kg kg-1)
!                                     ZQSATIN_N = saturation specific humidity (over ice) for the snow (kg kg-1)
!                                                 NOTE that liquid water can only exist when the snowpack T=XTT in the model, 
!                                                 and at the freezing point, the value is the same over ice and water, therefore
!                                                 over snow, we do not need to explicitly consider a "ZQSATN_N"
!                                     ZQSATN_G  = saturation specific humidity (over water) for the understory (kg kg-1)
!                
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!*       0.     Initialization:
!               ---------------
!
IF (lhook) CALL dr_hook('ISBA_FLUXES_MEB',0,zhook_handle)
!-------------------------------------------------------------------------------
!
!*       1.     Radiative Fluxes
!               ----------------
!
! LWnet: transform from explicit to implicit (i.e. at time t+dt)
!
plwnet_v(:)  = plwnet_v(:) + plwnet_v_dtv(:)*pdeltat_v(:)   &
                           + plwnet_v_dtg(:)*pdeltat_g(:)   &
                           + plwnet_v_dtn(:)*pdeltat_n(:)

plwnet_g(:)  = plwnet_g(:) + plwnet_g_dtv(:)*pdeltat_v(:)   &
                           + plwnet_g_dtg(:)*pdeltat_g(:)   &
                           + plwnet_g_dtn(:)*pdeltat_n(:)

plwnet_n(:)  = plwnet_n(:) + plwnet_n_dtv(:)*pdeltat_v(:)   &
                           + plwnet_n_dtg(:)*pdeltat_g(:)   &
                           + plwnet_n_dtn(:)*pdeltat_n(:)
!
! LWup at t+dt
!
plw_up(:)   = plw_rad(:) - (plwnet_v(:) + plwnet_g(:) + plwnet_n(:))
!
!
! Effective emissivity:
!
 CALL isba_emis_meb(ppsn, ppsna, psigma_f, psigma_fn,  &
                    pemis_n, pemis                     )
!
! Now compute the effective radiative temperature while
! imposing the constraint: 
!
!    LW_RAD * (1 - EMIS ) + EMIS * XSTEFAN * TS_RAD**4 = LWUP
!
! Using the effective emissivity ensures that the upwelling radiation from the surface (RHS)
! model will be equal to the upwelling radiation computed in the atmospheric model (LHS)
! (i.e. LWUP is consistent with EMIS & TS_RAD), thereby insuring energy conservation from
! the surface to the atmosphere. Solving the above equation for
! the radiative T gives:
!
pts_rad(:)    = ((plw_up(:) - plw_rad(:)*(1.0-pemis(:)))/(xstefan*pemis(:)))**0.25
!
!
! Rnet (t+dt)
!
prnet_v(:)  = pswnet_v(:) + plwnet_v(:)
!
prnet_g(:)  = pswnet_g(:) + plwnet_g(:)
!
prnet_n(:)  = pswnet_n(:) + plwnet_n(:)
!
!
! total Rnet (t+dt):
!
prnet(:)    = prnet_g(:) + prnet_v(:) + prnet_n(:)
!
!
!*       2.a    Implicit (Turbulent) Sensible Heat Fluxes
!               -----------------------------------------

! First get input thermo variable (could be enthalpy (air heat capacity x potential temperature or dry static energy)

zsair(:)  = pthrmb_ta(:)    + pthrma_ta(:)   *pta_ic(:)
zsairc(:) = pthrmb_tc(:)    + pthrma_tc(:)   *ptc(:)

! Sensible heat fluxes (W m-2):
! - Canopy air to atmosphere, vegetation canopy to canopy air (implicitly includes from canopy intercepted snow), 
!   understory-ground to canopy air,
!   ground-based snow to canopy air, ground-based snow to atmosphere:

ph_c_a(:)  = pflxc_c_a(:) *( zsairc(:)                            - zsair(:)  )*(1.0 - ppsn(:)*ppsna(:))
ph_v_c(:)  = pflxc_v_c(:) *( pthrmb_tv(:) + pthrma_tv(:)*ptv(:)   - zsairc(:) ) 
ph_g_c(:)  = pflxc_g_c(:) *( pthrmb_tg(:) + pthrma_tg(:)*ptg(:,1) - zsairc(:) )*(1.0-ppsn(:))
ph_n_c(:)  = pflxc_n_c(:) *( pthrmb_tn(:) + pthrma_tn(:)*ptn(:,1) - zsairc(:) )*     ppsn(:) *(1.0-ppsna(:)) 
ph_n_a(:)  = pflxc_n_a(:) *( pthrmb_tn(:) + pthrma_tn(:)*ptn(:,1) - zsair(:)  )*     ppsn(:) *     ppsna(:) 

! - Net sensible heat flux from ground-based snow (to the canopy and the atmosphere (from
!   the buried-vegetation canopy fraction)) (W m-2) 

ph_n(:)    = ph_n_c(:) + ph_n_a(:) 

! FINAL sensible heat flux to the atmosphere (W m-2):

ph(:)      = ph_c_a(:) + ph_n_a(:)

!
!*       2.b    Implicit (Turbulent) Vapor and Latent Heat Fluxes
!               -------------------------------------------------
! Note, to convert any of the latent heat fluxes back to vapor fluxes, 
! simply divide by XLVTT, even sublimation fluxes as XLSTT already accounted for.

! - first get 'new' surface specific humidities, qsatn, at time t+dt:

zqsatn_g(:)  =        pqsat_g(:)  + pdqsat_g(:)  * pdeltat_g(:)
zqsatn_v(:)  =        pqsat_v(:)  + pdqsat_v(:)  * pdeltat_v(:)
zqsatin_n(:) =        pqsati_n(:) + pdqsati_n(:) * pdeltat_n(:)

! additional sfc diagnostics needed for soil and snow hydrolology and intercepted water reservoirs:

zfff(:)       = pff(:)*( 1.0 - pffrozen(:)*(1.0 - (xlstt/xlvtt)) )

! - Evaporation and Sublimation latent heat fluxes from the soil, respectively:
! (kg m-2 s-1)

zwork(:)      = (1.-ppsn(:)-zfff(:)) * pflxc_g_c(:)

pleg(:)       = zwork(:)*pleg_delta(:) *( phug(:) *zqsatn_g(:) - pqc(:) )*(1.-pfrozen1(:))*xlvtt

plegi(:)      = zwork(:)*plegi_delta(:)*( phugi(:)*zqsatn_g(:) - pqc(:) )*    pfrozen1(:) *xlstt

! - Latent heat flux from frozen and unfrozen flooded zones (W m-2)

zwork(:)      = pff(:) * pflxc_g_c(:)*( zqsatn_g(:) - pqc(:) )
ple_flood(:)  = zwork(:) * (1.-pffrozen(:))* xlvtt 
plei_flood(:) = zwork(:) *     pffrozen(:) * xlstt 

! - Evapotranspiration vapor flux from the vegetation canopy (kg m-2 s-1)

zevap_v_c(:) = (1.-ppsncv(:)) * phvgs(:) * pflxc_v_c(:)*( zqsatn_v(:) - pqc(:) )

! - Latent heat flux from the canopy (liquid) water interception reservoir (W m-2)

pler_v_c(:)   = ( (1.-ppsna(:))*ppsn(:) * pflxc_vn_c(:)    +                      &
                           (1.-ppsn(:))* pflxc_vg_c(:)  ) *                       &
                 xlvtt * (1.-ppsncv(:))* pdelta_v(:) * ( zqsatn_v(:) - pqc(:) )

! - latent heat flux from transpiration from the canopy (W m-2)

pletr_v_c(:) = zevap_v_c(:) * xlvtt - pler_v_c(:) 

! Snow sublimation and evaporation latent heat flux from canopy-intercepted snow (W m-2)

ples_v_c(:)  =  ppsncv(:) * xlstt * phvns(:) * pflxc_v_c(:)*( zqsatn_v(:) - pqc(:) )

! - Total latent heat flux (evapotranspiration) from the vegetation to the canopy air space (W m-2)
!   *without* sublimation (for TOTAL evapotranspiration and sublimation, add PLESC here)

plev_v_c(:)  = xlvtt*zevap_v_c(:) 

! - Total latent heat flux from vegetation canopy overstory to canopy air space
!   (including transpiration, liquid water store, canopy snow sublimation):

ple_v_c(:)   = plev_v_c(:) + ples_v_c(:)

! - Vapor flux from the ground-based snowpack to the canopy air (kg m-2 s-1):

pevap_n_c(:) = pflxc_n_c(:)*(zqsatin_n(:) - pqc(:))*ppsn(:)*(1.0-ppsna(:))*(xlstt/xlvtt)

ple_n_c(:)   = xlvtt*pevap_n_c(:) ! W m-2

! - latent heat flux from transpiration from canopy veg (evapotranspiration)

pletr(:)     = pletr_v_c(:)

! Total latent heat flux from transpiration from understory veg and canopy veg (evapotranspiration and sublimation)
!   and intercepted water on both reservoirs (W m-2) 

plev(:)      = pletr(:) + pler_v_c(:) 

! Total latent heat flux from intercepted water (canopy and understory vegetation):
! (does not include intercepted snow sublimation): W m-2

pler(:)      = pler_v_c(:)

! - Vapor flux from the ground-based snowpack (part burying the canopy vegetation) to the atmosphere (kg m-2 s-1):

pevap_n_a(:) = pflxc_n_a(:) *( zqsatin_n(:) - pqa_ic(:))*       ppsn(:)*     ppsna(:) *(xlstt/xlvtt)

! - Net Snow (groud-based) sublimation latent heat flux (W m-2) to the canopy air space and the overlying atmosphere:

ples(:)      = ( pflxc_n_c(:) *( zqsatin_n(:) - pqc(:)   )*       ppsn(:)*(1.0-ppsna(:))  +         &
                 pflxc_n_a(:) *( zqsatin_n(:) - pqa_ic(:))*       ppsn(:)*     ppsna(:) ) * xlstt

! - Net Snow evaporation (liquid water) latent heat flux (W m-2)

plel(:)      = xlvtt*(pevap_n_c(:) + pevap_n_a(:)) - ples(:)

! - Total mass flux from ground-based snowpack (kg m-2 s-1)

pevapn(:)    = (plel(:) + ples(:))/xlvtt

! - Total snow-free vapor flux from the understory (flooded areas, baresoil and understory vegetation)
!   to the canopy air space (W m-2 and kg m-2 s-1, respectively):

ple_g_c(:)   = ple_flood(:) + plei_flood(:) + plegi(:) + pleg(:) 

pevap_g_c(:) = ple_g_c(:)/xlvtt 

! - Net vapor flux from canopy air to the atmosphere (kg m-2 s-1)

pevap_c_a(:) = pflxc_c_a(:) *( pqc(:) - pqa_ic(:))*(1.0 - ppsn(:)*ppsna(:))

ple_c_a(:)   = xlvtt * pevap_c_a(:) ! W m-2

! FINAL net vapor flux from the surface to the Atmosphere:
! - Net vapor flux from canopy air and exposed ground based snow (from part of snow 
!   burying the vegetation canopy) to the atmosphere (kg m-2 s-1)
!
pevap(:)     = pevap_c_a(:) + pevap_n_a(:)   
! 
! Total latent heat flux of surface/snow/vegetation: W m-2
!
ple(:)       = pevap(:)*xlvtt                    
!
! Total sublimation from the surface/snow/vegetation: W m-2
!
plei(:)      = ples(:) + plegi(:) + plei_flood(:)
!
! Total sublimation from the surface/snow/vegetation: kg m-2 s-1
!
psubl(:)     = plei(:)/plstt(:)
!
IF (lhook) CALL dr_hook('ISBA_FLUXES_MEB',1,zhook_handle)
!
END SUBROUTINE isba_fluxes_meb