albedo_rs14.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 albedo_rs14(PZENITH,PWIND,PDIR_ALB,PSCA_ALB)
!     ##################################################################
!
!!****  *ALBEDO_RS14*  
!!
!!    PURPOSE
!!    -------
!       computes the direct & diffuse albedo over open water
!
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!      
!!    AUTHOR
!!    ------
!!      R. Séférian           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    03/2014
!                   05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
!                   computation for diffuse and direct albedo
!                   09/2014 R. Séférian & B. Sunghye :: Adaptation to spectral
!                   bands compatible with 6-bands RRTM radiative code
!       
!-------------------------------------------------------------------------------
!
!*           DECLARATIONS
!            ------------
!
USE modd_albedo_rs14_par
USE modd_csts, ONLY : xpi
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!              -------------------------
!
REAL, DIMENSION(:), INTENT(IN)  :: pzenith                  ! zenithal angle (radian)
REAL, DIMENSION(:), INTENT(IN)  :: pwind                      ! surface wind (m s-1)
REAL, DIMENSION(:), INTENT(OUT) :: pdir_alb             ! direct  ocean surface albedo
REAL, DIMENSION(:), INTENT(OUT) :: psca_alb             ! diffuse ocean surface albedo
!
!*      0.2    declarations of local variables
!              -------------------------
!
REAL, DIMENSION(SIZE(PZENITH))               :: zchl             ! surface chlorophyll
REAL, DIMENSION(SIZE(PZENITH))               :: zdir_alb    ! direct  ocean surface albedo (spectral)
REAL, DIMENSION(SIZE(PZENITH))               :: zsca_alb    ! diffuse ocean surface albedo (spectral)
!
INTEGER                         :: ji, jwl                                                      ! indexes
REAL                            :: zwl                                                               ! input parameter: wavelength and diffuse/direct fraction of light
REAL:: zsig, zrefm, zxx2, zr00, zrr0, zrrr                          ! computation variables
REAL:: zr22, zue, zue2, zr11df, zalbt, zfwc                     ! computation variables
REAL:: zchlabs, zaw, zbw, zap, zylmd, zbp550                ! computation variables
REAL:: zbbp, znu, zhb                                                                     ! computation variables
REAL:: zcoszen                                                                                  ! Cosine of the zenith solar angle
REAL:: zr11, zrw, zrwdf, zrdf                                                 ! 4 components of the OSA

! 
REAL            :: zwork                                                                        ! dummy variable
! 
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ALBEDO_RS14',0,zhook_handle)
!
! Initiliazing :
!
pdir_alb(:) = 0. 
psca_alb(:) = 0. 
!
zdir_alb(:) = 0. 
zsca_alb(:) = 0.
!
!
zchl(:) = 0.05 ! averaged global values for surface chlorophyll
               ! need to include bgc coupling in earth system model configuration
