avg_albedo_emis_garden.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_garden (TGD, &
                                         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 GARDEN
!!
!!    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_teb_garden_n, ONLY : teb_garden_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_garden_t), INTENT(INOUT) :: tgd
!
 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_GARDEN',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(tgd%CUR%TSNOW%SCHEME,           &
         tgd%CUR%TSNOW%WSNOW(:,:,1), tgd%CUR%TSNOW%RHO(:,:,1),&
         tgd%CUR%TSNOW%ALB  (:,1),                    &
         pveg(:), plai(:), pz0(:),            &
         tgd%CUR%XPSN(:), tgd%CUR%XPSNV_A(:),                 &
         tgd%CUR%XPSNG(:), tgd%CUR%XPSNV(:)                   )
!
 WHERE (pveg(:)/=xundef)
!
! albedo on this tile
!
    zalbnir(:) = (1.-tgd%CUR%XPSN(:))*palbnir_eco(:) &
                +    tgd%CUR%XPSN(:) *tpsnow%ALB (:,1)  
      
    zalbvis(:) = (1.-tgd%CUR%XPSN(:))*palbvis_eco(:) &
                +    tgd%CUR%XPSN(:) *tpsnow%ALB (:,1)  
      
    zalbuv(:)  = (1.-tgd%CUR%XPSN(:))*palbuv_eco(:) &
                +    tgd%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.-tgd%CUR%XPSN(:))*pemis_eco(:) &
                +    tgd%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.-tgd%CUR%XPSN(:))*pemis(:)       *ptg1(:)**4         &
                  +    tgd%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_GARDEN',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE avg_albedo_emis_garden