budget_coupl_rout.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 budget_coupl_rout (DE, DEC, DC, DMI, IO, NP, NPE, U, KNI, KFORC_STEP)
!     ##########################
!
!!
!!    PURPOSE
!!    -------
!        
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!      
!!    REFERENCE
!!    ---------
!!     
!!    AUTHOR
!!    ------
!!
!!    L. Bouilloud &  B. Vincendon      * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original  03/2008 
!!      03/2014: Modif BV : add more variables
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_diag_n, ONLY : diag_t
USE modd_diag_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_options_n, ONLY : isba_options_t
USE modd_isba_n, ONLY : isba_np_t, isba_npe_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_budget_coupl_rout ! contains all useful variables XB_*
!
USE modd_topodyn,       ONLY : nncat, xqtot, xtopd_step, xqb_dr, xqb_run
USE modd_coupling_topd, ONLY : xrunoff_top, xrun_torout, xdr_torout, xatop, nnb_topd

!
USE modd_surf_par
USE modd_csts,            ONLY : xrholw
!
USE modd_forc_atm,        ONLY : xsnow       ,&! snow precipitation                    (kg/m2/s)
                                 xrain         ! liquid precipitation                  (kg/m2/s)
!
USE modi_unpack_same_rank
USE modi_pack_same_rank 
USE modi_avg_patch_wg
USE modi_dg_dfto3l
!USE MODI_WRITE_DISCHARGE_FILE_PRTEST
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(diag_t), INTENT(INOUT) :: DC
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DE
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEC
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMI
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(isba_npe_t), INTENt(INOUT) :: NPE
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
INTEGER, INTENT(IN)           :: KNI        ! expected physical size of full surface array
INTEGER, INTENT(IN)           :: KFORC_STEP ! time step
!
!*      0.2    declarations of local variables
REAL, DIMENSION(U%NSIZE_NATURE) :: ZINTER
REAL                          :: ZFACT0, ZFACT1, ZFACT2
INTEGER                       :: JMESH,JCAT
REAL, DIMENSION(U%NSIZE_NATURE,3)  :: ZWG_3L,ZWGI_3L,ZDG_3L          
REAL, DIMENSION(KNI)  :: ZB_DWGTOT,ZB_DWGITOT,ZB_DSWETOT,ZB_DWR,ZB_WATBUD         
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('BUDGET_COUPL_ROUT',0,zhook_handle)
!
!*       1.     Budget computation:
!               ---------------
IF (io%CISBA=='DIF') THEN
 CALL dg_dfto3l(io, np, zdg_3l)
 zwg_3l(:,2)=dmi%XFRD2_TWG(:)
 zwg_3l(:,3)=dmi%XFRD3_TWG(:)
 zwgi_3l(:,2)=dmi%XFRD2_TWGI(:)
 zwgi_3l(:,3)=dmi%XFRD3_TWGI(:)

ELSEIF (io%CISBA=='3-L') THEN
 CALL avg_patch_wg(io, np, npe, zwg_3l, zwgi_3l, zdg_3l)
ENDIF
!
CALL UNPACK_SAME_RANK(U%NR_NATURE,DE%XRAINFALL(:), XB_RAIN)
CALL UNPACK_SAME_RANK(U%NR_NATURE,DE%XSNOWFALL(:), XB_SNOW)
!
CALL UNPACK_SAME_RANK(U%NR_NATURE,DE%XDWR, ZB_DWR)
CALL UNPACK_SAME_RANK(U%NR_NATURE,DC%XEVAP, XB_EVAP)        
!
CALL UNPACK_SAME_RANK(U%NR_NATURE,DEC%XRUNOFF,XB_RUNOFF_ISBA)
CALL UNPACK_SAME_RANK(U%NR_NATURE,DEC%XHORT,XB_HORTON)
CALL UNPACK_SAME_RANK(U%NR_NATURE,DE%XWATBUD, ZB_WATBUD)
xb_runoff_topd = xb_runoff_isba
CALL UNPACK_SAME_RANK(U%NR_NATURE,DEC%XDRAIN, XB_DRAIN)
!
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZWG_3L(:,2)  ,XB_WG2)
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZWG_3L(:,3)  ,XB_WG3)
WHERE ( xb_wg2/=xundef .AND. xb_dg2/=xundef .AND. xb_wg3/=xundef .AND. xb_dg3/=xundef )
  xb_wgtot(:) = xb_wg2(:)*xb_dg2(:) + xb_wg3(:)*(xb_dg3(:)-xb_dg2(:)) !m3/m2