!
DO jwl=1,nnwl           ! loop over the wavelength
!
  DO ji=1,SIZE(pzenith)   ! loop over the grid points
  
    !---------------------------------------------------------------------------------
    ! 0- Compute baseline values
    !---------------------------------------------------------------------------------
    ! Get refractive index for the correspoding wavelength
    zwl=xakwl(jwl)
    zrefm= xakrefm(jwl)
    !
    ! compute the cosine of the solar zenith angle
    zcoszen = max(cos(pzenith(ji)),0.)
    ! Compute sigma derived from wind speed (Cox & Munk reflectance model)
    zsig=sqrt(0.003+0.00512*pwind(ji))
    !
    !---------------------------------------------------------------------------------
    ! 1- Compute direct surface albedo (ZR11)
    !---------------------------------------------------------------------------------
    zxx2=sqrt(1.0-(1.0-zcoszen**2)/zrefm**2)
    zrr0=0.50*(((zxx2-zrefm*zcoszen)/(zxx2+zrefm*zcoszen))**2 +((zcoszen-zrefm*zxx2)/(zcoszen+zrefm*zxx2))**2)
    zrrr=0.50*(((zxx2-1.34*zcoszen)/(zxx2+1.34*zcoszen))**2 +((zcoszen-1.34*zxx2)/(zcoszen+1.34*zxx2))**2)
    zr11=zrr0-(0.0152-1.7873*zcoszen+6.8972*zcoszen**2-8.5778*zcoszen**3+4.071*zsig-7.6446*zcoszen*zsig) &
        & * exp(0.1643-7.8409*zcoszen-3.5639*zcoszen**2-2.3588*zsig+10.0538*zcoszen*zsig)*zrr0/zrrr
    ! 
    !---------------------------------------------------------------------------------
    ! 2- Compute surface diffuse albedo (ZRDF)
    !---------------------------------------------------------------------------------
    ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
    ! light (relying later on AOD)
    ! old: ZRDF=-0.1482-0.012*ZSIG+0.1609*ZREFM-0.0244*ZSIG*ZREFM ! surface diffuse (Eq 5a)
    zrdf = -0.1479 + 0.1502*zrefm - 0.0176*zsig*zrefm      ! surface diffuse (Eq 5b)
    !
    !---------------------------------------------------------------------------------
    ! *- Determine absorption and backscattering
    ! coefficients to determine reflectance below the surface (Ro) once for all
    !
    ! *.1- Absorption by chlorophyll
    zchlabs= xakachl(jwl) 
    ! *.2- Absorption by seawater 
    zaw= xakaw3(jwl) 
    ! *.3- Backscattering by seawater
    zbw= xakbw(jwl) 
    ! *.4- Backscattering by chlorophyll
    zylmd = exp(0.014*(440.0-zwl))
    zwork= exp(log(zchl(ji))*0.65)
    zap = 0.06*zchlabs*zwork +0.2*(xaw440+0.06*zwork)*zylmd
    zbp550 = 0.416 * exp(log(zchl(ji))*0.766)
   !
    IF ( zchl(ji) > 2. ) THEN
      znu=0.
    ELSE
      IF ( zchl(ji) > 0.02 ) THEN
        zwork=log10(max(min(zchl(ji),2.),0.02))
        znu=0.5*(zwork-0.3)
        zbbp=(0.002+0.01*(0.5-0.25*zwork)*(zwl/550.)**znu)*zbp550
      ELSE
        zbbp=0.019*(550./zwl)*zbp550       !ZBBPf=0.0113 at chl<=0.02
      ENDIF
    ENDIF
    !
    ! Morel-Gentili(1991), Eq (12)
    ! ZHB=h/(h+2*ZBBPf*(1.-h))        
    zhb=0.5*zbw/(0.5*zbw+zbbp)
    !
    !---------------------------------------------------------------------------------
    ! 3- Compute direct water-leaving albedo (ZRW)
    !---------------------------------------------------------------------------------
    ! Based on Morel & Gentilli 1991 parametrization
    zr22=0.48168549-0.014894708*zsig-0.20703885*zsig**2
    ! Use Morel 91 formula to compute the direct reflectance
    ! below the surface
    zr00=(0.5*zbw+zbbp)/(zaw+zap) *(0.6279-0.2227*zhb-0.0513*zhb**2 + (-0.3119+0.2465*zhb)*zcoszen)
    ! ZRW=ZR00*(1.-ZR22)*(1.-ZR11)/(1.-ZR00*ZR22)
    zrw=zr00*(1.-zr22)/(1.-zr00*zr22) ! accurate formulation
    !
    !---------------------------------------------------------------------------------
    ! 4- Compute diffuse water-leaving albedo (ZRWDF)
    !---------------------------------------------------------------------------------
    ! as previous water-leaving computation but assumes a uniform incidence of
    ! shortwave at surface (ue)
    zue=0.676               ! equivalent u_unif for diffuse incidence
    zue2=sqrt(1.0-(1.0-zue**2)/zrefm**2)
    zrr0=0.50*(((zue2-zrefm*zue)/(zue2+zrefm*zue))**2 +((zue-zrefm*zue2)/(zue+zrefm*zue2))**2)
    zrrr=0.50*(((zue2-1.34*zue)/(zue2+1.34*zue))**2 +((zue-1.34*zue2)/(zue+1.34*zue2))**2)
    zr11df=zrr0-(0.0152-1.7873*zue+6.8972*zue**2-8.5778*zue**3+4.071*zsig-7.6446*zue*zsig) &
          & * exp(0.1643-7.8409*zue-3.5639*zue**2-2.3588*zsig+10.0538*zue*zsig)*zrr0/zrrr
    ! Use Morel 91 formula to compute the diffuse
    ! reflectance below the surface
    zr00=(0.5*zbw+zbbp)/(zaw+zap) *(0.6279-0.2227*zhb-0.0513*zhb**2 + (-0.3119+0.2465*zhb)*zue)
    zrwdf=zr00*(1.-zr22)*(1.-zr11df)/(1.-zr00*zr22)
    !
    ! original : correction for foam Monahanand and Muircheartaigh (1980) Eq 16-17
    ! new: Salisbury 2014 eq(2) at 37GHz, value in fraction
    zfwc=3.97e-4*pwind(ji)**(1.59) 
    ! has to be update once we have information from wave model (discussion with G. Madec)
    !
    ! --------------------------------------------------------------------
    !  *- OSA estimation
    ! --------------------------------------------------------------------
    ! partitionning direct and diffuse albedo
    !
    zdir_alb(ji) = zdir_alb(ji) + xfrwl(jwl) *((1.-zfwc) * (zr11+zrw  ) + zfwc*xrwc(jwl))
    zsca_alb(ji) = zsca_alb(ji) + xfrwl(jwl) *((1.-zfwc) * (zrdf+zrwdf) + zfwc*xrwc(jwl))
    !
    ENDDO ! end of the loop over grid points
   !
ENDDO ! ending loop over wavelengths
!
! --------------------------------------------------------------------
!  *- OSA estimation
! --------------------------------------------------------------------
!
pdir_alb(:)=zdir_alb(:)
psca_alb(:)=zsca_alb(:)
!
IF (lhook) CALL dr_hook('ALBEDO_RS14',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE albedo_rs14