flake_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 flake_albedo( PDIR_SW   , PSCA_SW , KSW,      &
                               pdir_alb  , psca_alb,           &
                               pglobal_sw, palb                )
!     ##########################################################################
!
!!****  *FLAKE_ALBEDO*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates  albedo and emissivity 
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!      P. Le Moigne           * Meteo-France *
!!
!!      Modified by P. Le Moigne - 10/2013 : bug in ZSW_UP declaration
!-------------------------------------------------------------------------------
!
!*       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
!
REAL, DIMENSION(:,:), INTENT(IN)   :: pdir_sw            ! direct incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN)   :: psca_sw            ! diffuse incoming solar radiation
REAL, DIMENSION(:,:), INTENT(IN)   :: pdir_alb           ! direct  albedo
REAL, DIMENSION(:,:), INTENT(IN)   :: psca_alb           ! diffuse albedo
INTEGER,              INTENT(IN)   :: ksw                ! number of short-wave spectral bands
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: pglobal_sw         ! global incoming SW rad.
REAL, DIMENSION(:)  , INTENT(OUT)  :: palb               ! albedo 
!
!-------------------------------------------------------------------------------
!
!*      0.     Local variables
!              ---------------
!
INTEGER                          :: jswb
REAL, DIMENSION(SIZE(PDIR_SW,1)) :: zsw_up
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!*      1.     surface albedo for each wavelength
!              ----------------------------------
!
IF (lhook) CALL dr_hook('FLAKE_ALBEDO',0,zhook_handle)
!
!* total shortwave incoming radiation
!
  pglobal_sw(:) = 0.
  DO jswb=1,ksw
    pglobal_sw(:) = pglobal_sw(:) + (pdir_sw(:,jswb) + psca_sw(:,jswb))
  END DO
!
!* total shortwave upcoming radiation
!
  zsw_up(:) = 0. 
  DO jswb=1,ksw
    zsw_up(:) =  zsw_up(:)                            &
                 + pdir_alb(:,jswb) * pdir_sw(:,jswb) &
                 + psca_alb(:,jswb) * psca_sw(:,jswb)  
  END DO
!
!* global albedo
!
  WHERE(pglobal_sw(:)>0.)  
       palb(:) = zsw_up(:) / pglobal_sw(:)
  ELSEWHERE
       palb(:) = pdir_alb(:,1)
  END WHERE
!
IF (lhook) CALL dr_hook('FLAKE_ALBEDO',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE flake_albedo