dry_wet_soil_albedos.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 dry_wet_soil_albedos( KK  )  
!     ##################################################################
!
!!****  *DRY_WET_SOIL_ALBEDOS*  
!!
!!    PURPOSE
!!    -------
!       computes the albedo of bare soil, for dry or wet conditions
!
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    17/12/99 
!       
!      (V. Masson)  16/02/01 Better fit with ISLSCP2; 
!                                            Ba et al 2001; 
!                                            Pinty et al 2000
!      (V. Masson) 01/2004  Add UV albedo
!      (R. Alkama) 05/2012  Add 7 new vegtype (19 rather than 12)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_isba_n, ONLY : isba_k_t
!
USE modd_data_cover_par, ONLY : nvt_park, nvt_tebd, nvt_bone, nvt_trbe, nvt_trbd, &
                                nvt_tebe, nvt_tene, nvt_bobd, nvt_bond, nvt_shrb, &
                                nvt_c3, nvt_c4, nvt_irr, nvt_gras, nvt_bogr,      &
                                nvt_trog, nvt_c3w, nvt_c3s, nvt_fltr, nvt_flgr                 
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!              -------------------------
!
TYPE(isba_k_t), INTENT(INOUT) :: KK
!
REAL :: ZSUM
INTEGER :: JJ
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('DRY_WET_SOIL_ALBEDOS',0,zhook_handle)
!
DO jj=1,SIZE(kk%XVEGTYPE,1)
  !
  zsum = kk%XVEGTYPE(jj,nvt_c4) + kk%XVEGTYPE(jj,nvt_gras) + kk%XVEGTYPE(jj,nvt_trog) &
       + kk%XVEGTYPE(jj,nvt_trbe) + kk%XVEGTYPE(jj,nvt_bone) + kk%XVEGTYPE(jj,nvt_tebd) &
       + kk%XVEGTYPE(jj,nvt_trbd) + kk%XVEGTYPE(jj,nvt_tebe) + kk%XVEGTYPE(jj,nvt_tene) &
       + kk%XVEGTYPE(jj,nvt_bobd) + kk%XVEGTYPE(jj,nvt_bond) + kk%XVEGTYPE(jj,nvt_bogr) &
       + kk%XVEGTYPE(jj,nvt_shrb)
  !
  IF (nvt_c3/=0 .AND. nvt_irr/=0) THEN
    zsum = zsum + kk%XVEGTYPE(jj,nvt_c3) + kk%XVEGTYPE(jj,nvt_irr)
  ELSEIF (nvt_c3w/=0 .AND. nvt_c3s/=0) THEN
    zsum = zsum + kk%XVEGTYPE(jj,nvt_c3w) + kk%XVEGTYPE(jj,nvt_c3s)
  ENDIF
  !
  IF (nvt_park/=0) THEN
    zsum = zsum + kk%XVEGTYPE(jj,nvt_park)
  ELSEIF (nvt_fltr/=0 .AND. nvt_flgr/=0) THEN
    zsum = zsum + kk%XVEGTYPE(jj,nvt_fltr) + kk%XVEGTYPE(jj,nvt_flgr)
  ENDIF
  !
  kk%XALBVIS_DRY(jj) = 0.05 +  (   0.05 + max(0.30 * kk%XSAND(jj,1), 0.10) )  &
                         * ( 1. - 0.9 * zsum**2 )
  !
ENDDO
!
kk%XALBNIR_DRY(:) = kk%XALBVIS_DRY(:) + 0.10
!
kk%XALBUV_DRY (:) = 0.06 + 0.14 * kk%XSAND(:,1)
!
kk%XALBVIS_WET(:) = kk%XALBVIS_DRY(:) / 2.
kk%XALBNIR_WET(:) = kk%XALBNIR_DRY(:) / 2.
kk%XALBUV_WET (:) = kk%XALBUV_DRY (:) / 2.
!
IF (lhook) CALL dr_hook('DRY_WET_SOIL_ALBEDOS',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE dry_wet_soil_albedos