isba_lwnet_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_lwnet_meb(PLAI,PPSN,PPSNA,PEMIS_N,PEMIS_F,PFF,                          &
           ptv,ptg,ptn,plw_rad,plwnet_n,plwnet_v,plwnet_g,                                    &
           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,                                            &
           psigma_f,psigma_fn,                                                                &
           plwdown_gn                                                                         )

!
!!****  *ISBA_LWNET_MEB*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates the net longwave radiation budget terms for fully
!     coupled snow, soil-understory vegetation and canopy vegetation.
!     Flux derrivatives also herein.
!         
!     
!!**  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 mode_meb,  ONLY : meb_shield_factor
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:),   INTENT(IN)  :: plai, ppsn, ppsna, plw_rad, psigma_f
!
REAL, DIMENSION(:),   INTENT(IN)  :: ptv, ptg, ptn
!
REAL, DIMENSION(:),   INTENT(IN)  :: pemis_n, pemis_f, pff
!
REAL, DIMENSION(:),   INTENT(OUT) :: plwnet_n, plwnet_v, plwnet_g
!
REAL, DIMENSION(:),   INTENT(OUT) :: plwdown_gn
!
REAL, DIMENSION(:),   INTENT(OUT) :: plwnet_v_dtv, plwnet_v_dtg, plwnet_v_dtn
!                                     PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN = Vegetation canopy net radiation 
!                                     derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(OUT) :: plwnet_g_dtv, plwnet_g_dtg, plwnet_g_dtn
!                                     PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN = Understory-ground net radiation 
!                                          derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(OUT) :: plwnet_n_dtv, plwnet_n_dtg, plwnet_n_dtn
!                                     PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN = Ground-based snow net radiation 
!                                          derivatives w/r/t surface temperature(s) (W m-2 K-1)
!
REAL, DIMENSION(:),   INTENT(OUT) :: psigma_fn
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(SIZE(PLAI)) :: zlwup
!
REAL, DIMENSION(SIZE(PLAI)) :: zsigma_fa, zpn, zfrac, zemis
!
REAL, DIMENSION(SIZE(PLAI)) :: zlw_g_a, zlw_g_b, zlw_g_c,            &
                               zlw_g_d, zlw_g_e, zlw_g_f, zlw_g_g,   &
                               zlw_g_h, zlw_g_i, zlw_g_j, zlw_g_k,   &
                               zlw_g_l
!
REAL, DIMENSION(SIZE(PLAI)) :: zlw_n_a, zlw_n_b, zlw_n_c,            &
                               zlw_n_d, zlw_n_e, zlw_n_f, zlw_n_g,   &
                               zlw_n_h, zlw_n_i, zlw_n_j, zlw_n_k,   &
                               zlw_n_l
!
REAL, DIMENSION(SIZE(PEMIS_N)) :: zemis_g
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!*       0.     Initialization:
!               ---------------
!
IF (lhook) CALL dr_hook('ISBA_LWNET_MEB',0,zhook_handle)
!-------------------------------------------------------------------------------
!
! Soil with flooded part:
!
zemis_g(:)    = xemissoil*(1.-pff(:)) + pff(:)*pemis_f(:)
!
!*       1.     View factors: transmission
!               --------------------------
!
psigma_fn(:)  = 1.0 - meb_shield_factor(plai,ppsna)          ! NOTE: Effects of intercepted snow on the 
!                                                            !       canopy is neglected.
!
!*       2.     Longwave radiation terms
!               ------------------------

! - over snow-free fraction:

zfrac(:)      = 1.-ppsn(:)
zpn(:)        = ppsn(:)*(1.-ppsna(:))
zsigma_fa(: ) = (1.-zpn(:))*psigma_f(:) + zpn(:)*psigma_fn(:)

 CALL lw_flux_comp(zpn,plw_rad,zfrac,psigma_f,zsigma_fa,       &
     zemis_g,ptv,ptg,                                         & 
     zlw_g_a,zlw_g_b,zlw_g_c,zlw_g_d,zlw_g_e,zlw_g_f,         &
     zlw_g_g,zlw_g_h,zlw_g_i,zlw_g_j,zlw_g_k,zlw_g_l          )

! - over snow-covered fraction:

zfrac(:)      = ppsn(:)
zpn(:)        = ppsn(:) + ppsna(:)*(1.-ppsn(:))
zsigma_fa(: ) = (1.-zpn(:))*psigma_f(:) + zpn(:)*psigma_fn(:)

 CALL lw_flux_comp(zpn,plw_rad,zfrac,psigma_fn,zsigma_fa,      &
     pemis_n,ptv,ptn,                                         & 
     zlw_n_a,zlw_n_b,zlw_n_c,zlw_n_d,zlw_n_e,zlw_n_f,         &
     zlw_n_g,zlw_n_h,zlw_n_i,zlw_n_j,zlw_n_k,zlw_n_l          )

!------------------------------------------------------------------
! Diagnostics
!------------------------------------------------------------------

! Total LW energy flux reaching ground/snow surface: (W m-2)
! (explicit part: the implicit flux needs to have the derrivative terms added)

plwdown_gn(:) = zlw_g_c(:) + zlw_g_f(:) + zlw_n_c(:) + zlw_n_f(:) + &
                zlw_g_j(:) + zlw_g_k(:) + zlw_n_j(:) + zlw_n_k(:)

