update_rad_isban.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_isba_n (I, &
                              oflood,hsnow,pzenith,psw_bands,pveg,plai,pz0, &
                               omeb_patch,plaigv,pgndlitter,pz0litter, ph_veg, &
                               palbnir,palbvis,palbuv,pemis,               &
                               pdir_alb_with_snow,psca_alb_with_snow,pemist, &
                               pdir_sw,psca_sw,                            &
                               palbnir_veg, palbnir_soil,                  &
                               palbvis_veg, palbvis_soil                   )
!     ####################################################################
!
!!****  *UPDATE_RAD_ISBA_n * - Calculate snow/flood fraction, dir/dif albedo
!!                             and emissivity at t+1 in order to close the 
!!                             energy budget between the atmospheric model 
!!                             and surfex  
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     B. Decharme 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    09/2009
!!      P. Samuelsson 02/2012 MEB
!!      A. Boone      03/2015 MEB-use TR_ML scheme for SW radiation
!!------------------------------------------------------------------
!
!
USE modd_isba_n, ONLY : isba_t
!
USE modd_type_snow
!
USE modd_data_cover_par, ONLY : nvt_snow
!
USE modd_csts,      ONLY : xtt
USE modd_surf_par,  ONLY : xundef
USE modd_snow_par,  ONLY : xrhosmin_es,xrhosmax_es,xsnowdmin,xemissn
USE modd_water_par, ONLY : xalbsca_wat, xemiswat, xalbwatice, xemiswatice 
USE modd_meb_par,   ONLY : xsw_wght_vis, xsw_wght_nir
!
USE mode_surf_flood_frac
USE mode_surf_snow_frac      
USE mode_meb,       ONLY : meb_shield_factor, mebpalphan
!
USE modi_albedo_ta96
USE modi_albedo_from_nir_vis
USE modi_pack_same_rank
USE modi_unpack_same_rank
USE modi_isba_snow_frac
USE modi_isba_emis_meb
USE modi_radiative_transfert
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(isba_t), INTENT(INOUT) :: i
!
LOGICAL,                INTENT(IN)   :: oflood
 CHARACTER(LEN=*),       INTENT(IN)   :: hsnow
!
REAL, DIMENSION(:),     INTENT(IN)   :: pzenith   ! Zenithal angle at t+1
REAL, DIMENSION(:),     INTENT(IN)   :: psw_bands ! mean wavelength of each shortwave band (m)
REAL, DIMENSION(:,:),   INTENT(IN)   :: pveg      ! Vegetation fraction at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: plai      ! leaf area index at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: pz0       ! roughness length at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: palbnir   ! near-infra-red albedo (soil+vegetation) at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: palbvis   ! visible albedo (soil+vegetation) at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: palbuv    ! UV albedo (soil+vegetation) at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: pemis     ! emissivity (soil+vegetation) at t+1
LOGICAL, DIMENSION(:),  INTENT(IN)   :: omeb_patch  ! multi-energy balance logical vector
REAL, DIMENSION(:,:),   INTENT(IN)   :: pgndlitter  ! Ground litter fraction at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: plaigv    ! Understory leaf area index at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: pz0litter ! Ground litter roughness length at t+1
REAL, DIMENSION(:,:),   INTENT(IN)   :: ph_veg
!
REAL, DIMENSION(:,:,:), INTENT(OUT)  :: pdir_alb_with_snow ! Total direct albedo at t+1
REAL, DIMENSION(:,:,:), INTENT(OUT)  :: psca_alb_with_snow ! Total diffuse albedo at t+1
REAL, DIMENSION(:,:),   INTENT(OUT)  :: pemist             ! Total emissivity at t+1
!
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: pdir_sw   ! direct  solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: psca_sw   ! diffuse solar radiation (on horizontal surf.)
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: palbnir_veg   ! near-infra-red albedo (vegetation) at t+1
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: palbnir_soil  ! near-infra-red albedo (soil) at t+1
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: palbvis_veg   ! visible albedo (vegetation) at t+1
REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: palbvis_soil  ! visible albedo (soil) at t+1
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(I%XVEGTYPE,1),SIZE(I%XVEGTYPE,2)) :: zvegtype
!
INTEGER :: jpatch, iswb, jj
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
! Initialization
!-------------------------------------------------------------------------------------

IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N',0,zhook_handle)
iswb   = SIZE(psw_bands)
!
! Re-order VEGTYPE array to correspond with mask NR_NATURE_P:
!
zvegtype(:,:) = 0.
DO jpatch=1,i%NPATCH
   DO jj=1,i%NSIZE_NATURE_P(jpatch)
      zvegtype(jj,jpatch) = i%XVEGTYPE(i%NR_NATURE_P(jj,jpatch),jpatch)
   ENDDO
ENDDO
!
!-------------------------------------------------------------------------------------
!Patch loop
!
DO jpatch=1,i%NPATCH
  !
  IF(i%NSIZE_NATURE_P(jpatch)>0) CALL treat_nature(i%NSIZE_NATURE_P(jpatch),jpatch)
  !
ENDDO
!-------------------------------------------------------------------------------
!
!Update albedo with snow for the next time step
!
pdir_alb_with_snow(:,:,:)=i%XDIR_ALB_WITH_SNOW (:,:,:)
psca_alb_with_snow(:,:,:)=i%XSCA_ALB_WITH_SNOW (:,:,:)
!
IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N',1,zhook_handle)
!
 CONTAINS
!
SUBROUTINE treat_nature(KSIZE,KPATCH)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: ksize
INTEGER, INTENT(IN) :: kpatch
!
INTEGER             :: jp
INTEGER, DIMENSION(KSIZE) :: imask
!
REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: zlayerswe
REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: zlayerrho
REAL, DIMENSION(KSIZE,SIZE(I%TSNOW%WSNOW,2)) :: zlayerage
!
REAL, DIMENSION(KSIZE,ISWB) :: zdir_alb_with_snow
REAL, DIMENSION(KSIZE,ISWB) :: zsca_alb_with_snow
!
REAL, DIMENSION(KSIZE) :: zsnowalb          
REAL, DIMENSION(KSIZE) :: zsnowalbvis
REAL, DIMENSION(KSIZE) :: zsnowalbnir
REAL, DIMENSION(KSIZE) :: zlai             
!REAL, DIMENSION(KSIZE) :: ZLAIV             
REAL, DIMENSION(KSIZE) :: zz0               
REAL, DIMENSION(KSIZE) :: zveg
REAL, DIMENSION(KSIZE) :: zemis    
REAL, DIMENSION(KSIZE) :: zalbnir           
REAL, DIMENSION(KSIZE) :: zalbvis           
REAL, DIMENSION(KSIZE) :: zalbuv  
REAL, DIMENSION(KSIZE) :: zalbnir_veg
REAL, DIMENSION(KSIZE) :: zalbnir_soil
REAL, DIMENSION(KSIZE) :: zalbvis_veg
REAL, DIMENSION(KSIZE) :: zalbvis_soil
!
REAL, DIMENSION(KSIZE) :: zpsn
REAL, DIMENSION(KSIZE) :: zpsnv_a
REAL, DIMENSION(KSIZE) :: zpsng             
REAL, DIMENSION(KSIZE) :: zpsnv 
!
REAL, DIMENSION(KSIZE) :: zalbf
REAL, DIMENSION(KSIZE) :: zalbf_dir
REAL, DIMENSION(KSIZE) :: zalbf_sca
REAL, DIMENSION(KSIZE) :: zemisf   
REAL, DIMENSION(KSIZE) :: zff   
!
REAL, DIMENSION(KSIZE) :: zalbnir_with_snow
REAL, DIMENSION(KSIZE) :: zalbvis_with_snow
REAL, DIMENSION(KSIZE) :: zalbuv_with_snow
!
REAL, DIMENSION(KSIZE) :: zemist    
REAL, DIMENSION(KSIZE) :: zzenith
REAL, DIMENSION(KSIZE) :: zh_veg
REAL, DIMENSION(KSIZE) :: zsnowdepth, zpalphan
REAL, DIMENSION(KSIZE) :: zswup
REAL, DIMENSION(KSIZE) :: zglobal_sw
REAL, DIMENSION(KSIZE) :: zalbt
REAL, DIMENSION(KSIZE) :: zpsna, zsigma_f, zsigma_fn, zemissn
REAL, DIMENSION(KSIZE,ISWB) :: zdir_sw, zsca_sw
REAL, DIMENSION(KSIZE) :: zpermsnowfrac, zdsgrain
REAL, DIMENSION(KSIZE,3) :: zspectralalbedo
!
REAL, DIMENSION(KSIZE)            :: zlain, zalbvis_tsoil, zalbnir_tsoil    
REAL, DIMENSION(KSIZE)            :: zfapir, zfapar, zfapir_bs, zfapar_bs
REAL, DIMENSION(KSIZE,SIZE(I%XABC)) :: ziacan_sunlit, ziacan_shade, zfrac_sun, ziacan
REAL, DIMENSION(KSIZE)            :: zfaparc, zfapirc, zmus, zlai_effc
LOGICAL, DIMENSION(KSIZE)         :: gshade
!
REAL, PARAMETER :: zput0 = 0.0
INTEGER  :: jswb
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N:TREAT_NATURE',0,zhook_handle)
!
imask(:)=i%NR_NATURE_P(1:ksize,kpatch)
!
 CALL pack_same_rank(imask(:),i%TSNOW%WSNOW(:,:,kpatch),zlayerswe(:,:))
 CALL pack_same_rank(imask(:),i%TSNOW%RHO  (:,:,kpatch),zlayerrho(:,:))
