update_esm_flaken.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_flake_n (F, &
                                     ki,ksw,pzenith,pdir_alb,     &
                                    psca_alb,pemis,ptsrad,ptsurf )
!     ############################################################
!
!!****  *UPDATE_ESM_FLAKE_n* -   routine to update FLAKE 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    04/2013
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_flake_n, ONLY : flake_t
!
USE modd_csts,           ONLY : xtt
USE modd_surf_par,       ONLY : xundef
!                                
USE modi_update_rad_flake
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(flake_t), INTENT(INOUT) :: f
!
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    ! effective temperature
REAL(KIND=JPRB) :: zhook_handle
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
!-------------------------------------------------------------------------------
!
!
!*            Albedo and emissivity on open sea and sea ice
!             ---------------------------------------------
!
IF (lhook) CALL dr_hook('UPDATE_ESM_FLAKE_N',0,zhook_handle)
!
 CALL update_rad_flake(f%CFLK_ALB,f%XTS,pzenith,f%XH_ICE,f%XH_SNOW,f%XICE_ALB,f%XSNOW_ALB,&
                       f%XDIR_ALB,f%XSCA_ALB,f%XEMIS,pdir_alb,psca_alb,pemis,ptsrad )
!
ptsurf(:) = f%XTS(:)
!                         
IF (lhook) CALL dr_hook('UPDATE_ESM_FLAKE_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE update_esm_flake_n