update_rad_flake.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_flake(HALB,PTS,PZENITH,PH_ICE,PH_SNOW,PICE_ALB,PSNOW_ALB,   &
                            pdir_alb,psca_alb,pemis,pdir_alb_atmos,psca_alb_atmos,&
                            pemis_atmos,ptrad )  
!     #######################################################################
!
!!****  *UPDATE_RAD_FLAKE * - 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    04/2013
!!------------------------------------------------------------------
!
USE modd_water_par, ONLY : xalbsca_wat, xalbwat, xemiswat, xemiswatice
!
USE modd_flake_parameters , ONLY : h_snow_min_flk, h_ice_min_flk
!
USE modd_snow_par, ONLY : xemissn
!
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
!
 CHARACTER(LEN=4),       INTENT(IN)   :: halb
!
REAL, DIMENSION(:),     INTENT(IN)   :: pts       !  surface temperature
REAL, DIMENSION(:),     INTENT(IN)   :: pzenith   ! Zenithal angle at t+1
REAL, DIMENSION(:),     INTENT(IN)   :: ph_ice    ! ice depth at t+
REAL, DIMENSION(:),     INTENT(IN)   :: ph_snow   ! snow depth at t+
REAL, DIMENSION(:),     INTENT(IN)   :: pice_alb  ! ice albedo at t+
REAL, DIMENSION(:),     INTENT(IN)   :: psnow_alb ! snow albedo at t+
!
REAL, DIMENSION(:),     INTENT(INOUT):: pdir_alb  ! Direct albedo at t+1
REAL, DIMENSION(:),     INTENT(INOUT):: psca_alb  ! Diffuse albedo at t+1
REAL, DIMENSION(:),     INTENT(OUT)  :: pemis     ! emissivity (soil+vegetation) 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
!
!*      0.2    declarations of local variables
!
INTEGER :: jswb
!
REAL, DIMENSION(SIZE(PTS)) :: zalbdir
REAL, DIMENSION(SIZE(PTS)) :: zalbsca
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('UPDATE_RAD_FLAKE',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
ELSE
  zalbdir(:) = xalbwat
  zalbsca(:) = xalbwat
ENDIF
!
WHERE (ph_snow(:)>=h_snow_min_flk)
!* snow
  pdir_alb(:) = psnow_alb(:)
  psca_alb(:) = psnow_alb(:)
  pemis(:) = xemissn
ELSEWHERE(ph_ice(:)>=h_ice_min_flk)
!* ice
  pdir_alb(:) = pice_alb(:)
  psca_alb(:) = pice_alb(:)
  pemis(:) = xemiswatice
ELSEWHERE
!* open water
  pdir_alb(:) = zalbdir(:)
  psca_alb(:) = zalbsca(:)
  pemis(:) = xemiswat    
END WHERE
!
!-------------------------------------------------------------------------------------
!
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(:)
ptrad(:) = pts(:)
!
IF (lhook) CALL dr_hook('UPDATE_RAD_FLAKE',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE update_rad_flake