!  
 CALL pack_same_rank(imask(:),i%TSNOW%ALB  (:,kpatch),zsnowalb(:))
!
IF(omeb_patch(kpatch))THEN

!  IF(NPATCH==1)THEN
!    ZDIR_SW(:,:) = PDIR_SW(:,:)
!  ELSE
!    DO JK=1,SIZE(PDIR_SW,2)
!      DO JJ=1,KSIZE
!        JI=IMASK(JJ)
!        ZDIR_SW(JJ,JK) = PDIR_SW (JI,JK)
!        ZSCA_SW(JJ,JK) = PSCA_SW (JI,JK)
!      ENDDO
!    ENDDO
!  ENDIF

  CALL pack_same_rank(imask(:),pzenith(:),       zzenith(:))
!  CALL PACK_SAME_RANK(IMASK(:),PLAIGV     (:,KPATCH),ZLAI        (:))
!  CALL PACK_SAME_RANK(IMASK(:),PLAI       (:,KPATCH),ZLAIV       (:))
!  CALL PACK_SAME_RANK(IMASK(:),PZ0LITTER  (:,KPATCH),ZZ0         (:))
!  CALL PACK_SAME_RANK(IMASK(:),PGNDLITTER (:,KPATCH),ZVEG        (:))
  zveg(:)=0. ! Set veg=0 for MEB to get bare soil conditions for snow cover and
!            ! flood fraction
  CALL pack_same_rank(imask(:),ph_veg(:,kpatch),zh_veg(:))
!
  IF(present(pdir_sw))THEN
!
    CALL pack_same_rank(imask(:),pdir_sw(:,:),     zdir_sw(:,:))
    CALL pack_same_rank(imask(:),psca_sw(:,:),     zsca_sw(:,:))
    CALL pack_same_rank(imask(:),palbnir_veg(:,kpatch),zalbnir_veg(:))
    CALL pack_same_rank(imask(:),palbnir_soil(:,kpatch),zalbnir_soil(:))
    CALL pack_same_rank(imask(:),palbvis_veg(:,kpatch),zalbvis_veg(:))
    CALL pack_same_rank(imask(:),palbvis_soil(:,kpatch),zalbvis_soil(:))
!
    CALL pack_same_rank(imask(:),i%TSNOW%AGE  (:,:,kpatch),zlayerage(:,:))
!
    CALL pack_same_rank(imask(:),i%XVEGTYPE_PATCH(:,nvt_snow,kpatch),zpermsnowfrac(:))    
!
  ENDIF
!
ELSE
!  CALL PACK_SAME_RANK(IMASK(:),PLAI       (:,KPATCH),ZLAI    (:))
!  CALL PACK_SAME_RANK(IMASK(:),PZ0        (:,KPATCH),ZZ0     (:))
  CALL pack_same_rank(imask(:),pveg(:,kpatch),zveg(:))
