albedo.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 albedo(HALBEDO, PEK, PSNOW, OMASK    )  
!     ####################################################################
!
!!****  *ALBEDO*  
!!
!!    PURPOSE
!!    -------
!  computes the albedo of for different types (patches) 
! of natural continental parts, from
! vegetation albedo and soil albedo.
! Soil albedo is estimated from sand fraction.
! A correction due to the soil humidity is used.
!
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!      F.Solmon  /  V. Masson          
!!
!!    MODIFICATIONS
!!    -------------
!!      Original     
!!                  01/2004  Externalization (V. Masson)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_pe_t
!
USE modd_data_cover_par, ONLY : nvt_snow
USE modd_snow_par,       ONLY : xansmax
USE modd_surf_par,       ONLY : xundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*),       INTENT(IN)   :: HALBEDO
! Albedo dependance wxith 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
!
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
REAL,    DIMENSION(:), INTENT(IN), OPTIONAL  :: PSNOW ! fraction of permanent snow and ice
LOGICAL, DIMENSION(:),   INTENT(IN), OPTIONAL :: OMASK    ! mask where computations are done
!
!*      0.2    declarations of local variables
!              -------------------------------
!
LOGICAL, DIMENSION(SIZE(PEK%XVEG)) :: GMASK
!
REAL, DIMENSION(SIZE(PEK%XVEG)) :: ZSNOW
INTEGER :: JP     !loop index for patches
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ALBEDO',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('ALBEDO',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
gmask(:) = .true.
IF (PRESENT(omask)) gmask(:) = omask(:)
!
WHERE (gmask(:))
  pek%XALBVIS (:) = xundef
  pek%XALBNIR (:) = xundef
  pek%XALBUV  (:) = xundef
END WHERE
!
zsnow(:) = 0.
IF (PRESENT(psnow)) zsnow(:) = psnow(:)
!
WHERE (gmask(:) .AND. pek%XVEG(:)/=xundef)

  pek%XALBVIS(:) = ( (1.-pek%XVEG(:)) * pek%XALBVIS_SOIL(:) + pek%XVEG(:)  * pek%XALBVIS_VEG (:)) &
         * (1-zsnow(:)) + xansmax  * zsnow(:)   
  !
  pek%XALBNIR(:) = ( (1.-pek%XVEG(:)) * pek%XALBNIR_SOIL(:) + pek%XVEG(:)  * pek%XALBNIR_VEG (:)) &
         * (1-zsnow(:)) + xansmax  * zsnow(:)   
  !
  pek%XALBUV (:) = ( (1.-pek%XVEG(:)) * pek%XALBUV_SOIL (:) + pek%XVEG(:)  * pek%XALBUV_VEG  (:)) &
         * (1-zsnow(:)) + xansmax  * zsnow(:)   
END WHERE
!
IF (lhook) CALL dr_hook('ALBEDO',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE albedo