avg_albedo_emis_teb_veg.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 avg_albedo_emis_teb_veg (PEK, HALBEDO, PTG1, PSW_BANDS, PDIR_ALB,PSCA_ALB, PEMIS, PTSRAD )  
!     ###################################################
!
!!**** ** computes radiative fields used in TEB_VEG
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    01/2004
!!     A. Bogatchev 09/2005 EBA snow option
!!     B. Decharme  2008    The fraction of vegetation covered by snow must be
!                            <= to XPSNG
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_isba_n, ONLY : isba_pe_t
!
USE modd_surf_par,  ONLY : xundef
!
USE modd_type_snow
!
USE modd_snow_par,   ONLY : xemissn
USE modd_surf_par,   ONLY : xundef
!
!
USE modi_albedo
USE modi_albedo_from_nir_vis
USE modi_isba_snow_frac
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
 CHARACTER(LEN=4),       INTENT(IN)   :: HALBEDO     ! albedo type
! Albedo dependance with surface soil water content
!   "EVOL" = albedo evolves with soil wetness
!   "DRY " = constant albedo value for dry soil
!   "WET " = constant albedo value for wet soil
!   "MEAN" = constant albedo value for medium soil wetness
!
REAL, DIMENSION(:),   INTENT(IN)   :: PTG1        ! soil surface temperature
REAL, DIMENSION(:),     INTENT(IN)   :: PSW_BANDS   ! middle wavelength of each band 
!
REAL, DIMENSION(:,:),   INTENT(OUT)  :: PDIR_ALB    ! averaged direct albedo  (per wavelength)
REAL, DIMENSION(:,:),   INTENT(OUT)  :: PSCA_ALB    ! averaged diffuse albedo (per wavelength)
REAL, DIMENSION(:),     INTENT(OUT)  :: PEMIS       ! averaged emissivity
REAL, DIMENSION(:),     INTENT(OUT)  :: PTSRAD      ! averaged radiaitve temp.
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
!
REAL, DIMENSION(SIZE(PEK%XALBNIR_VEG(:))) :: ZALBNIR ! near-infra-red albedo with snow
REAL, DIMENSION(SIZE(PEK%XALBVIS_VEG(:))) :: ZALBVIS ! visible albedo with snow
REAL, DIMENSION(SIZE(PEK%XALBUV_VEG(:) )) :: ZALBUV  ! UV albedo with snow
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!
!*    1.      averaged albedo on natural continental surfaces (except prognostic snow)
!             -----------------------------------------------
!
IF (lhook) CALL dr_hook('AVG_ALBEDO_EMIS_TEB_VEG',0,zhook_handle)
!
 CALL albedo(halbedo, pek )  

!
!*    2.      averaged albedo and emis. on natural continental surfaces (with prognostic snow)
!             ---------------------------------------------------------
!
zalbnir(:)=0.
zalbvis(:)=0.
zalbuv(:)=0.
!
pdir_alb(:,:)=0.
psca_alb(:,:)=0.
pemis(:)  =0.
ptsrad(:)  =0.
!   
!
 CALL isba_snow_frac(pek%TSNOW%SCHEME, pek%TSNOW%WSNOW, pek%TSNOW%RHO, pek%TSNOW%ALB,  &
                     pek%XVEG, pek%XLAI, pek%XZ0,pek%XPSN, pek%XPSNV_A, pek%XPSNG, pek%XPSNV )
!
WHERE (pek%XVEG/=xundef)
  !
  ! albedo on this tile
  !
  zalbnir(:) = (1.-pek%XPSN)*pek%XALBNIR + pek%XPSN * pek%TSNOW%ALB   
      
  zalbvis(:) = (1.-pek%XPSN)*pek%XALBVIS + pek%XPSN * pek%TSNOW%ALB   
      
  zalbuv(:)  = (1.-pek%XPSN)*pek%XALBUV  + pek%XPSN * pek%TSNOW%ALB   
END WHERE
!
!* albedo for each wavelength
!
 CALL albedo_from_nir_vis(psw_bands,zalbnir, zalbvis, zalbuv, pdir_alb, psca_alb)  
!
! emissivity
!
WHERE (pek%XEMIS/=xundef)
  pemis(:)   = (1.-pek%XPSN)*pek%XEMIS + pek%XPSN *xemissn  
END WHERE
!
!* radiative surface temperature
!
IF (pek%TSNOW%SCHEME=='D95' .OR. pek%TSNOW%SCHEME=='EBA') THEN
  ptsrad(:) = ptg1(:)
ELSE IF (pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') THEN
  WHERE (pek%XEMIS/=xundef)
    ptsrad(:) =( ( (1.-pek%XPSN)*pemis(:)       *ptg1(:)      **4            &
                  +    pek%XPSN *pek%TSNOW%EMIS * pek%TSNOW%TS**4 ) )**0.25  &
                             / pemis(:)**0.25  
  END WHERE
END IF
!
IF (lhook) CALL dr_hook('AVG_ALBEDO_EMIS_TEB_VEG',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE avg_albedo_emis_teb_veg