!  ZALBNIR_VEG(:)  = XUNDEF
!  ZALBNIR_SOIL(:) = XUNDEF
!  ZALBVIS_VEG(:)  = XUNDEF
!  ZALBVIS_SOIL(:) = XUNDEF
ENDIF
!
 CALL pack_same_rank(imask(:),plai(:,kpatch),zlai(:))
 CALL pack_same_rank(imask(:),pz0(:,kpatch),zz0(:))
 CALL pack_same_rank(imask(:),pemis(:,kpatch),zemis(:))
 CALL pack_same_rank(imask(:),palbnir(:,kpatch),zalbnir(:))
 CALL pack_same_rank(imask(:),palbvis(:,kpatch),zalbvis(:))
 CALL pack_same_rank(imask(:),palbuv(:,kpatch),zalbuv(:))
!
IF (hsnow=='3-L' .OR. hsnow=='CRO') THEN
  CALL pack_same_rank(imask(:),i%TSNOW%ALBVIS  (:,kpatch),zsnowalbvis(:))
  CALL pack_same_rank(imask(:),i%TSNOW%ALBNIR  (:,kpatch),zsnowalbnir(:))
ENDIF
!   
!-------------------------------------------------------------------------------
!
 CALL isba_snow_frac(hsnow, zlayerswe, zlayerrho, zsnowalb,    &
         zveg, zlai, zz0,zpsn(:), zpsnv_a(:), zpsng(:), zpsnv(:) )  
!
IF ( hsnow=='EBA' ) CALL unpack_same_rank(imask(:),zpsnv_a(:),i%XPSNV_A(:,kpatch),zput0) 
!
!-------------------------------------------------------------------------------
!
! Flood fractions and properties
!
IF(oflood)THEN   
  CALL treat_flood(ksize,kpatch,imask,zpsng,zpsnv,zlai,zveg,&
                zalbf, zalbf_dir,zalbf_sca,zemisf,zff)
ELSE
  zalbf(:)=0.0
  zalbf_dir(:)=0.0
  zalbf_sca(:)=0.0
  zemisf(:)=0.0
  zff(:)=0.0
ENDIF        
!-------------------------------------------------------------------------------
!
zspectralalbedo(:,:) = 0.
zpermsnowfrac(:)     = 0.
!
IF(omeb_patch(kpatch))THEN
!
   zsnowdepth(:) = sum(zlayerswe(:,:)/zlayerrho(:,:),2)
   zpalphan(:)   = mebpalphan(zsnowdepth,zh_veg)
!
   zdir_alb_with_snow(:,:)=xundef
   zsca_alb_with_snow(:,:)=xundef
!
   IF(present(pdir_sw))THEN
!
! Albedo
!
! - just extract some parameters for call, but no need to update 
!   the cummulative variables in this routine:
!
      CALL pack_same_rank(imask(:),i%XLAI_EFFC(:,kpatch),zlai_effc(:))
      CALL pack_same_rank(imask(:),i%XFAPARC(:,kpatch),  zfaparc(:)  )
      CALL pack_same_rank(imask(:),i%XFAPIRC(:,kpatch),  zfapirc(:)  )
      CALL pack_same_rank(imask(:),i%XMUS(:,kpatch),     zmus(:)     )
!
      zpermsnowfrac(:)     = 0. ! assume no vegetation overlying permanent snow 

      zspectralalbedo(:,1) = zsnowalbvis(:)
      zspectralalbedo(:,2) = zsnowalbnir(:)
      zspectralalbedo(:,3) = xundef ! Currently, MEB only considers 2 spectral bands
