isba_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 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