update_esm_watfluxn.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_esm_watflux_n (W, &
                                       ki,ksw,pzenith,pdir_alb,     &
                                      psca_alb,pemis,ptsrad,ptsurf )
!     ##############################################################
!
!!****  *UPDATE_ESM_WATFLUX_n* - routine to update WATFLUX radiative and physical properties in
!!                               Earth System Model after the call to OASIS coupler in order 
!!                               to close the energy budget between radiative scheme and surfex
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!     B. Decharme 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!!      B. Decharme 06/2013 new coupling variables
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_watflux_n, ONLY : watflux_t
!
USE modd_csts,           ONLY : xtt
USE modd_surf_par,       ONLY : xundef
!                                
USE modi_update_rad_water
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(watflux_t), INTENT(INOUT) :: w
!
INTEGER,                            INTENT(IN)  :: ki        ! number of points
INTEGER,                            INTENT(IN)  :: ksw       ! number of short-wave spectral bands
!
REAL,             DIMENSION(KI),    INTENT(IN)  :: pzenith   ! solar zenithal angle
!
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: pdir_alb  ! direct albedo for each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: psca_alb  ! diffuse albedo for each band
REAL,             DIMENSION(KI),    INTENT(OUT) :: pemis     ! emissivity
REAL,             DIMENSION(KI),    INTENT(OUT) :: ptsrad    ! radiative temperature
REAL,             DIMENSION(KI),    INTENT(OUT) :: ptsurf    ! surface effective temperature         (K)
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!
!*            Albedo and emissivity on open sea and sea ice
!             ---------------------------------------------
!
IF (lhook) CALL dr_hook('UPDATE_ESM_WATFLUX_N',0,zhook_handle)
!
 CALL update_rad_water(w%CWAT_ALB,w%XTS,pzenith,xtt,w%XEMIS,w%XDIR_ALB,&
                      w%XSCA_ALB,pdir_alb,psca_alb,pemis,ptsrad ) 
!
ptsurf(:) = w%XTS(:)
!
IF (lhook) CALL dr_hook('UPDATE_ESM_WATFLUX_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE update_esm_watflux_n