rout_data_isba.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 rout_data_isba (DEC, DC, DMI, PMESH_SIZE, IO, NP, NPE, UG, U, HPROGRAM,KI,KSTEP)
!     #####################
!
!!****  *ROUT_DATA_ISBA*  
!!
!!    PURPOSE
!!    -------
!
!    Routes runoff and drainage of ISBA with coupling with Topmodel
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR
!!    ------
!!
!!      B. Vincendon    *  Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   15/06/2007
!!                 03/2014 (B. Vincendon) call of initialisation for budget on watersheds
!-------------------------------------------------------------------------------
!
!*       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_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modi_get_luout
USE modi_unpack_same_rank
USE modi_diag_isba_to_rout
USE modi_isba_to_topd
USE modi_init_budget_coupl_rout
USE modi_routing
!
USE modd_topodyn,        ONLY : nncat, nmesht, nnmc
USE modd_coupling_topd,  ONLY : nmaskt, xrunoff_top, xatop, nnpix,&
                                  xavg_runoffcm, xavg_draincm, lbudget_topd
!
USE modd_surf_par,         ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(diag_evap_isba_t), INTENT(INOUT) :: DEC
TYPE(diag_t), INTENT(INOUT) :: DC
TYPE(diag_misc_isba_t), INTENT(INOUT) :: DMI
REAL, DIMENSION(:), INTENT(IN) :: PMESH_SIZE
TYPE(isba_options_t), INTENT(INOUT) :: IO
TYPE(isba_np_t), INTENT(INOUT) :: NP
TYPE(isba_npe_t), INTENt(INOUT) :: NPE
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
INTEGER, INTENT(IN)          :: KI     ! Grid dimensions
INTEGER, INTENT(IN)          :: KSTEP  ! current time step 
!
!*      0.2    declarations of local variables
!
INTEGER                       :: JJ,JI  ! loop control 
INTEGER                       :: ILUOUT      ! unit number of listing file
 CHARACTER(LEN=30)             :: YVAR
REAL, DIMENSION(KI)           :: ZRUNOFFC_FULL  ! Cumulated runoff from isba on the full domain (kg/m2)
REAL, DIMENSION(KI)           :: ZRUNOFFC_FULLM ! Cumulated runoff from isba on the full domain (kg/m2) at t-dt
REAL, DIMENSION(KI)           :: ZRUNOFF_ISBA   ! Runoff from Isba (kg/m2)
REAL, DIMENSION(KI)           :: ZDRAINC_FULL   ! Cumulated drainage from Isba on the full domain (kg/m2)
REAL, DIMENSION(KI)           :: ZDRAINC_FULLM  ! Cumulated drainage from Isba on the full domain (kg/m2) at t-dt
REAL, DIMENSION(KI)           :: ZDRAIN_ISBA    ! Drainage from Isba (m3/s)
REAL, DIMENSION(NNCAT,NMESHT) :: ZRUNOFF_TOPD   ! Runoff on the Topodyn grid (m3/s)
REAL, DIMENSION(NNCAT,NMESHT) :: ZDRAIN_TOPD    ! Drainage from Isba on Topodyn grid (m3/s)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ROUT_DATA_ISBA',0,zhook_handle)
!
 CALL get_luout(hprogram,iluout)
!
zrunoffc_full(:) = 0.
zrunoffc_fullm(:) = 0.
zrunoff_isba(:) = 0.
zrunoff_topd(:,:) = 0.
zdrainc_full(:) = 0.
zdrainc_fullm(:) = 0.
zdrain_isba(:) = 0.
zdrain_topd(:,:) = 0.
IF (kstep==1 .AND. lbudget_topd) CALL init_budget_coupl_rout(dec, dc, dmi, pmesh_size, &
                                                             io, np, npe, u, ki)
!
!    Runoff on TOPODYN grid
!   ---------------------------------------
!
 CALL unpack_same_rank(u%NR_NATURE,dec%XRUNOFF,zrunoffc_full)
 CALL unpack_same_rank(u%NR_NATURE,xavg_runoffcm,zrunoffc_fullm)
!
 CALL diag_isba_to_rout(ug%G%XMESH_SIZE,zrunoffc_full,zrunoffc_fullm,zrunoff_isba)
!
xavg_runoffcm(:) = dec%XRUNOFF(:)
zrunoff_topd(:,:) = 0.0
!
 CALL isba_to_topd(zrunoff_isba,zrunoff_topd)
!
DO jj=1,nncat
  DO ji=1,nnmc(jj)
    zrunoff_topd(jj,ji) = zrunoff_topd(jj,ji) / nnpix(nmaskt(jj,ji))
  ENDDO
ENDDO
!
!    Drainage treatment
!    ----------------------------------------
!
 CALL unpack_same_rank(u%NR_NATURE,dec%XDRAIN*xatop,zdrainc_full)
 CALL unpack_same_rank(u%NR_NATURE,xavg_draincm*xatop,zdrainc_fullm)
!
 CALL diag_isba_to_rout(ug%G%XMESH_SIZE,zdrainc_full,zdrainc_fullm,zdrain_isba)
!
xavg_draincm(:)  = dec%XDRAIN(:)
zdrain_topd(:,:) = 0.0
!
 CALL isba_to_topd(zdrain_isba,zdrain_topd)
!
DO jj=1,nncat
  DO ji=1,nnmc(jj)
    zdrain_topd(jj,ji) = zdrain_topd(jj,ji) / nnpix(nmaskt(jj,ji))
  ENDDO
ENDDO
!*     Routing (runoff + drainage)
!     ----------------------------------------
!
 CALL routing(zrunoff_topd,zdrain_topd,kstep)
!
IF (lhook) CALL dr_hook('ROUT_DATA_ISBA',1,zhook_handle)
!
END SUBROUTINE rout_data_isba