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 (DGEI, DGMI, I, 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_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_n, ONLY : isba_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_evap_isba_t), INTENT(INOUT) :: dgei
TYPE(diag_misc_isba_t), INTENT(INOUT) :: dgmi
TYPE(isba_t), INTENT(INOUT) :: i
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                          :: zfact0, zfact1, zfact2
INTEGER                       :: jmesh,jcat
REAL, DIMENSION(SIZE(I%XWG,1),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 (i%CISBA=='DIF') THEN
 CALL dg_dfto3l(i, &
                SIZE(i%XWG,1),zdg_3l)
 zwg_3l(:,2)=dgmi%XFRD2_TWG(:)
 zwg_3l(:,3)=dgmi%XFRD3_TWG(:)
 zwgi_3l(:,2)=dgmi%XFRD2_TWGI(:)
 zwgi_3l(:,3)=dgmi%XFRD3_TWGI(:)

ELSEIF (i%CISBA=='3-L') THEN
 CALL avg_patch_wg(i, &
                   SIZE(i%XWG,1),zwg_3l,zwgi_3l,zdg_3l)
ENDIF
!
 CALL unpack_same_rank(u%NR_NATURE,dgei%XRAINFALL(:), xb_rain)
 CALL unpack_same_rank(u%NR_NATURE,dgei%XSNOWFALL(:), xb_snow)
!
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_DWR, zb_dwr)
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_EVAPC, xb_evap)        
!
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_RUNOFFC,xb_runoff_isba)
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_HORTC,xb_horton)
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_WATBUD, zb_watbud)
xb_runoff_topd = xb_runoff_isba
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_DRAINC, 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(u%NR_NATURE,i%TSNOW%WSNOW(:,1,1),xb_swe1)
 CALL unpack_same_rank(u%NR_NATURE,i%TSNOW%WSNOW(:,2,1),xb_swe2)
 CALL unpack_same_rank(u%NR_NATURE,i%TSNOW%WSNOW(:,3,1),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