ELSEWHERE
  xb_wgtot(:) = xundef
ENDWHERE
!
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZWGI_3L(:,2) ,XB_WGI2)
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZWGI_3L(:,3) ,XB_WGI3)
WHERE ( xb_wgi2/=xundef .AND. xb_dg2/=xundef .AND. xb_wgi3/=xundef .AND. xb_dg3/=xundef )
  xb_wgitot(:) = xb_wgi2(:)*xb_dg2(:) + xb_wgi3(:)*(xb_dg3(:)-xb_dg2(:)) !m3/m2
ELSEWHERE
  xb_wgitot(:) = xundef
ENDWHERE
!
CALL UNPACK_SAME_RANK(NP%AL(1)%NR_P,NPE%AL(1)%TSNOW%WSNOW(:,1),ZINTER)
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZINTER,XB_SWE1)
!
CALL UNPACK_SAME_RANK(NP%AL(1)%NR_P,NPE%AL(1)%TSNOW%WSNOW(:,2),ZINTER)
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZINTER,XB_SWE2)
!
CALL UNPACK_SAME_RANK(NP%AL(1)%NR_P,NPE%AL(1)%TSNOW%WSNOW(:,3),ZINTER)
CALL UNPACK_SAME_RANK(U%NR_NATURE,ZINTER,XB_SWE3)
!
xb_swetot(:) = xb_swe1(:)+xb_swe2(:)+xb_swe3(:)
!
DO jcat=1,nncat
  xb_qtot(jcat) = sum(xqtot(jcat,1:kforc_step))
  xb_qrun(jcat) = sum(xqb_run(jcat,1:kforc_step))
  xb_qdr(jcat)  = sum(xqb_dr(jcat,1:kforc_step))
ENDDO
!
DO jcat=1,nncat
  !
  DO jmesh=1,kni
    !
    IF ( xb_dg2(jmesh)/=xundef ) THEN
!!    Water going in the system
      zfact0 =  xb_abv_bymesh(jmesh,jcat) * xb_mesh_size(jmesh)
      zfact1 =  zfact0 / xrholw
      zfact2 =  nnb_topd * zfact1
      !ZFACT2 =  XTOPD_STEP * ZFACT1
      !
!!      variable =1 : Rain      
      xb_var_bv(kforc_step,jcat,1) = xb_var_bv(kforc_step,jcat,1) + xb_rain(jmesh) * zfact2
!!      variable =2 : Snow
      xb_var_bv(kforc_step,jcat,2) = xb_var_bv(kforc_step,jcat,2) + xb_snow(jmesh) * zfact2
!!    Water going out of the system
!!      variable =3 : Incerception 
      xb_var_bv(kforc_step,jcat,3) = xb_var_bv(kforc_step,jcat,3) + zb_dwr(jmesh) * zfact2
!!      variable =4 : Evaporation
      xb_var_bv(kforc_step,jcat,4) = xb_var_bv(kforc_step,jcat,4) + (xb_evap(jmesh)-xb_evapm(jmesh)) * zfact1
!!      variable =5 : Runoff
      xb_var_bv(kforc_step,jcat,5) = xb_var_bv(kforc_step,jcat,5) + (xb_runoff_topd(jmesh)-xb_runoff_topdm(jmesh)) * zfact1
!!      variable =6 : Drainage
      xb_var_bv(kforc_step,jcat,6) = xb_var_bv(kforc_step,jcat,6) + (xb_drain(jmesh)-xb_drainm(jmesh)) * zfact1
!!      variable =7 : Variation of liquid water stocked in the ground
      xb_var_bv(kforc_step,jcat,7) = xb_var_bv(kforc_step,jcat,7) + (xb_wgtot(jmesh)-xb_wgtotm(jmesh)) * zfact0   
!!      variable =8 : Variation of solid water stocked in the ground
      xb_var_bv(kforc_step,jcat,8) = xb_var_bv(kforc_step,jcat,8) + (xb_wgitot(jmesh)-xb_wgitotm(jmesh)) * zfact0 
