average_diag_evap_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 average_diag_evap_isba_n (OSURF_BUDGETC, DE, DEC, NDE, NDEC, NP, KNPATCH, &
                                     OGLACIER, OMEB_PATCH, PTSTEP, PRAIN, PSNOW)
!#############################
!
!
!!****  *AVERAGE_DIAG_EVAP_ISBA_n*  
!!
!!    PURPOSE
!!    -------
!      Average the cumulated diagnostics from all ISBA tiles
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!      
!!    REFERENCE
!!    ---------
!!      
!!    AUTHOR
!!    ------
!!      P. Le Moigne           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    11/03
!!      B. Decharme 2008     New diag for the water budget
!!      B. Decharme 2012     New diag for snow 
!!                                        carbon
!!                                        isab water budget
!!                  2013                  Sublimation
!!                                        Subsurface runoff if SGH (DIF option only)
!!      P. Samuelsson 10/2014: MEB
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE mode_diag
!
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t, diag_evap_isba_np_t
USE modd_isba_n, ONLY : isba_np_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
LOGICAL, INTENT(IN) :: OSURF_BUDGETC
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DE
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEC 
TYPE(diag_evap_isba_np_t), INTENT(INOUT) :: NDE
TYPE(diag_evap_isba_np_t), INTENT(INOUT) :: NDEC
TYPE(isba_np_t), INTENT(INOUT) :: NP
INTEGER, INTENT(IN) :: KNPATCH
!
LOGICAL, INTENT(IN) :: OGLACIER
LOGICAL, DIMENSION(:), INTENT(IN) :: OMEB_PATCH
!
REAL,                  INTENT(IN) :: PTSTEP        ! time step (s)
REAL,    DIMENSION(:), INTENT(IN) :: PRAIN         ! rainfall rate
REAL,    DIMENSION(:), INTENT(IN) :: PSNOW         ! snowfall rate
!
!
!*      0.2    declarations of local variables
!
INTEGER :: JP ! tile loop counter
INTEGER :: JI, IMASK
INTEGER           :: ISIZE_LMEB_PATCH   ! Number of patches where multi-energy balance should be applied
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
!
!       0.     Initialization
!              --------------
!
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_EVAP_ISBA_N',0,zhook_handle)
!
isize_lmeb_patch=count(omeb_patch(:))
!
!       1.     Surface Energy fluxes
!              -----------------------
!
IF (de%LSURF_EVAP_BUDGET) THEN
  !
  CALL init_evap_bud(de)
  IF (isize_lmeb_patch>0) CALL init_meb_bud(de)
  !
  IF(de%LWATER_BUDGET)THEN
    !  
    CALL init_water_bud(de)
    !
    de%XRAINFALL  (:) = prain(:) * ptstep
    de%XSNOWFALL  (:) = psnow(:) * ptstep
    !
  ENDIF
  !
  CALL make_average_evap(de,nde)  
  ! 
  ! Ice calving flux
  !  
  IF(oglacier)THEN 

    de%XICEFLUX(:)= 0.
    DO jp=1,knpatch
      DO ji=1,np%AL(jp)%NSIZE_P
        imask = np%AL(jp)%NR_P(ji)
        de%XICEFLUX(imask) = de%XICEFLUX(imask) + np%AL(jp)%XPATCH(ji) * nde%AL(jp)%XICEFLUX(ji)      
      END DO
    END DO

  END IF
  !  
ENDIF
!
!       2.     Surface Cumulated Energy fluxes
!              -------------------------------
!
IF (osurf_budgetc) THEN
  !
  !
  CALL init_evap_bud(dec)
  !
  IF (isize_lmeb_patch>0) THEN
    CALL init_meb_bud(dec)
  ENDIF
  !
  ! Isba water budget and reservoir time tendencies
  !
  IF(de%LWATER_BUDGET)THEN
    !  
    CALL init_water_bud(dec)
    !
    dec%XRAINFALL  (:) = dec%XRAINFALL (:) + prain(:) * ptstep
    dec%XSNOWFALL  (:) = dec%XSNOWFALL (:) + psnow(:) * ptstep
    !
  ENDIF
  !
  CALL make_average_evap(dec,ndec)
  !
  ! Ice calving flux
  !  
  IF(oglacier)THEN 

    dec%XICEFLUX(:)= 0.
    DO jp=1,knpatch
      DO ji=1,np%AL(jp)%NSIZE_P
        imask = np%AL(jp)%NR_P(ji)
        dec%XICEFLUX(imask) = dec%XICEFLUX(imask) + np%AL(jp)%XPATCH(ji) * ndec%AL(jp)%XICEFLUX(ji)      
      END DO
    END DO

  END IF
