soil_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 soil_albedo(HALBEDO, PWSAT, PWG1, KK, PEK, HBAND)  
!     ####################################################################
!
!!****  *SOIL_ALBEDO*  
!!
!!    PURPOSE
!!    -------
!  computes the SOIL_ALBEDO of for different types (patches) 
! of natural continental parts.
!
! Soil SOIL_ALBEDO is estimated from sand fraction.
! A correction due to the soil humidity can be used.
!
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!      F.Solmon  /  V. Masson          
!!
!!    MODIFICATIONS
!!    -------------
!!      Original     
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_k_t, isba_pe_t
!
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
! SOIL_ALBEDO dependance wxith surface soil water content
!   "EVOL" = SOIL_ALBEDO evolves with soil wetness
!   "DRY " = constant SOIL_ALBEDO value for dry soil
!   "WET " = constant SOIL_ALBEDO value for wet soil
!   "MEAN" = constant SOIL_ALBEDO value for medium soil wetness
!
REAL, DIMENSION(:), INTENT(IN)    :: PWSAT       ! saturation water content
REAL, DIMENSION(:), INTENT(IN)  :: PWG1        ! surface water content
!
TYPE(isba_k_t), INTENT(INOUT) :: KK
TYPE(isba_pe_t), INTENT(INOUT) :: PEK
!
 CHARACTER(LEN=*), INTENT(IN) :: HBAND
!
!*      0.2    declarations of local variables
!              -------------------------------
!
REAL,    DIMENSION(SIZE(PWSAT)) :: ZX
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('SOIL_ALBEDO',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('SOIL_ALBEDO',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
IF (trim(hband)=="VIS".OR.trim(hband)=="ALL") pek%XALBVIS_SOIL = xundef
IF (trim(hband)=="NIR".OR.trim(hband)=="ALL") pek%XALBNIR_SOIL = xundef
IF (trim(hband)=="UV" .OR.trim(hband)=="ALL") pek%XALBUV_SOIL  = xundef
!
SELECT CASE ( halbedo )
CASE ('EVOL')

    zx = min( pwg1(:)/pwsat(:) , 1. )

    IF (trim(hband)=="VIS".OR.trim(hband)=="ALL") &
      WHERE (pwg1(:)/=xundef) &
        pek%XALBVIS_SOIL(:) = kk%XALBVIS_WET(:) + &
            (0.25*kk%XALBVIS_DRY(:)-kk%XALBVIS_WET(:)) * (1. - zx(:)) * &
       ( zx(:) + (kk%XALBVIS_DRY(:)-kk%XALBVIS_WET(:)) / (0.25*kk%XALBVIS_DRY(:)-kk%XALBVIS_WET(:)) )  
    IF (trim(hband)=="NIR".OR.trim(hband)=="ALL") &
      WHERE (pwg1(:)/=xundef) &      
        pek%XALBNIR_SOIL(:) = kk%XALBNIR_WET(:) + &
           (0.25*kk%XALBNIR_DRY(:)-kk%XALBNIR_WET(:)) * (1. - zx(:)) * &
      ( zx(:) + (kk%XALBNIR_DRY(:)-kk%XALBNIR_WET(:)) / (0.25*kk%XALBNIR_DRY(:)-kk%XALBNIR_WET(:)) )  
    IF (trim(hband)=="UV".OR.trim(hband)=="ALL") &
      WHERE (pwg1(:)/=xundef) &      
        pek%XALBUV_SOIL (:) = kk%XALBUV_WET (:) + &
           (0.25*kk%XALBUV_DRY (:)-kk%XALBUV_WET (:)) * (1. - zx(:)) * &
      ( zx(:) + (kk%XALBUV_DRY (:)-kk%XALBUV_WET (:)) / (0.25*kk%XALBUV_DRY (:)-kk%XALBUV_WET (:)) )  

    !END WHERE

CASE ('DRY ')
  IF (trim(hband)=="VIS".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBVIS_SOIL(:) = kk%XALBVIS_DRY(:)
  IF (trim(hband)=="NIR".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBNIR_SOIL(:) = kk%XALBNIR_DRY(:)
  IF (trim(hband)=="UV".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBUV_SOIL (:) = kk%XALBUV_DRY (:)

CASE ('WET ')
  IF (trim(hband)=="VIS".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBVIS_SOIL(:) = kk%XALBVIS_WET(:)
  IF (trim(hband)=="NIR".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBNIR_SOIL(:) = kk%XALBNIR_WET(:)
  IF (trim(hband)=="UV".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBUV_SOIL (:) = kk%XALBUV_WET (:)

CASE ('MEAN')
  IF (trim(hband)=="VIS".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBVIS_SOIL(:) = 0.5 * ( kk%XALBVIS_DRY(:) + kk%XALBVIS_WET(:) )
  IF (trim(hband)=="NIR".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBNIR_SOIL(:) = 0.5 * ( kk%XALBNIR_DRY(:) + kk%XALBNIR_WET(:) )
  IF (trim(hband)=="UV".OR.trim(hband)=="ALL") &
    WHERE (pwg1(:)/=xundef) pek%XALBUV_SOIL (:) = 0.5 * ( kk%XALBUV_DRY (:) + kk%XALBUV_WET (:) )

END SELECT
IF (lhook) CALL dr_hook('SOIL_ALBEDO',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE soil_albedo