update_rad_sea.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 update_rad_sea(HALB,PSST,PZENITH,PTT,PEMIS,PDIR_ALB,PSCA_ALB,  &
                          pdir_alb_atmos,psca_alb_atmos,pemis_atmos,ptrad,&
                          ohandle_sic,ptice,psic,pice_alb,pu,pv           )  
!     #######################################################################
!
!!****  *UPDATE_RAD_SEA * - update the radiative properties at time t+1 (see by the atmosphere) 
!                           in order to close the energy budget between surfex and the atmosphere
 
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     B. Decharme 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!!      Modified    03/2011 : E. Bazile (MK10) albedo from Marat Khairoutdinov
!!      Modified    01/2014 : S. Senesi : handle fractional seaice
!!      Modified    02/2014 : split from update_rad_seawat.F90
!!      Modified    01/2015 : introduce interactive ocean surface albedo (R.Séférian)
!!------------------------------------------------------------------
!
USE modd_water_par, ONLY : xemiswat, xemiswatice, &
                           xalbwat, xalbsca_wat,  &
                           xalbseaice
!
USE modd_sfx_oasis, ONLY : lcpl_sea
!
USE modi_albedo_ta96
USE modi_albedo_mk10
USE modi_albedo_rs14
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
 CHARACTER(LEN=4),       INTENT(IN)  :: halb
!
REAL, DIMENSION(:),     INTENT(IN)   :: psst      ! Sea surface temperature
REAL, DIMENSION(:),     INTENT(IN)   :: pzenith   ! Zenithal angle at t+1
REAL,                   INTENT(IN)   :: ptt       ! Sea/ice transition temperature (different according to sea or inland water)
!
REAL, DIMENSION(:),     INTENT(INOUT):: pdir_alb  ! Direct albedo at t+1 for the mix (open sea, seaice)
REAL, DIMENSION(:),     INTENT(INOUT):: psca_alb  ! Diffuse albedo at t+1 for the mix (open sea, seaice)
REAL, DIMENSION(:),     INTENT(OUT)  :: pemis     ! emissivity (sea water + sea ice) at t+1
!
REAL, DIMENSION(:,:),   INTENT(OUT)  :: pdir_alb_atmos ! Direct albedo at t+1 for the atmosphere
REAL, DIMENSION(:,:),   INTENT(OUT)  :: psca_alb_atmos ! Diffuse albedo at t+1 for the atmosphere
REAL, DIMENSION(:),     INTENT(OUT)  :: pemis_atmos    ! Emissivity at t+1 for the atmosphere
REAL, DIMENSION(:),     INTENT(OUT)  :: ptrad          ! radiative temp at t+1 for the atmosphere
!
LOGICAL,                INTENT(IN)   , OPTIONAL :: ohandle_sic ! Do we weight seaice and open sea fluxes
REAL, DIMENSION(:),     INTENT(IN)   , OPTIONAL :: ptice     ! Seaice surface temperature
REAL, DIMENSION(:),     INTENT(IN)   , OPTIONAL :: psic      ! Seaice cover
REAL, DIMENSION(:),     INTENT(IN)   , OPTIONAL :: pice_alb  ! Seaice albedo
REAL, DIMENSION(:),     INTENT(IN)   , OPTIONAL :: pu        ! zonal wind (m/s)
REAL, DIMENSION(:),     INTENT(IN)   , OPTIONAL :: pv        ! meridian wind (m/s)
!
!*      0.2    declarations of local variables
!
INTEGER :: jswb
REAL, DIMENSION(SIZE(PZENITH)) :: zalbdir
REAL, DIMENSION(SIZE(PZENITH)) :: zalbsca
REAL, DIMENSION(SIZE(PZENITH)) :: zwind
LOGICAL :: ghandle_sic
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('UPDATE_RAD_SEA',0,zhook_handle)
!
zalbdir(:) = 0.
zalbsca(:) = 0.
!
IF (halb=='TA96') THEN
!        
  zalbdir(:) = albedo_ta96(pzenith(:))
  zalbsca(:) = xalbsca_wat