!  
END IF
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_EVAP_ISBA_N',1,zhook_handle)
!
CONTAINS
!
SUBROUTINE make_average_evap(DEA,NDEA)
!
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEA
TYPE(diag_evap_isba_np_t), INTENT(INOUT) :: NDEA
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('AVERAGE_DIAG_EVAP_ISBA_N:MAKE_AVERAGE_EVAP',0,zhook_handle)
!
DO jp=1,knpatch
  DO ji=1,np%AL(jp)%NSIZE_P
    imask = np%AL(jp)%NR_P(ji)
    !
    ! Latent heat of evaporation over the ground
    dea%XLEG (imask) = dea%XLEG (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLEG(ji)
    !
    ! Surface soil ice sublimation
    dea%XLEGI(imask) = dea%XLEGI(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLEGI(ji)
    !
    ! Latent heat of evaporation over vegetation
    dea%XLEV (imask) = dea%XLEV (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLEV(ji)
    !
    ! Latent heat of sublimation over snow
    dea%XLES (imask) = dea%XLES (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLES(ji)
    !
    ! Latent heat of evaporation of liquid water over snow
    dea%XLESL(imask) = dea%XLESL(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLESL(ji)
    !
    ! Evaporation from canopy water interception
    dea%XLER (imask) = dea%XLER (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLER(ji)
    !
    ! Evapotranspiration of the vegetation
    dea%XLETR(imask) = dea%XLETR(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLETR(ji)
    !
    ! Blowing snow sublimation (ES or Crocus)
    dea%XSNDRIFT(imask) = dea%XSNDRIFT(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSNDRIFT(ji)
    !
    ! Soil drainage flux
    dea%XDRAIN (imask) = dea%XDRAIN (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDRAIN(ji)
    !
    ! Soil lateral subsurface flux
    dea%XQSB   (imask) = dea%XQSB   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XQSB(ji)        
    !
    ! Supersaturation runoff
    dea%XRUNOFF(imask) = dea%XRUNOFF(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XRUNOFF(ji)
    !
    ! Horton runoff
    dea%XHORT  (imask) = dea%XHORT  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XHORT(ji)
    !
    ! Vegetation dripping
    dea%XDRIP  (imask) = dea%XDRIP  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDRIP(ji)
    !
    ! Precipitation intercepted by the vegetation
    dea%XRRVEG (imask) = dea%XRRVEG (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XRRVEG(ji)
    !      
    ! Snow melt
    dea%XMELT  (imask) = dea%XMELT  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XMELT(ji)
    !      
    ! Flood infiltartion
    dea%XIFLOOD(imask) = dea%XIFLOOD(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XIFLOOD(ji)
    !      
    ! Precipitation intercepted by the floodplains   
    dea%XPFLOOD(imask) = dea%XPFLOOD(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XPFLOOD(ji)
    !      
    ! Floodplains evaporation  
    dea%XLE_FLOOD (imask) = dea%XLE_FLOOD (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLE_FLOOD (ji)
    dea%XLEI_FLOOD(imask) = dea%XLEI_FLOOD(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLEI_FLOOD(ji)
    !      
    ! irrigation rate (as soil input)
    dea%XIRRIG_FLUX(imask) = dea%XIRRIG_FLUX(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XIRRIG_FLUX(ji)
    !
    ! Gross primary production
    dea%XGPP      (imask) = dea%XGPP      (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XGPP(ji)
    !
    ! Autotrophic respiration 
    dea%XRESP_AUTO(imask) = dea%XRESP_AUTO(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XRESP_AUTO(ji)
    !
    ! Ecosystem respiration
    dea%XRESP_ECO (imask) = dea%XRESP_ECO (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XRESP_ECO(ji)  
    !        
    IF (isize_lmeb_patch>0) THEN
      dea%XLELITTER (imask) = dea%XLELITTER (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLELITTER (ji)
      dea%XLELITTERI(imask) = dea%XLELITTERI(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLELITTERI(ji)
      dea%XDRIPLIT  (imask) = dea%XDRIPLIT  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDRIPLIT  (ji)
      dea%XRRLIT    (imask) = dea%XRRLIT    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XRRLIT    (ji)     

      dea%XLEV_CV   (imask) = dea%XLEV_CV   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLEV_CV   (ji)
      dea%XLES_CV   (imask) = dea%XLES_CV   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLES_CV   (ji)
      dea%XLETR_CV  (imask) = dea%XLETR_CV  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLETR_CV  (ji)
      dea%XLER_CV   (imask) = dea%XLER_CV   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLER_CV   (ji)      
      dea%XLE_CV    (imask) = dea%XLE_CV    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLE_CV    (ji)       
      dea%XH_CV     (imask) = dea%XH_CV     (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XH_CV     (ji)   
      dea%XMELT_CV  (imask) = dea%XMELT_CV  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XMELT_CV  (ji)
      dea%XFRZ_CV   (imask) = dea%XFRZ_CV   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XFRZ_CV   (ji)   

      dea%XLETR_GV  (imask) = dea%XLETR_GV  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLETR_GV  (ji)
      dea%XLER_GV   (imask) = dea%XLER_GV   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLER_GV   (ji)
      dea%XLE_GV    (imask) = dea%XLE_GV    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLE_GV    (ji)      
      dea%XH_GV     (imask) = dea%XH_GV     (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XH_GV     (ji)      

      dea%XLE_GN    (imask) = dea%XLE_GN    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLE_GN    (ji)
      dea%XEVAP_GN  (imask) = dea%XEVAP_GN  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XEVAP_GN  (ji)
      dea%XH_GN     (imask) = dea%XH_GN     (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XH_GN     (ji)      
      dea%XSR_GN    (imask) = dea%XSR_GN    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSR_GN    (ji)
      dea%XSWDOWN_GN(imask) = dea%XSWDOWN_GN(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSWDOWN_GN(ji)
      dea%XLWDOWN_GN(imask) = dea%XLWDOWN_GN(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLWDOWN_GN(ji)

      dea%XEVAP_G   (imask) = dea%XEVAP_G   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XEVAP_G   (ji)
      dea%XLE_CA    (imask) = dea%XLE_CA    (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLE_CA    (ji)
      dea%XH_CA     (imask) = dea%XH_CA     (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XH_CA     (ji)

      dea%XSWNET_V  (imask) = dea%XSWNET_V  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSWNET_V(ji)
      dea%XSWNET_G  (imask) = dea%XSWNET_G  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSWNET_G(ji)
      dea%XSWNET_N  (imask) = dea%XSWNET_N  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSWNET_N(ji)
      dea%XSWNET_NS (imask) = dea%XSWNET_NS (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XSWNET_NS(ji)
      dea%XLWNET_V  (imask) = dea%XLWNET_V  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLWNET_V(ji)
      dea%XLWNET_G  (imask) = dea%XLWNET_G  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLWNET_G(ji)
      dea%XLWNET_N  (imask) = dea%XLWNET_N  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XLWNET_N(ji)
    ENDIF
  END DO
ENDDO
!
! Isba water budget and reservoir time tendencies
!
IF(de%LWATER_BUDGET)THEN
  !  
  DO jp=1,knpatch
  DO ji=1,np%AL(jp)%NSIZE_P
    imask = np%AL(jp)%NR_P(ji)
      !
      dea%XDWG   (imask) = dea%XDWG   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDWG   (ji)
      dea%XDWGI  (imask) = dea%XDWGI  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDWGI  (ji)
      dea%XDWR   (imask) = dea%XDWR   (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDWR   (ji)
      dea%XDSWE  (imask) = dea%XDSWE  (imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XDSWE  (ji)
      dea%XWATBUD(imask) = dea%XWATBUD(imask) + np%AL(jp)%XPATCH(ji) * ndea%AL(jp)%XWATBUD(ji)

    ENDDO
  ENDDO
!
ENDIF
!
IF (lhook) CALL dr_hook('AVERAGE_DIAG_EVAP_ISBA_N:MAKE_AVERAGE_EVAP',1,zhook_handle)
!
END SUBROUTINE make_average_evap
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE average_diag_evap_isba_n