update_rad_water.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_water(W,PZENITH,PTT,PDIR_ALB_ATMOS,PSCA_ALB_ATMOS,PEMIS_ATMOS,PTRAD)  
!     #######################################################################
!
!!****  *UPDATE_RAD_WATER * - 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    02/2014 : split from update_rad_seawat.F90
!!------------------------------------------------------------------
!
USE modd_watflux_n, ONLY : watflux_t
!
USE modd_water_par, ONLY : xemiswat, xemiswatice, &
                           xalbwat, xalbsca_wat,  &
                           xalbwatice
!
USE modn_sfx_oasis,  ONLY : lwater
USE modd_sfx_oasis,  ONLY : lcpl_sea
!
USE modi_albedo_ta96
USE modi_albedo_mk10
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(watflux_t), INTENT(INOUT) :: W
!
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(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
!
!*      0.2    declarations of local variables
!
INTEGER :: JSWB
REAL, DIMENSION(SIZE(W%XTS)) :: ZALBEDO
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('UPDATE_RAD_WATER',0,zhook_handle)
!
zalbedo(:) = 0.
IF (w%CWAT_ALB=='TA96') THEN
  zalbedo(:) = albedo_ta96(pzenith(:))
ELSEIF (w%CWAT_ALB=='MK10') THEN
  zalbedo(:) = albedo_mk10(pzenith(:))
ENDIF
!
IF(lcpl_sea.AND.lwater)THEN !Earth System Model
!
!Sea and/or ice albedo already given by oceanic model
!Except for Taylor et al (1996) formulation
!
  !
  WHERE (w%XTS(:)>=ptt  )
    !* open water
    w%XEMIS   (:) = xemiswat
  ELSEWHERE
    !* sea ice
    w%XEMIS   (:) = xemiswatice
  END WHERE
  !
  IF (w%CWAT_ALB=='TA96' .OR. w%CWAT_ALB=='MK10') THEN
    !* Taylor et al 1996
    !* open water
    WHERE (w%XTS(:)>=ptt) w%XDIR_ALB(:) = zalbedo(:)
    WHERE (w%XTS(:)>=ptt) w%XSCA_ALB(:) = xalbsca_wat
  ENDIF
  !
ELSE
  !
  IF (w%CWAT_ALB=='UNIF') THEN
  !* uniform albedo
    WHERE (w%XTS(:)>=ptt  )
    !* open water
      w%XDIR_ALB  (:) = xalbwat
      w%XSCA_ALB  (:) = xalbwat
      w%XEMIS     (:) = xemiswat
    ELSEWHERE
    !* sea ice
      w%XDIR_ALB(:) = xalbwatice
      w%XSCA_ALB(:) = xalbwatice
      w%XEMIS   (:) = xemiswatice
    END WHERE
  !
  ELSE IF (w%CWAT_ALB=='TA96' .OR. w%CWAT_ALB=='MK10') THEN
    !* Taylor et al 1996
    WHERE (w%XTS(:)>=ptt) w%XDIR_ALB(:) = zalbedo(:)
    !
    WHERE (w%XTS(:)>=ptt)
    !* open water
      w%XSCA_ALB  (:) = xalbsca_wat
      w%XEMIS     (:) = xemiswat
    ELSEWHERE
    !* sea ice
      w%XDIR_ALB(:) = xalbwatice
      w%XSCA_ALB(:) = xalbwatice
      w%XEMIS   (:) = xemiswatice
    END WHERE
    !
  ENDIF
  !
ENDIF
!
!-------------------------------------------------------------------------------------
!
DO jswb=1,SIZE(pdir_alb_atmos,2)
  pdir_alb_atmos(:,jswb) = w%XDIR_ALB(:)
  psca_alb_atmos(:,jswb) = w%XSCA_ALB(:)
END DO
!
pemis_atmos(:) = w%XEMIS(:)
ptrad(:) = w%XTS (:)
!
IF (lhook) CALL dr_hook('UPDATE_RAD_WATER',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE update_rad_water