!  
ELSEIF (halb=='MK10') THEN
!        
  zalbdir(:) = albedo_mk10(pzenith(:))
  zalbsca(:) = xalbsca_wat
!  
ELSEIF (halb=='RS14') THEN
!        
  IF (present(pu).AND.present(pv)) THEN
     zwind(:) = sqrt(pu(:)**2+pv(:)**2)
     CALL albedo_rs14(pzenith(:),zwind(:),zalbdir(:),zalbsca(:))
  ELSE
     zalbdir(:) = pdir_alb(:)
     zalbsca(:) = psca_alb(:)
  ENDIF
!
ENDIF
!
IF (.NOT. present(ohandle_sic)) THEN 
   ghandle_sic=.false.
ELSE 
   ghandle_sic=ohandle_sic
ENDIF
!
IF(lcpl_sea)THEN !Earth System Model
!
!Sea and/or ice albedo already given by coupled seaice model
!Except for Taylor et al (1996) and MK10 formulation
!
  WHERE (psst(:)>=ptt  )
    !* open water
    pemis(:) = xemiswat
  ELSEWHERE
    !* sea ice
    pemis(:) = xemiswatice
  END WHERE
  !
  IF (halb=='TA96' .OR. halb=='MK10' .OR. halb=='RS14') THEN
    !* Taylor et al 1996
    !* open water
    WHERE (psst(:)>=ptt) pdir_alb(:) = zalbdir(:)
    WHERE (psst(:)>=ptt) psca_alb(:) = zalbsca(:)
  ENDIF
  !
ELSEIF(ghandle_sic) THEN 
  ! Returned values are an average of open sea and seaice properties
  ! weighted by the seaice cover
  pemis(:) = ( 1 - psic(:)) * xemiswat    + psic(:) * xemiswatice
  IF (halb=='UNIF') THEN
     pdir_alb(:) = ( 1 - psic(:)) * xalbwat     + psic(:) * pice_alb(:)
     psca_alb(:) = ( 1 - psic(:)) * xalbwat     + psic(:) * pice_alb(:)
  ELSE IF (halb=='TA96' .OR. halb=='MK10' .OR. halb=='RS14') THEN
     pdir_alb(:) = ( 1 - psic(:)) * zalbdir(:) + psic(:) * pice_alb(:)
     psca_alb(:) = ( 1 - psic(:)) * zalbsca(:) + psic(:) * pice_alb(:)
  ENDIF
ELSE
  !
  IF (halb=='UNIF') THEN
  !* uniform albedo
    WHERE (psst(:)>=ptt  )
    !* open water
      pdir_alb(:) = xalbwat
      psca_alb(:) = xalbwat
      pemis(:) = xemiswat
    ELSEWHERE
    !* sea ice
      pdir_alb(:) = xalbseaice
      psca_alb(:) = xalbseaice
      pemis(:) = xemiswatice
    END WHERE
  !
  ELSE IF (halb=='TA96' .OR. halb=='MK10' .OR. halb=='RS14') THEN
    !* Taylor et al 1996
    !
    WHERE (psst(:)>=ptt)
    !* open water
      pdir_alb(:) = zalbdir(:)
      psca_alb(:) = zalbsca(:)
      pemis(:) = xemiswat
    ELSEWHERE
    !* sea ice
      pdir_alb(:) = xalbseaice
      psca_alb(:) = xalbseaice
      pemis(:) = xemiswatice
    END WHERE
    !
  ENDIF
  !
ENDIF
!
!-------------------------------------------------------------------------------------
!
DO jswb=1,SIZE(pdir_alb_atmos,2)
  pdir_alb_atmos(:,jswb) = pdir_alb(:)
  psca_alb_atmos(:,jswb) = psca_alb(:)
END DO
!
pemis_atmos(:) = pemis(:)
IF(ghandle_sic) THEN 
   ptrad(:) = (((1 - psic(:)) * xemiswat    * psst(:)**4 + &
                     psic(:)  * xemiswatice * ptice(:)**4)/ &
              pemis(:)) ** 0.25
ELSE
   ptrad(:) = psst(:)
END IF
!
IF (lhook) CALL dr_hook('UPDATE_RAD_SEA',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE update_rad_sea