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_albedo
!      ###########
!
INTERFACE albedo
!
!
      SUBROUTINE albedo_1d(HALBEDO,                                      &
                             palbvis_veg,palbnir_veg,palbuv_veg,pveg,      &
                             palbvis_soil,palbnir_soil,palbuv_soil,        &
                             palbvis_eco ,palbnir_eco, palbuv_eco,         &
                             psnow, omask                                  )  
!
!
!*      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
!
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_veg ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_veg ! albedo of the vegetation
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_veg  !
REAL, DIMENSION(:), INTENT(IN)  :: pveg        ! fraction of vegetation
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_soil! soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_soil !
!
REAL, DIMENSION(:), INTENT(INOUT) :: palbvis_eco ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(INOUT) :: palbnir_eco ! averaged albedo
REAL, DIMENSION(:), INTENT(INOUT) :: palbuv_eco  !
REAL,    DIMENSION(:), INTENT(IN), OPTIONAL  :: psnow ! fraction of permanent snow and ice
LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL  :: omask ! mask where computations are done
!
END SUBROUTINE albedo_1d
!
!
      SUBROUTINE albedo_1d_patch(HALBEDO,                                &
                             palbvis_veg,palbnir_veg,palbuv_veg,pveg,      &
                             palbvis_soil,palbnir_soil,palbuv_soil,        &
                             palbvis_eco ,palbnir_eco, palbuv_eco,         &
                             pvegtype, omask                               )  
!
!
!*      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
!
REAL, DIMENSION(:,:), INTENT(IN)  :: palbvis_veg ! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(IN)  :: palbnir_veg ! albedo of the vegetation
REAL, DIMENSION(:,:), INTENT(IN)  :: palbuv_veg  !
REAL, DIMENSION(:,:), INTENT(IN)  :: pveg        ! fraction of vegetation
REAL, DIMENSION(:,:), INTENT(IN)  :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(IN)  :: palbnir_soil! soil albedo
REAL, DIMENSION(:,:), INTENT(IN)  :: palbuv_soil !
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbvis_eco ! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbnir_eco ! averaged albedo
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbuv_eco  !
REAL,    DIMENSION(:,:), INTENT(IN), OPTIONAL :: pvegtype ! vegetation type
LOGICAL, DIMENSION(:),   INTENT(IN), OPTIONAL :: omask    ! mask where computations are done
!
END SUBROUTINE albedo_1d_patch
!
END INTERFACE
!
END MODULE modi_albedo
!
!     ####################################################################
      SUBROUTINE albedo_1d(HALBEDO,                                      &
                             palbvis_veg,palbnir_veg,palbuv_veg,pveg,      &
                             palbvis_soil,palbnir_soil,palbuv_soil,        &
                             palbvis_eco ,palbnir_eco, palbuv_eco,         &
                             psnow, omask                                  )  
!     ####################################################################
!
!!****  *ALBEDO*  
!!
!!    PURPOSE
!!    -------
!       computes the albedo of the 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
!!    ------
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    17/12/99 
!!                  01/2004  Externalization (V. Masson)
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_snow_par, ONLY : xansmax
!
!
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
!
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_veg ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_veg ! albedo of the vegetation
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_veg  !
REAL, DIMENSION(:), INTENT(IN)  :: pveg        ! fraction of vegetation
REAL, DIMENSION(:), INTENT(IN)  :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(IN)  :: palbnir_soil! soil albedo
REAL, DIMENSION(:), INTENT(IN)  :: palbuv_soil !
!
REAL, DIMENSION(:), INTENT(INOUT) :: palbvis_eco ! visible, near infra-red and UV
REAL, DIMENSION(:), INTENT(INOUT) :: palbnir_eco ! averaged albedo
REAL, DIMENSION(:), INTENT(INOUT) :: palbuv_eco  !
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
!              -------------------------------
!
REAL, DIMENSION(SIZE(PVEG)) :: zsnow
LOGICAL, DIMENSION(SIZE(PVEG)) :: gmask
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
gmask=.true.
IF (present(omask)) gmask=omask
!
zsnow(:) = 0.
IF (present(psnow)) zsnow(:) = psnow(:)
!
WHERE (gmask(:)) 
  palbvis_eco(:) = ( (1.-pveg(:)) * palbvis_soil(:) &
                       +    pveg(:)  * palbvis_veg(:))&
                     * (1-zsnow(:))                    &
                    + xansmax  * zsnow(:)    
!
  palbnir_eco(:) = ( (1.-pveg(:)) * palbnir_soil(:) &
                       +    pveg(:)  * palbnir_veg(:))&
                     * (1-zsnow(:))                    &
                    + xansmax  * zsnow(:)    
!
  palbuv_eco(:)  = ( (1.-pveg(:)) * palbuv_soil(:)  &
                       +    pveg(:)  * palbuv_veg(:)) &
                     * (1-zsnow(:))                    &
                    + xansmax  * zsnow(:)    
