seaflux_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 seaflux_albedo(PDIR_SW,PSCA_SW,PDIR_ALB,PSCA_ALB,PALB)
!##########################################################################
!
!!****  *SEAFLUX_ALBEDO*  
!!
!!    PURPOSE
!!    -------
!
!     Calculates  total sea albedo 
!         
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    AUTHOR
!!    ------
!!
!!      B. Decharme           * Meteo-France *
!!
!-------------------------------------------------------------------------------
!
!*       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
!
REAL, DIMENSION(:)  , INTENT(OUT)  :: palb               ! albedo 
!
!-------------------------------------------------------------------------------
!
!*      0.     Local variables
!              ---------------
!
REAL, DIMENSION(SIZE(PDIR_SW,1)) :: zsw_up, zglobal_sw
!
INTEGER              :: ini, ji, isw, jswb
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!*      1.     surface albedo for each wavelength
!              ----------------------------------
!
IF (lhook) CALL dr_hook('SEAFLUX_ALBEDO',0,zhook_handle)
!
ini=SIZE(pdir_sw,1)
isw=SIZE(pdir_sw,2)
!
!* total shortwave incoming and upcoming radiation
!
zglobal_sw(:) = 0.
zsw_up(:) = 0.
!
DO ji=1,ini
   DO jswb=1,isw
     zglobal_sw(ji) = zglobal_sw(ji) + pdir_sw(ji,jswb) + psca_sw(ji,jswb)
     zsw_up(ji) = zsw_up(ji) + pdir_alb(ji,jswb) * pdir_sw(ji,jswb) &
                                     + psca_alb(ji,jswb) * psca_sw(ji,jswb)  
  END DO
END DO
!
!* global albedo
!
WHERE(zglobal_sw(:)>0.)  
     palb(:) = zsw_up(:) / zglobal_sw(:)
ELSEWHERE
     palb(:) = pdir_alb(:,1)
END WHERE
!
IF (lhook) CALL dr_hook('SEAFLUX_ALBEDO',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE seaflux_albedo