!
      DO jswb=1,iswb
         zglobal_sw(:) = zdir_sw(:,jswb) + zsca_sw(:,jswb)

         WHERE(zsnowalb(:)/=xundef .AND. zsnowalbvis(:)/=xundef .AND. zsnowalbnir(:)/=xundef)
            zlain(:)         = zlai(:)*(1.0-zpalphan(:))
            zalbvis_tsoil(:) = zalbvis_soil(:)*(1.-zpsn(:)) + zpsn(:)*zsnowalbvis(:)
            zalbnir_tsoil(:) = zalbnir_soil(:)*(1.-zpsn(:)) + zpsn(:)*zsnowalbnir(:)
         ELSEWHERE
            zlain(:)         = zlai(:)
            zalbvis_tsoil(:) = zalbvis_soil(:)
            zalbnir_tsoil(:) = zalbnir_soil(:)
         END WHERE
         !
         CALL radiative_transfert(i%LAGRI_TO_GRASS, zvegtype(1:ksize,:),           &
              zalbvis_veg, zalbvis_tsoil, zalbnir_veg, zalbnir_tsoil,              &
              zglobal_sw, zlain, zzenith, i%XABC,                                  &
              zfaparc, zfapirc, zmus, zlai_effc, gshade, ziacan,                   &              
              ziacan_sunlit, ziacan_shade, zfrac_sun,                              &
              zfapar, zfapir, zfapar_bs, zfapir_bs                                 )    

! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
! albedo: diagnosed from shortwave energy budget closure.
! Final note: purely diagnostic - apply limits for night time

         zalbt(:)      = 1. - (xsw_wght_vis*(zfapar(:)+zfapar_bs(:)) +             &
                               xsw_wght_nir*(zfapir(:)+zfapir_bs(:)))
         zswup(:)      = zglobal_sw(:)*zalbt(:)
         zalbt(:)      = zswup(:)/max(1.e-5, zglobal_sw(:))
!
         zdir_alb_with_snow(:,jswb)=zalbt(:)
         zsca_alb_with_snow(:,jswb)=zalbt(:) 
!
      END DO
!
   ENDIF
!
! Emissivity
!
  zemissn(:)   = xemissn
  zpsna(:)     = 0.
  zsigma_f(:)  = 1.0 - meb_shield_factor(zlai,zpsna)
  zsigma_fn(:) = 1.0 - meb_shield_factor(zlai,zpalphan)
!
  CALL isba_emis_meb(zpsn, zpalphan, zsigma_f, zsigma_fn,  &
                     zemissn, zemist                       )

!
ELSE
!        
!  * albedo for near-infra-red and visible over snow-covered and snow-flood-free surface
!
  zalbnir_with_snow(:) = zalbnir(:) * (1.-zpsn(:)-zff(:)) + zsnowalb(:) * zpsn(:)   
  zalbvis_with_snow(:) = zalbvis(:) * (1.-zpsn(:)-zff(:)) + zsnowalb(:) * zpsn(:)  
  zalbuv_with_snow(:) = zalbuv(:) * (1.-zpsn(:)-zff(:)) + zsnowalb(:) * zpsn(:)  
!
!  * snow-flood-covered surface albedo for each wavelength (needed for outputs)
!
  CALL albedo_from_nir_vis(psw_bands,                                            &
                         zalbnir_with_snow,  zalbvis_with_snow, zalbuv_with_snow,&
                         zdir_alb_with_snow, zsca_alb_with_snow                  )  
!
  DO jswb=1,iswb
    zdir_alb_with_snow(:,jswb)=zdir_alb_with_snow(:,jswb) + zff(:)*zalbf_dir(:)
    zsca_alb_with_snow(:,jswb)=zsca_alb_with_snow(:,jswb) + zff(:)*zalbf_sca(:)
  ENDDO
!
!-------------------------------------------------------------------------------
!
! longwave computations for outputs (emissivity for radiative scheme)
!
  zemist(:) = (1.-zpsn(:)-zff(:))*zemis(:) + zpsn(:) * xemissn + zff(:)*zemisf(:)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