END WHERE
IF (lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE albedo_1d
!
!     ####################################################################
      SUBROUTINE albedo_1d_patch(HALBEDO,                                &
                             palbvis_veg,palbnir_veg,palbuv_veg,pveg,      &
                             palbvis_soil,palbnir_soil,palbuv_soil,        &
                             palbvis_eco ,palbnir_eco, palbuv_eco,         &
                             pvegtype, 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_data_cover_par, ONLY : nvt_snow
USE modd_snow_par,       ONLY : xansmax
USE modd_surf_par,       ONLY : xundef
!
USE modi_vegtype_to_patch
USE modi_surf_patch
!
!
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
!
REAL, DIMENSION(:,:), INTENT(IN)  :: palbvis_veg ! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(IN)  :: palbnir_veg ! albedo of the vegetation
REAL, DIMENSION(:,:), INTENT(IN)  :: palbuv_veg  !
REAL, DIMENSION(:,:), INTENT(IN)  :: pveg        ! fraction of vegetation
REAL, DIMENSION(:,:), INTENT(IN)  :: palbvis_soil! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(IN)  :: palbnir_soil! soil albedo
REAL, DIMENSION(:,:), INTENT(IN)  :: palbuv_soil !
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbvis_eco ! visible, near infra-red and UV
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbnir_eco ! averaged albedo
REAL, DIMENSION(:,:), INTENT(INOUT) :: palbuv_eco  !
REAL,    DIMENSION(:,:), INTENT(IN), OPTIONAL :: pvegtype ! vegetation type
LOGICAL, DIMENSION(:),   INTENT(IN), OPTIONAL :: omask    ! mask where computations are done
!
!
!*      0.2    declarations of local variables
!              -------------------------------
!
LOGICAL, DIMENSION(SIZE(PVEG,1)) :: gmask
!
REAL, DIMENSION(SIZE(PVEG,1),SIZE(PVEG,2))  ::zpatch, zsnowpatch 
INTEGER :: isnowpatch !patch index for snow 
INTEGER :: ipatch     ! number of patches
INTEGER :: jpatch     !loop index for patches
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D_PATCH',0,zhook_handle)
IF (halbedo=='USER' .AND. lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D_PATCH',1,zhook_handle)
IF (halbedo=='USER') RETURN
!
gmask(:) = .true.
IF (present(omask)) gmask(:) = omask(:)
!
ipatch = SIZE(pveg,2)

DO jpatch=1,ipatch
  WHERE (gmask(:))
    palbvis_eco(:,jpatch) = xundef
    palbnir_eco(:,jpatch) = xundef
    palbuv_eco(:,jpatch) = xundef
  END WHERE
END DO
!
!
!
zsnowpatch(:,:) =0.
!
IF (present(pvegtype)) THEN
  ! calculation of patch surfaces  (weights for average)
  CALL surf_patch(ipatch,pvegtype,zpatch)
  ! permanent snow fraction in the corresponding patch
  isnowpatch= vegtype_to_patch(nvt_snow,ipatch)
  WHERE(gmask(:) .AND. zpatch(:,isnowpatch)>0.)
    zsnowpatch(:,isnowpatch)=pvegtype(:,nvt_snow)/zpatch(:,isnowpatch)
  END WHERE
END IF
!

DO jpatch=1,ipatch
  WHERE (gmask(:) .AND. pveg(:,jpatch)/=xundef)

    palbvis_eco(:,jpatch) =(  (1.-pveg(:,jpatch)) * palbvis_soil(:,jpatch)  &
           +    pveg(:,jpatch)  * palbvis_veg(:,jpatch))                      &
           * (1-zsnowpatch(:,jpatch))                                          &
           + xansmax  * zsnowpatch(:,jpatch)   
    !
    palbnir_eco(:,jpatch) =(  (1.-pveg(:,jpatch)) * palbnir_soil(:,jpatch)  &
           +      pveg(:,jpatch)  * palbnir_veg(:,jpatch))                    &
           * (1-zsnowpatch(:,jpatch))                                          &
           + xansmax  * zsnowpatch(:,jpatch)   
    !
    palbuv_eco(:,jpatch) =(  (1.-pveg(:,jpatch)) * palbuv_soil(:,jpatch)  &
           +      pveg(:,jpatch)  * palbuv_veg(:,jpatch))                    &
           * (1-zsnowpatch(:,jpatch))                                          &
           + xansmax  * zsnowpatch(:,jpatch)   
  END WHERE
END DO
IF (lhook) CALL dr_hook('MODI_ALBEDO:ALBEDO_1D_PATCH',1,zhook_handle)
!-------------------------------------------------------------------------------
!
END SUBROUTINE albedo_1d_patch