avg_albedo_emis_greenroof.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_greenroof (TGR, &
                                            halbedo,         &
                                 pveg,pz0,plai,ptg1,        &
                                 psw_bands,                 &
                                 palbnir_veg,palbvis_veg,   &
                                 palbuv_veg,                &
                                 palbnir_soil,palbvis_soil, &
                                 palbuv_soil,               &
                                 pemis_eco,                 &
                                 tpsnow,                    &
                                 palbnir_eco,palbvis_eco,   &
                                 palbuv_eco,                &
                                 pdir_alb,psca_alb,         &
                                 pemis,ptsrad               )  
!     ###################################################
!
!!**** ** computes radiative fields used in GREENROOF
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!    Based on avg_albedo_emis_garden
!!
!!    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
!      C. de Munck & A. Lemonsu   09/2011   Greenroofs
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_teb_greenroof_n, ONLY : teb_greenroof_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(teb_greenroof_t), INTENT(INOUT) :: tgr
!
 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)   :: pveg        ! vegetation fraction
REAL, DIMENSION(:),   INTENT(IN)   :: pz0         ! roughness length
REAL, DIMENSION(:),   INTENT(IN)   :: plai        ! leaf area index
REAL, DIMENSION(:),   INTENT(IN)   :: ptg1        ! soil surface temperature
REAL, DIMENSION(:),   INTENT(IN)   :: psw_bands   ! middle wavelength of each band 

REAL, DIMENSION(:),   INTENT(IN)   :: palbnir_veg ! near-infra-red albedo of vegetation
REAL, DIMENSION(:),   INTENT(IN)   :: palbvis_veg ! visible albedo of vegetation
REAL, DIMENSION(:),   INTENT(IN)   :: palbuv_veg  ! UV albedo of vegetation
REAL, DIMENSION(:),   INTENT(IN)   :: palbnir_soil! near-infra-red albedo of soil
REAL, DIMENSION(:),   INTENT(IN)   :: palbvis_soil! visible albedo of soil
REAL, DIMENSION(:),   INTENT(IN)   :: palbuv_soil ! UV albedo of soil
REAL, DIMENSION(:),   INTENT(IN)   :: pemis_eco   ! emissivity (soil+vegetation)
TYPE(surf_snow),      INTENT(IN)   :: tpsnow      ! prognostic snow cover
!
REAL, DIMENSION(:),   INTENT(OUT)  :: palbnir_eco ! near-infra-red albedo (soil+vegetation)
REAL, DIMENSION(:),   INTENT(OUT)  :: palbvis_eco ! visible albedo (soil+vegetation)
REAL, DIMENSION(:),   INTENT(OUT)  :: palbuv_eco  ! UV albedo (soil+vegetation)
!
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(PALBNIR_VEG)) :: zalbnir ! near-infra-red albedo with snow
REAL, DIMENSION(SIZE(PALBVIS_VEG)) :: zalbvis ! visible albedo with snow
REAL, DIMENSION(SIZE(PALBUV_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_GREENROOF',0,zhook_handle)
 CALL albedo(halbedo,                                  &
            palbvis_veg,palbnir_veg,palbuv_veg,pveg,  &
            palbvis_soil,palbnir_soil,palbuv_soil,    &
            palbvis_eco,palbnir_eco,palbuv_eco        )  

!
!*    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(tgr%CUR%TSNOW%SCHEME,                          &
                    tgr%CUR%TSNOW%WSNOW(:,:,1), tgr%CUR%TSNOW%RHO(:,:,1),  &
                    tgr%CUR%TSNOW%ALB  (:,1),                      &
                    pveg(:), plai(:), pz0(:),              &
                    tgr%CUR%XPSN(:), tgr%CUR%XPSNV_A(:),                   &
                    tgr%CUR%XPSNG(:), tgr%CUR%XPSNV(:) )  
!
 WHERE (pveg(:)/=xundef)
!
! albedo on this tile
!
    zalbnir(:) = (1.-tgr%CUR%XPSN(:))*palbnir_eco(:) + tgr%CUR%XPSN(:) *tpsnow%ALB(:,1)
      
    zalbvis(:) = (1.-tgr%CUR%XPSN(:))*palbvis_eco(:) + tgr%CUR%XPSN(:) *tpsnow%ALB(:,1)
 
    zalbuv(:)  = (1.-tgr%CUR%XPSN(:))*palbuv_eco(:) + tgr%CUR%XPSN(:) *tpsnow%ALB(:,1)
  END WHERE
!
!* albedo for each wavelength
!
  CALL albedo_from_nir_vis(psw_bands,zalbnir, zalbvis, zalbuv,  &
                           pdir_alb(:,:), psca_alb(:,:) )  
!
! emissivity
!
  WHERE (pemis_eco(:)/=xundef)
    pemis(:) = (1.-tgr%CUR%XPSN(:))*pemis_eco(:) + tgr%CUR%XPSN(:) * xemissn  
  END WHERE
!
!* radiative surface temperature
!
  IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA') THEN
    ptsrad(:) = ptg1(:)
  ELSE IF (tpsnow%SCHEME=='3-L' .OR. tpsnow%SCHEME=='CRO') THEN
    WHERE (pemis_eco(:)/=xundef)
      ptsrad(:) = ( ( (1.-tgr%CUR%XPSN(:))*pemis(:)*ptg1(:)**4                           &
                   +      tgr%CUR%XPSN(:) *tpsnow%EMIS(:,1)*tpsnow%TS(:,1)**4 ) )**0.25  &
                         / pemis(:)**0.25  
    END WHERE
  END IF
!
IF (lhook) CALL dr_hook('AVG_ALBEDO_EMIS_GREENROOF',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE avg_albedo_emis_greenroof