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 (DGEI, DGMI, IG, I, 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_evap_isba_n, ONLY : diag_evap_isba_t
USE modd_diag_misc_isba_n, ONLY : diag_misc_isba_t
USE modd_isba_grid_n, ONLY : isba_grid_t
USE modd_isba_n, ONLY : isba_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) :: dgei
TYPE(diag_misc_isba_t), INTENT(INOUT) :: dgmi
TYPE(isba_grid_t), INTENT(INOUT) :: ig
TYPE(isba_t), INTENT(INOUT) :: i
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(dgei, dgmi, ig, i, u, &
                                                             ki)
!
!    Runoff on TOPODYN grid
!   ---------------------------------------
!
 CALL unpack_same_rank(u%NR_NATURE,dgei%XAVG_RUNOFFC,zrunoffc_full)
 CALL unpack_same_rank(u%NR_NATURE,xavg_runoffcm,zrunoffc_fullm)
!
 CALL diag_isba_to_rout(ug, &
                        zrunoffc_full,zrunoffc_fullm,zrunoff_isba)
!
xavg_runoffcm(:) = dgei%XAVG_RUNOFFC(:)
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,dgei%XAVG_DRAINC*xatop,zdrainc_full)
 CALL unpack_same_rank(u%NR_NATURE,xavg_draincm*xatop,zdrainc_fullm)
!
 CALL diag_isba_to_rout(ug, &
                        zdrainc_full,zdrainc_fullm,zdrain_isba)
!
xavg_draincm(:)  = dgei%XAVG_DRAINC(:)
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