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.
!      ###########
MODULE modi_soil_albedo
!      ###########
!
INTERFACE soil_albedo
!
!
      SUBROUTINE soil_albedo_1d(HALBEDO,                             &
                             pwsat,pwg1,                               &
                             palbvis_dry,palbnir_dry,palbuv_dry,       &
                             palbvis_wet,palbnir_wet,palbuv_wet,       &
                             palbvis_soil, palbnir_soil,palbuv_soil    )  
!
!
!*      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
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_dry ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_dry ! dry soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_dry  ! 
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_wet ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_wet ! wet soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_wet  ! wet soil albedo
!
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbnir_soil! soil albedo
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbuv_soil !
!
END SUBROUTINE soil_albedo_1d
!
      SUBROUTINE soil_albedo_1d_patch(HALBEDO,                       &
                             pwsat,pwg1,                               &
                             palbvis_dry,palbnir_dry,palbuv_dry,       &
                             palbvis_wet,palbnir_wet,palbuv_wet,       &
                             palbvis_soil, palbnir_soil,palbuv_soil    )  
!
!
!*      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
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_dry ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_dry ! dry soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_dry  !
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_wet ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_wet ! wet soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_wet  !
!
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbnir_soil! soil albedo
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbuv_soil !
!
END SUBROUTINE soil_albedo_1d_patch
!
END INTERFACE
!
END MODULE modi_soil_albedo
!
!     ####################################################################
      SUBROUTINE soil_albedo_1d(HALBEDO,                             &
                             pwsat,pwg1,                               &
                             palbvis_dry,palbnir_dry,palbuv_dry,       &
                             palbvis_wet,palbnir_wet,palbuv_wet,       &
                             palbvis_soil, palbnir_soil,palbuv_soil    )  
!     ####################################################################
!
!!****  *SOIL_ALBEDO*  
!!
!!    PURPOSE
!!    -------
!       computes the SOIL ALBEDO of the 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
!!    ------
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    17/12/99 
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
!
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
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_dry ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_dry ! dry soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_dry  !
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_wet ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_wet ! wet soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_wet  !
!
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbnir_soil! soil albedo
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: palbuv_soil !
!
!*      0.2    declarations of local variables
!              -------------------------------
!
REAL, DIMENSION(SIZE(PWSAT)) :: zx
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
SELECT CASE ( halbedo )
  CASE ('EVOL')
!
       zx = min( pwg1(:)/pwsat(:) , 1. ) 
!
!* linear formula
!      ZALBVIS_SOIL(:) = PALBVIS_DRY(:) + ZX(:)*(PALBVIS_WET(:)-PALBVIS_DRY(:))
!      ZALBNIR_SOIL(:) = PALBNIR_DRY(:) + ZX(:)*(PALBNIR_WET(:)-PALBNIR_DRY(:))
!      ZALBUV_SOIL (:) = PALBUV_DRY (:) + ZX(:)*(PALBUV_WET (:)-PALBUV_DRY (:))
!* quadratic formula
      IF (present(palbvis_soil))        &
        palbvis_soil(:) = palbvis_wet(:)                                    &
                        + (0.25*palbvis_dry(:)-palbvis_wet(:))              &
                         * (1. - zx(:))                                     &
                         * ( zx(:) + (     palbvis_dry(:)-palbvis_wet(:))   &
                                    /(0.25*palbvis_dry(:)-palbvis_wet(:)) )  
      IF (present(palbnir_soil))        &                                    
        palbnir_soil(:) = palbnir_wet(:)                                    &
                        + (0.25*palbnir_dry(:)-palbnir_wet(:))              &
                         * (1. - zx(:))                                     &
                         * ( zx(:) + (     palbnir_dry(:)-palbnir_wet(:))   &
                                    /(0.25*palbnir_dry(:)-palbnir_wet(:)) )  
      IF (present(palbuv_soil))        &                                    
        palbuv_soil(:) = palbuv_wet(:)                                     &
                        + (0.25*palbuv_dry(:)-palbuv_wet(:))              &
                         * (1. - zx(:))                                     &
                         * ( zx(:) + (     palbuv_dry(:)-palbuv_wet(:))   &
                                    /(0.25*palbuv_dry(:)-palbuv_wet(:)) )  
!
  CASE ('DRY ')
      IF (present(palbvis_soil)) palbvis_soil(:) = palbvis_dry(:)
      IF (present(palbnir_soil)) palbnir_soil(:) = palbnir_dry(:)
      IF (present(palbuv_soil)) palbuv_soil(:) = palbuv_dry(:)
  CASE ('WET ')
      IF (present(palbvis_soil)) palbvis_soil(:) = palbvis_wet(:)
      IF (present(palbnir_soil)) palbnir_soil(:) = palbnir_wet(:)
      IF (present(palbuv_soil)) palbuv_soil(:) = palbuv_wet(:)
  CASE ('MEAN')
      IF (present(palbvis_soil)) palbvis_soil(:) = 0.5 * ( palbvis_dry(:) + palbvis_wet(:) )
      IF (present(palbnir_soil)) palbnir_soil(:) = 0.5 * ( palbnir_dry(:) + palbnir_wet(:) )
      IF (present(palbuv_soil)) palbuv_soil(:) = 0.5 * ( palbuv_dry(:) + palbuv_wet(:) )