!!      variable =9 : Variation of melting snow
      xb_var_bv(kforc_step,jcat,9) = xb_var_bv(kforc_step,jcat,9) + (xb_swetot(jmesh)-xb_swetotm(jmesh)) * zfact0 
!!      variable =11 : Hortonian Runoff
      xb_var_bv(kforc_step,jcat,11) = xb_var_bv(kforc_step,jcat,11) + (xb_horton(jmesh)-xb_hortonm(jmesh)) * zfact1
!!      variable =12 : ISBA water budget
      xb_var_bv(kforc_step,jcat,12) = xb_var_bv(kforc_step,jcat,12) + zb_watbud(jmesh) * zfact2

 !! bilan hors BV en m3
      zfact0 =  (1.-xb_abv_bymesh(jmesh,jcat)) * xb_mesh_size(jmesh)
      zfact1 =  zfact0 / xrholw
      zfact2 =  nnb_topd * zfact1
!      ZFACT2 =  XTOPD_STEP * ZFACT1
      !
      xb_var_nobv(kforc_step,jcat,1) = xb_var_nobv(kforc_step,jcat,1) + xb_rain(jmesh) * zfact2
      xb_var_nobv(kforc_step,jcat,2) = xb_var_nobv(kforc_step,jcat,2) + xb_snow(jmesh) * zfact2
      xb_var_nobv(kforc_step,jcat,3) = xb_var_nobv(kforc_step,jcat,3) + zb_dwr(jmesh) * zfact2
      xb_var_nobv(kforc_step,jcat,4) = xb_var_nobv(kforc_step,jcat,4) + (xb_evap(jmesh)-xb_evapm(jmesh)) * zfact1
      xb_var_nobv(kforc_step,jcat,5) = xb_var_nobv(kforc_step,jcat,5) + (xb_runoff_isba(jmesh)-xb_runoff_isbam(jmesh)) * zfact1
      xb_var_nobv(kforc_step,jcat,6) = xb_var_nobv(kforc_step,jcat,6) + (xb_drain(jmesh)-xb_drainm(jmesh)) * zfact1
      xb_var_nobv(kforc_step,jcat,7) = xb_var_nobv(kforc_step,jcat,7) + (xb_wgtot(jmesh)-xb_wgtotm(jmesh)) * zfact0   
      xb_var_nobv(kforc_step,jcat,8) = xb_var_nobv(kforc_step,jcat,8) + (xb_wgitot(jmesh)-xb_wgitotm(jmesh)) * zfact0   
      xb_var_nobv(kforc_step,jcat,9) = xb_var_nobv(kforc_step,jcat,9) + (xb_swetot(jmesh)-xb_swetotm(jmesh)) * zfact0 
      xb_var_nobv(kforc_step,jcat,11) = xb_var_nobv(kforc_step,jcat,11) + (xb_horton(jmesh)-xb_hortonm(jmesh)) * zfact1
      xb_var_nobv(kforc_step,jcat,12) = xb_var_nobv(kforc_step,jcat,12) + zb_watbud(jmesh) * zfact2
      !
    ENDIF
    !     
  ENDDO
  !
  xb_var_bv(kforc_step,jcat,10) = sum(xb_var_bv(kforc_step,jcat,1:2)) - sum(xb_var_bv(kforc_step,jcat,3:9))
  !
  xb_var_nobv(kforc_step,jcat,10) =  sum(xb_var_nobv(kforc_step,jcat,1:2)) - sum(xb_var_nobv(kforc_step,jcat,3:9))
  !
  xb_var_q(kforc_step,jcat,1) = (xb_qtot(jcat)-xb_qtotm(jcat)) * xtopd_step
  xb_var_q(kforc_step,jcat,2) = (xb_qrun(jcat)-xb_qrunm(jcat)) * xtopd_step
  xb_var_q(kforc_step,jcat,3) = (xb_qdr(jcat)- xb_qdrm(jcat)) * xtopd_step
  xb_var_q(kforc_step,jcat,4) = sum(xrun_torout(jcat,:)) * xtopd_step
  xb_var_q(kforc_step,jcat,5) = sum(xdr_torout(jcat,:)) * xtopd_step
  !