!------------------------------------------------------------------
! - compute derivatives: W m-2 K-1
!------------------------------------------------------------------

plwnet_v_dtv(:) = ( zlw_g_g(:) - zlw_g_h(:) - 2*zlw_g_f(:)             &
                  + zlw_n_g(:) - zlw_n_h(:) - 2*zlw_n_f(:)  )*4/ptv(:)
plwnet_v_dtg(:) = ( zlw_g_i(:) - zlw_g_j(:) -   zlw_g_k(:)             &
                  - zlw_g_l(:)                              )*4/ptg(:)
plwnet_v_dtn(:) = ( zlw_n_i(:) - zlw_n_j(:) -   zlw_n_k(:)             &
                  - zlw_n_l(:)                              )*4/ptn(:)

plwnet_g_dtv(:) = ( zlw_g_f(:) - zlw_g_g(:)                 )*4/ptv(:)
plwnet_g_dtg(:) = ( zlw_g_j(:) - zlw_g_i(:)                 )*4/ptg(:)
plwnet_g_dtn(:) =   zlw_n_j(:)                               *4/ptn(:)

plwnet_n_dtv(:) = ( zlw_n_f(:) - zlw_n_g(:)                 )*4/ptv(:)
plwnet_n_dtg(:) =   zlw_g_k(:)                               *4/ptg(:)
plwnet_n_dtn(:) = ( zlw_n_j(:) - zlw_n_i(:)                 )*4/ptn(:)

!------------------------------------------------------------------
! - Compute *explicit* net budgets (at time t): W m-2
!   NOTE: fully implicit budgets (at time t+dt) are computed 
!   *after* energy budget
!------------------------------------------------------------------

zlwup(:)     =   zlw_g_b(:) + zlw_g_e(:) + zlw_g_f(:) + zlw_g_h(:)     &
               + zlw_g_l(:)                                            &
               + zlw_n_b(:) + zlw_n_e(:) + zlw_n_f(:) + zlw_n_h(:)     &
               + zlw_n_l(:)

plwnet_g(:)  =   zlw_g_c(:) + zlw_g_f(:) + zlw_g_j(:)                  &
               - zlw_g_i(:) - zlw_g_d(:) - zlw_g_g(:)                  &
               + zlw_n_j(:)

plwnet_n(:)  =   zlw_n_c(:) + zlw_n_f(:) + zlw_n_k(:)                  &
               - zlw_n_i(:) - zlw_n_d(:) - zlw_n_g(:)                  &
               + zlw_g_k(:)

plwnet_v(:)  = plw_rad(:) - zlwup(:) - plwnet_g(:) - plwnet_n(:) 

IF (lhook) CALL dr_hook('ISBA_LWNET_MEB',1,zhook_handle)

 CONTAINS
!=========================================================
SUBROUTINE lw_flux_comp(PPN,PLW_RAD,PFRAC,PSIGMA_F,PSIGMA_FA,      &
     pemis_s,ptv,ptemp_s,                                          & 
     plw_a,plw_b,plw_c,plw_d,plw_e,plw_f,plw_g,plw_h,              &
     plw_i,plw_j,plw_k,plw_l                                       )

USE modd_csts,       ONLY : xstefan

IMPLICIT NONE

REAL, DIMENSION(:),   INTENT(IN)  :: ppn, plw_rad, psigma_f, psigma_fa, pfrac
REAL, DIMENSION(:),   INTENT(IN)  :: ptemp_s, ptv
REAL, DIMENSION(:),   INTENT(IN)  :: pemis_s
REAL, DIMENSION(:),   INTENT(OUT) :: plw_a, plw_b, plw_c, plw_d, plw_e, plw_f, &
                                     plw_g, plw_h, plw_i, plw_j, plw_k, plw_l

! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

REAL, DIMENSION(SIZE(PLW_RAD))    :: zwork
REAL(KIND=JPRB) :: zhook_handle
!--------------------------------------------------------------
IF (lhook) CALL dr_hook('LW_FLUX_COMP',0,zhook_handle)

plw_a(:)      = plw_rad(:)*pfrac(:)
plw_b(:)      = plw_a(:)*    psigma_f(:)    *(1.-xemisveg)
plw_c(:)      = plw_a(:)*(1.-psigma_f(:))
plw_d(:)      = plw_c(:)                    *(1.-pemis_s(:))
plw_e(:)      = plw_d(:)*(1.-psigma_fa(:))

plw_f(:)      =                psigma_fa(:) *    xemisveg * pfrac(:) *xstefan*(ptv(:)**4)
plw_g(:)      = plw_f(:)                    *(1.-pemis_s(:))
plw_h(:)      = plw_g(:)*(1.-psigma_fa(:))

zwork(:)      = (1.-xemisveg)*psigma_fa(:)
plw_i(:)      =                                  pemis_s(:) * pfrac(:) *xstefan*(ptemp_s(:)**4)
plw_j(:)      = plw_i(:)*zwork(:)                           *(1.-ppn(:))
plw_k(:)      = plw_i(:)*zwork(:)*                               ppn(:)
plw_l(:)      = plw_i(:)*(1.-psigma_fa(:))

IF (lhook) CALL dr_hook('LW_FLUX_COMP',1,zhook_handle)

END SUBROUTINE lw_flux_comp
!=========================================================

END SUBROUTINE isba_lwnet_meb