isba_albedo.F90 Source File


Contents

Source Code


Source Code

!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 version 2.1
!SFX_LIC version 1. See LICENSE, Licence_CeCILL_V2.1-en.txt and Licence_CeCILL_V2.1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE ISBA_ALBEDO(PEK, OTR_ML, OMEB, PDIR_SW, PSCA_SW, PSW_BANDS, KSW, &
                             PFALB, PFFV, PFFG, PGLOBAL_SW,           &
                             PMEB_SCA_SW, PALBNIR_TVEG, PALBVIS_TVEG,               &
                             PALBNIR_TSOIL, PALBVIS_TSOIL               )
!     ##########################################################################
!
!!****  *ISBA_ALBEDO*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates grid-averaged albedo and emissivity (according to snow scheme)
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!	S. Belair           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    
!!      P. Samuelsson  02/2012  MEB
!!
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE MODD_ISBA_n, ONLY : ISBA_PE_t
!
USE MODD_SURF_PAR,     ONLY : XUNDEF
!
USE MODI_ALBEDO_FROM_NIR_VIS
!
!
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE PARKIND1  ,ONLY : JPRB
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
LOGICAL,              INTENT(IN)   :: OTR_ML
LOGICAL,              INTENT(IN)   :: OMEB        ! True = patch with multi-energy balance 
!                                                 ! False = patch with classical ISBA
!
REAL, DIMENSION(:,:), INTENT(IN)   :: PDIR_SW            ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN)   :: PSCA_SW            ! diffus incoming solar radiation
REAL, DIMENSION(:)  , INTENT(IN)   :: PSW_BANDS          ! mean wavelength of each shortwave band (m)
INTEGER,              INTENT(IN)   :: KSW                ! number of short-wave spectral bands
!
TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
!
REAL, DIMENSION(:)  , INTENT(IN)   :: PFALB              ! Floodplain albedo
REAL, DIMENSION(:)  , INTENT(IN)   :: PFFV               ! Floodplain fraction over vegetation
REAL, DIMENSION(:)  , INTENT(IN)   :: PFFG               ! Floodplain fraction over the ground
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: PGLOBAL_SW         ! global incoming SW rad.
REAL, DIMENSION(:)  , INTENT(OUT)  :: PMEB_SCA_SW        ! diffuse incoming SW rad.
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TVEG       ! nearIR  veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TVEG       ! visible veg tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBNIR_TSOIL      ! nearIR  soil tot albedo
REAL, DIMENSION(:)  , INTENT(OUT)  :: PALBVIS_TSOIL      ! visible soil tot albedo
!
!-------------------------------------------------------------------------------
!
!*      0.     Local variables
!              ---------------
!
INTEGER                          :: JLAYER
INTEGER                          :: JSWB
REAL, DIMENSION(SIZE(PEK%XALBNIR))      :: ZSW_UP
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZDIR_ALB_WITHOUT_SNOW
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZSCA_ALB_WITHOUT_SNOW
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZDIR_ALB_VEG_WITHOUT_SNOW
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZSCA_ALB_VEG_WITHOUT_SNOW
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZDIR_ALB_SOIL_WITHOUT_SNOW
REAL, DIMENSION(SIZE(PEK%XALBNIR),KSW)  :: ZSCA_ALB_SOIL_WITHOUT_SNOW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!*      2.     Compute snow-free albedo
!              ------------------------
!
!* Snow-free surface albedo for each wavelength
!
IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',0,ZHOOK_HANDLE)
!
IF (OTR_ML )THEN
  IF (OMEB) THEN
    PALBNIR_TVEG (:) =               PEK%XALBNIR_VEG(:)
    PALBNIR_TSOIL(:) = ( 1.-PFFG(:))*PEK%XALBNIR_SOIL(:) + PFFG(:)*PFALB(:)   
    PALBVIS_TVEG (:) =               PEK%XALBVIS_VEG(:)
    PALBVIS_TSOIL(:) = ( 1.-PFFG(:))*PEK%XALBVIS_SOIL(:) + PFFG(:)*PFALB(:)
  ELSE
    PALBNIR_TVEG (:) = PEK%XALBNIR_VEG(:)
    PALBNIR_TSOIL(:) = PEK%XALBNIR_SOIL(:) 
    PALBVIS_TVEG (:) = PEK%XALBVIS_VEG(:)
    PALBVIS_TSOIL(:) = PEK%XALBVIS_SOIL(:) 
  ENDIF
