isba_properties.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_properties(IO, PEK, PDIR_SW, PSCA_SW, PSW_BANDS, KSW,  &
                                 PASNOW, PANOSNOW, PESNOW, PENOSNOW,         &
                                 PTSSNOW, PTSNOSNOW,                         &
                                 PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL )  
!     ##########################################################################
!
!!****  *ISBA_PROPERTIES*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates grid-averaged albedo and emissivity (according to snow scheme)
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!      S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    ------------- 
!!      
!!      P. Samuelsson  02/2012  MEB
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_pe_t
!
USE modd_type_snow
USE modd_snow_par   , ONLY : xemissn, xemcrin, xsnowdmin, &
                               xrhosmax_es, xrhosmin_es  
USE modd_water_par  , ONLY : xemiswat
!
USE modi_isba_snow_frac
USE modi_isba_albedo
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffus incoming solar radiation
REAL, DIMENSION(:)  , INTENT(IN)   :: PSW_BANDS          ! mean wavelength of each shortwave band (m)
INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands            
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: PASNOW    ! = snow albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PANOSNOW  ! = snow free albedo 
REAL, DIMENSION(:)  , INTENT(OUT)  :: PESNOW    ! = snow emissivity
REAL, DIMENSION(:)  , INTENT(OUT)  :: PENOSNOW  ! = snow free emissivity
REAL, DIMENSION(:)  , INTENT(OUT)  :: PTSSNOW   ! = snow radiative temperature
REAL, DIMENSION(:)  , INTENT(OUT)  :: PTSNOSNOW ! = snow free radiative temperature
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TVEG       ! nearIR  veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TVEG       ! visible veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TSOIL      ! nearIR  soil tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TSOIL      ! visible soil tot albedo
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(PDIR_SW,1)) :: ZGLOBAL_SW                 ! global incoming SW rad.
REAL, DIMENSION(SIZE(PEK%XALBNIR))   :: ZALBF
REAL, DIMENSION(SIZE(PEK%XALBNIR))   :: ZFFV
REAL, DIMENSION(SIZE(PEK%XALBNIR))   :: ZFFG
!
LOGICAL, PARAMETER :: GMEB=.false.
REAL, DIMENSION(SIZE(PDIR_SW,1))   :: ZP_MEB_SCA_SW, ZALBNIR_TSNOW, ZALBVIS_TSNOW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ISBA_PROPERTIES',0,zhook_handle)
!
 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 )  
!
!-------------------------------------------------------------------------------
!*      2.     Compute snow-free albedo
!              ------------------------
!
!* Snow-free surface albedo for each wavelength
!
zalbf         = 0.
zffv          = 0.
zffg          = 0.
!
 CALL isba_albedo(pek, io%LTR_ML, gmeb, pdir_sw, psca_sw, psw_bands, ksw, &
                  zalbf, zffv, zffg, zglobal_sw, zp_meb_sca_sw,           &
                  palbnir_tveg, palbvis_tveg, palbnir_tsoil, palbvis_tsoil)

panosnow(:) = pek%XSNOWFREE_ALB(:)
!-------------------------------------------------------------------------------
!
!*      3.     Compute aggeragted albedo and emissivity
!              ----------------------------------------
!
IF(pek%TSNOW%SCHEME == '3-L' .OR. pek%TSNOW%SCHEME == 'CRO' .OR. io%CISBA == 'DIF')THEN
!
! NON-SNOW covered Grid averaged albedo and emissivity for explicit snow scheme:
!
  pasnow(:) = pek%TSNOW%ALB(:)
  pesnow(:) = pek%TSNOW%EMIS(:)
  penosnow(:) = pek%XEMIS(:)

  ptssnow(:)   = pek%TSNOW%TS(:)
  ptsnosnow(:) = pek%XTG(:,1)

ELSE
!
! Grid averaged albedo and emissivity for composite snow scheme:
!
  IF(pek%TSNOW%SCHEME =='EBA') THEN
!
    pasnow(:) = pek%TSNOW%ALB(:)
    pesnow(:) = xemcrin
    penosnow(:) = pek%XEMIS(:)

    ptssnow(:) = pek%XTG(:,1)
    ptsnosnow(:) = pek%XTG(:,1)

  ELSE

    pasnow(:) = pek%TSNOW%ALB(:)
    pesnow(:) = xemissn
    penosnow(:) = pek%XEMIS(:)

    ptssnow(:) = pek%XTG(:,1)
    ptsnosnow(:) = pek%XTG(:,1)

  ENDIF
!
ENDIF
IF (lhook) CALL dr_hook('ISBA_PROPERTIES',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE isba_properties