END SELECT
IF (lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE soil_albedo_1d
!
!-------------------------------------------------------------------------------
!
!     ####################################################################
      SUBROUTINE soil_albedo_1d_patch(HALBEDO,                       &
                             pwsat,pwg1,                               &
                             palbvis_dry,palbnir_dry,palbuv_dry,       &
                             palbvis_wet,palbnir_wet,palbuv_wet,       &
                             palbvis_soil, palbnir_soil,palbuv_soil    )  
!     ####################################################################
!
!!****  *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_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
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_dry ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_dry ! dry soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_dry  !
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_wet ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_wet ! wet soil SOIL_ALBEDO
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_wet  !
!
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbnir_soil! soil albedo
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: palbuv_soil !
!
!*      0.2    declarations of local variables
!              -------------------------------
!
REAL,    DIMENSION(SIZE(PWSAT)) :: zx
!
INTEGER :: ipatch     ! number of patches
INTEGER :: jpatch     !loop index for patches
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
ipatch = SIZE(pwg1,2)

IF (present(palbvis_soil)) palbvis_soil = xundef
IF (present(palbnir_soil)) palbnir_soil = xundef
IF (present(palbuv_soil)) palbuv_soil  = xundef
!
SELECT CASE ( halbedo )
 CASE ('EVOL')

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

    !WHERE (PWG1(:,JPATCH)/=XUNDEF)
      !* linear formula
      !      ZALBVIS_SOIL(:) = PALBVIS_DRY(:) + ZX(:)*(PALBVIS_WET(:)-PALBVIS_DRY(:))
      !      ZALBNIR_SOIL(:) = PALBNIR_DRY(:) + ZX(:)*(PALBNIR_WET(:)-PALBNIR_DRY(:))
      !      ZALBUV_SOIL (:) = PALBUV_DRY (:) + ZX(:)*(PALBUV_WET (:)-PALBUV_DRY (:))
      !* quadratic formula
      IF (present(palbvis_soil)) &
        WHERE (pwg1(:,jpatch)/=xundef) &
          palbvis_soil(:,jpatch) = palbvis_wet(:)             &
             + (0.25*palbvis_dry(:)-palbvis_wet(:))           &
             * (1. - zx(:))                                   &
             * ( zx(:) + (     palbvis_dry(:)-palbvis_wet(:)) &
             /(0.25*palbvis_dry(:)-palbvis_wet(:)) )  
      IF (present(palbnir_soil))  &     
        WHERE (pwg1(:,jpatch)/=xundef) &      
        palbnir_soil(:,jpatch) = palbnir_wet(:)               &
             + (0.25*palbnir_dry(:)-palbnir_wet(:))           &
             * (1. - zx(:))                                   &
             * ( zx(:) + (     palbnir_dry(:)-palbnir_wet(:)) &
             /(0.25*palbnir_dry(:)-palbnir_wet(:)) )  
      IF (present(palbuv_soil))  &   
        WHERE (pwg1(:,jpatch)/=xundef) &      
        palbuv_soil(:,jpatch) = palbuv_wet(:)               &
             + (0.25*palbuv_dry(:)-palbuv_wet(:))           &
             * (1. - zx(:))                                   &
             * ( zx(:) + (     palbuv_dry(:)-palbuv_wet(:)) &
             /(0.25*palbuv_dry(:)-palbuv_wet(:)) )  

    !END WHERE
  END DO

 CASE ('DRY ')
  IF (present(palbvis_soil)) palbvis_soil(:,:) = spread(palbvis_dry(:),2,ipatch)
  IF (present(palbnir_soil)) palbnir_soil(:,:) = spread(palbnir_dry(:),2,ipatch)
  IF (present(palbuv_soil)) palbuv_soil(:,:) = spread(palbuv_dry(:),2,ipatch)

 CASE ('WET ')
  IF (present(palbvis_soil)) palbvis_soil(:,:) = spread(palbvis_wet(:),2,ipatch)
  IF (present(palbnir_soil)) palbnir_soil(:,:) = spread(palbnir_wet(:),2,ipatch)
  IF (present(palbuv_soil)) palbuv_soil(:,:) = spread(palbuv_wet(:),2,ipatch)

 CASE ('MEAN')
  IF (present(palbvis_soil))  palbvis_soil(:,:) = 0.5 * ( spread(palbvis_dry(:),2,ipatch) + spread(palbvis_wet(:),2,ipatch) )
  IF (present(palbnir_soil)) palbnir_soil(:,:) = 0.5 * ( spread(palbnir_dry(:),2,ipatch) + spread(palbnir_wet(:),2,ipatch) )
  IF (present(palbuv_soil)) palbuv_soil(:,:) = 0.5 * ( spread(palbuv_dry(:),2,ipatch) + spread(palbuv_wet(:),2,ipatch) )

END SELECT
IF (lhook) CALL dr_hook('MODI_SOIL_ALBEDO:SOIL_ALBEDO_1D_PATCH',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE soil_albedo_1d_patch