ELSE
  PALBNIR_TVEG (:) = XUNDEF
  PALBNIR_TSOIL(:) = XUNDEF
  PALBVIS_TVEG (:) = XUNDEF
  PALBVIS_TSOIL(:) = XUNDEF
ENDIF
!
 CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS, PEK%XALBNIR(:), PEK%XALBVIS(:), PEK%XALBUV(:),  &
                           ZDIR_ALB_WITHOUT_SNOW, ZSCA_ALB_WITHOUT_SNOW )  
!
!* total shortwave incoming radiation
!
PGLOBAL_SW (:) = 0.
PMEB_SCA_SW(:) = 0.
DO JSWB=1,KSW
  PGLOBAL_SW (:) = PGLOBAL_SW(:) + (PDIR_SW(:,JSWB) + PSCA_SW(:,JSWB))
  PMEB_SCA_SW(:) = PMEB_SCA_SW(:) + (PSCA_SW(:,JSWB))
END DO
!
!* snow-free global albedo (needed by ISBA)
!
ZSW_UP(:) = 0. 
DO JSWB=1,KSW
  ZSW_UP(:) =  ZSW_UP(:)                                       &
               + ZDIR_ALB_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
               + ZSCA_ALB_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
END DO
PEK%XSNOWFREE_ALB(:) = XUNDEF
WHERE(PGLOBAL_SW(:)>0.)  
  PEK%XSNOWFREE_ALB(:) = ZSW_UP(:) / PGLOBAL_SW(:)
ELSEWHERE
  PEK%XSNOWFREE_ALB(:) = ZDIR_ALB_WITHOUT_SNOW(:,1)
END WHERE
!
IF(PEK%TSNOW%SCHEME == 'EBA') THEN
  CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,            &
            PEK%XALBNIR_VEG(:), PEK%XALBVIS_VEG(:), PEK%XALBUV_VEG(:), &
            ZDIR_ALB_VEG_WITHOUT_SNOW, ZSCA_ALB_VEG_WITHOUT_SNOW )  
  ZSW_UP(:) = 0.
  DO JSWB=1,KSW
     ZSW_UP(:) =  ZSW_UP(:)                                           &
                  + ZDIR_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
                  + ZSCA_ALB_VEG_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
  END DO
  PEK%XSNOWFREE_ALB_VEG(:) = XUNDEF
  WHERE(PGLOBAL_SW(:)>0.)  PEK%XSNOWFREE_ALB_VEG(:) = ZSW_UP(:) / PGLOBAL_SW(:)
!
  CALL ALBEDO_FROM_NIR_VIS(PSW_BANDS,               &
            PEK%XALBNIR_SOIL(:), PEK%XALBVIS_SOIL(:), PEK%XALBUV_SOIL(:), &
            ZDIR_ALB_SOIL_WITHOUT_SNOW, ZSCA_ALB_SOIL_WITHOUT_SNOW    )  
  ZSW_UP(:) = 0.
  DO JSWB=1,KSW
    ZSW_UP(:) =  ZSW_UP(:)                                            &
               + ZDIR_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PDIR_SW(:,JSWB) &
               + ZSCA_ALB_SOIL_WITHOUT_SNOW(:,JSWB) * PSCA_SW(:,JSWB)  
  END DO
  PEK%XSNOWFREE_ALB_SOIL(:) = XUNDEF
  WHERE(PGLOBAL_SW(:)>0.)  PEK%XSNOWFREE_ALB_SOIL(:) = ZSW_UP(:) / PGLOBAL_SW(:)             
ENDIF
!
IF (LHOOK) CALL DR_HOOK('ISBA_ALBEDO',1,ZHOOK_HANDLE)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE ISBA_ALBEDO