! Unpack variable
!
 CALL unpack_same_rank(imask(:),zpsng(:),i%XPSNG  (:,kpatch),zput0)     
 CALL unpack_same_rank(imask(:),zpsnv(:),i%XPSNV  (:,kpatch),zput0)     
 CALL unpack_same_rank(imask(:),zpsn(:),i%XPSN   (:,kpatch),zput0)  
 CALL unpack_same_rank(imask(:),zemist(:),pemist(:,kpatch),zput0)  
 CALL unpack_same_rank(imask(:),zdir_alb_with_snow(:,:),i%XDIR_ALB_WITH_SNOW (:,:,kpatch),zput0)  
 CALL unpack_same_rank(imask(:),zsca_alb_with_snow(:,:),i%XSCA_ALB_WITH_SNOW (:,:,kpatch),zput0)
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N:TREAT_NATURE',1,zhook_handle)
!
END SUBROUTINE treat_nature
!
SUBROUTINE treat_flood(KSIZE,KPATCH,KMASK,PPSNG,PPSNV,PLAI,PVEG,&
               palbf, palbf_dir,palbf_sca,pemisf,pff)
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: ksize
INTEGER, INTENT(IN) :: kpatch
INTEGER, DIMENSION(:), INTENT(IN) :: kmask
REAL, DIMENSION(:),  INTENT(IN) :: ppsng             
REAL, DIMENSION(:),  INTENT(IN) :: ppsnv 
REAL, DIMENSION(:),  INTENT(IN) :: plai
REAL, DIMENSION(:),  INTENT(IN) :: pveg
REAL, DIMENSION(:), INTENT(OUT) :: palbf_dir
REAL, DIMENSION(:), INTENT(OUT) :: palbf_sca
REAL, DIMENSION(:), INTENT(OUT) :: palbf
REAL, DIMENSION(:), INTENT(OUT) :: pemisf   
REAL, DIMENSION(:), INTENT(OUT) :: pff  
!
REAL, DIMENSION(KSIZE) :: ztg
REAL, DIMENSION(KSIZE) :: zzenith
REAL, DIMENSION(KSIZE) :: zfflood
REAL, DIMENSION(KSIZE) :: zffg   
REAL, DIMENSION(KSIZE) :: zffv
REAL, DIMENSION(KSIZE) :: zffrozen
REAL, DIMENSION(KSIZE) :: zalbedo
!
REAL, PARAMETER :: zput0 = 0.0
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N:TREAT_FLOOD',0,zhook_handle)
!
 CALL pack_same_rank(kmask(:),i%XTG(:,1,kpatch),ztg(:))
!
 CALL pack_same_rank(kmask(:),pzenith(:),zzenith(:))
 CALL pack_same_rank(kmask(:),i%XFFLOOD(:),zfflood(:))
!      
zffg(:) = flood_frac_ground(ppsng,zfflood)
zffv(:) = flood_frac_veg(plai,ppsnv,zfflood)
pff(:) = flood_frac_nat(pveg,zffg,zffv,zfflood)
!
zalbedo(:) = albedo_ta96(zzenith(:))
WHERE(zfflood==0.0)
  palbf_dir(:) = xundef
  palbf_sca(:) = xundef
  palbf(:) = xundef
  pemisf(:) = xundef
  zffrozen(:) = 0.0
ELSEWHERE
  WHERE(ztg(:)>=xtt)
    palbf_dir(:) = zalbedo(:)
    palbf_sca(:) = xalbsca_wat
    pemisf(:) = xemiswat
    zffrozen(:) = 0.0
  ELSEWHERE
    palbf_dir(:) = xalbwatice
    palbf_sca(:) = xalbwatice
    pemisf(:) = xemiswatice
    zffrozen(:) = 1.0
  END WHERE
  palbf(:)=0.5*(palbf_dir(:)+palbf_sca(:))
ENDWHERE
!
 CALL unpack_same_rank(kmask(:),zffg(:),i%XFFG    (:,kpatch),zput0)     
 CALL unpack_same_rank(kmask(:),zffv(:),i%XFFV    (:,kpatch),zput0)     
 CALL unpack_same_rank(kmask(:),zffrozen(:),i%XFFROZEN(:,kpatch),zput0)     
 CALL unpack_same_rank(kmask(:),pff(:),i%XFF     (:,kpatch),zput0) 
 CALL unpack_same_rank(kmask(:),pemisf(:),i%XEMISF  (:,kpatch),xundef)
 CALL unpack_same_rank(kmask(:),palbf(:),i%XALBF   (:,kpatch),xundef)     
!
IF (lhook) CALL dr_hook('UPDATE_RAD_ISBA_N:TREAT_FLOOD',1,zhook_handle)
!
END SUBROUTINE treat_flood
!
END SUBROUTINE update_rad_isba_n