ENDDO   
!
!bilan tot isba (m3)
DO jmesh=1,kni
  !
  IF (xb_dg2(jmesh)/=xundef) THEN  
    !
    zfact0 =  xb_mesh_size(jmesh)
    zfact1 =  zfact0 / xrholw
      zfact2 =  nnb_topd * zfact1
!    ZFACT2 =  XTOPD_STEP * ZFACT1
    !
!!    Water going in the system
!!      variable =1 : Rain
    xb_var_tot(kforc_step,1) = xb_var_tot(kforc_step,1) + xb_rain(jmesh) * zfact2
!!      variable =2 : Snow
    xb_var_tot(kforc_step,2) = xb_var_tot(kforc_step,2) + xb_snow(jmesh) * zfact2
!!    Water going out of the system
!!      variable =3 : Incerception 
    xb_var_tot(kforc_step,3) = xb_var_tot(kforc_step,3) + zb_dwr(jmesh) * zfact2
!!      variable =4 : Evaporation
    xb_var_tot(kforc_step,4) = xb_var_tot(kforc_step,4) + (xb_evap(jmesh)-xb_evapm(jmesh)) * zfact1
!!      variable =5 : Runoff
    xb_var_tot(kforc_step,5) = xb_var_tot(kforc_step,5) + (xb_runoff_isba(jmesh)-xb_runoff_isbam(jmesh))  * zfact1 
!!      variable =6 : Drainage
    xb_var_tot(kforc_step,6) = xb_var_tot(kforc_step,6) + (xb_drain(jmesh)-xb_drainm(jmesh)) * zfact1
!!      variable =7 : Variation of liquid water stocked in the ground
    xb_var_tot(kforc_step,7) = xb_var_tot(kforc_step,7) + (xb_wgtot(jmesh)-xb_wgtotm(jmesh)) * zfact0  
!!      variable =8 : Variation of solid water stocked in the ground
    xb_var_tot(kforc_step,8) = xb_var_tot(kforc_step,8) + (xb_wgitot(jmesh)-xb_wgitotm(jmesh)) * zfact0  
!!      variable =9 : Variation of melting snow
    xb_var_tot(kforc_step,9) = xb_var_tot(kforc_step,9) + (xb_swetot(jmesh)-xb_swetotm(jmesh)) * zfact0  
!!      variable =11: Hortonian runoff
    xb_var_tot(kforc_step,11) = xb_var_tot(kforc_step,11) + (xb_horton(jmesh)-xb_hortonm(jmesh)) * zfact1
!!      variable =12 : ISBA water budget
    xb_var_tot(kforc_step,12) = xb_var_tot(kforc_step,12) + zb_watbud(jmesh) * zfact2
   !
  ENDIF
  !
ENDDO !JMESH
!
xb_var_tot(kforc_step,10) = sum(xb_var_tot(kforc_step,1:2)) - sum(xb_var_tot(kforc_step,3:9)) 
!
!
xb_wrm(:) = xb_wr(:)
xb_evapm(:) = xb_evap(:)
!
xb_runoff_topdm(:) = xb_runoff_topd(:)
xb_runoff_isbam(:) = xb_runoff_isba(:)
xb_hortonm(:) = xb_horton(:)
xb_drainm(:) = xb_drain(:)
!
xb_wg2m(:) = xb_wg2(:)
xb_wg3m(:) = xb_wg3(:)
xb_wgtotm(:) = xb_wgtot(:)
xb_wgi2m(:) = xb_wgi2(:)
xb_wgi3m(:) = xb_wgi3(:)
xb_wgitotm(:) = xb_wgitot(:)
xb_swe1m(:) = xb_swe1(:)
xb_swe2m(:) = xb_swe2(:)
xb_swe3m(:) = xb_swe3(:)
xb_swetotm(:) = xb_swetot(:)
!
xb_qtotm(:) = xb_qtot(:)
xb_qrunm(:) = xb_qrun(:) 
xb_qdrm(:) = xb_qdr(:)
!
IF (lhook) CALL dr_hook('BUDGET_COUPL_ROUT',1,zhook_handle)
!
END SUBROUTINE budget_coupl_rout