routing.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 routing(PRO,PDR,KSTEP)
!     ####################
!
!!****  *ROUTING*  
!!
!!    PURPOSE
!!    -------
!     To route the runoff and the exfiltration discharge to the catchment outlet
!         
!     
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!     
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * Meteo-France *
!!      G-M. Saulnier  * LTHE *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   23/11/2005
!!      M. Le Lay     02/2008 Compatibility with the RESTART option (to update the
!!                            discharge between two runs)
!!      Modif B Vincendon 11/2011 : stock managed in three distinct variables
!!      Modif B Vincendon 03/2014 : correction of a bug on drainage still in the
!                                   river
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_surf_par,        ONLY:xundef
!
USE modd_topodyn, ONLY : xtopd_step, nncat, xqtot, nnmc, &
                         xtime_topd, xqb_run, xqb_dr, xtime_topd_drain, nnb_topd_step
USE modd_coupling_topd, ONLY: xrun_torout, xdr_torout, nnb_stp_restart
!
USE modi_get_luout
USE modi_open_file
USE modi_close_file
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
REAL, DIMENSION(:,:), INTENT(IN) :: PRO     ! Total water for runoff for each pixel (m3/s)
!ludo
REAL, DIMENSION(:,:), INTENT(IN) :: PDR     ! Total water for drainage for each pixel
INTEGER, INTENT(IN)              :: KSTEP   ! current integration step
!
!
!*      0.2    declarations of local variables
!
!
INTEGER                            :: JCAT, JJ, JI ! Loop variables
INTEGER                            :: JSTEP        ! current or future integration steps
REAL, DIMENSION(NNCAT,NNB_TOPD_STEP+NNB_STP_RESTART) :: ZRUN_TOROUT,ZDR_TOROUT ! Kg/m2
                                                   ! water of runoff and drainage resp. still in the river 
                                                   ! and added to the discharge for the current simulation
 CHARACTER(LEN=3)                  :: YSTEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ROUTING',0,zhook_handle)
!
!*       1.0.     Initialization :
!               --------------
!
zrun_torout(:,:) = 0.
zdr_torout(:,:) = 0.
!
DO jcat=1,nncat
  !
  !*       2.0    Runoff by geomorpho transfer function
  !               -------------------------------------
  DO jj=1,nnmc(jcat)
  !
    IF ( pro(jcat,jj) > 0.0 .AND. pro(jcat,jj) < xundef ) THEN
      !
      jstep = int(xtime_topd(jcat,jj) / xtopd_step) + kstep 
      !
      IF ( jstep.LE.nnb_topd_step ) THEN
        !
        xqb_run(jcat,jstep) = xqb_run(jcat,jstep) + pro(jcat,jj)
        xqtot(jcat,jstep) = xqtot(jcat,jstep) + pro(jcat,jj)
        !
      ELSEIF (jstep.LE.nnb_topd_step+nnb_stp_restart) THEN
        !
        zrun_torout(jcat,jstep) = zrun_torout(jcat,jstep) + pro(jcat,jj)  !m3
        !
      ENDIF
      !
    ENDIF
    !
  !
  !*       3.0    Drainage by geomorpho transfer function
  !               -------------------------------------
    !
    IF ((pdr(jcat,jj) > 0.0).AND.(pdr(jcat,jj)<xundef)) THEN
      !
      jstep = int(xtime_topd_drain(jcat,jj) / xtopd_step) + kstep
      !
      IF (jstep.LE.nnb_topd_step) THEN
        !
        xqb_dr(jcat,jstep) = xqb_dr(jcat,jstep) + pdr(jcat,jj)
        xqtot(jcat,jstep) = xqtot(jcat,jstep) + pdr(jcat,jj) 
        !
      ELSEIF (jstep.LE.nnb_topd_step+nnb_stp_restart) THEN
        !
        zdr_torout(jcat,jstep) = zdr_torout(jcat,jstep) + pdr(jcat,jj) !m3
        !
      ENDIF
    ENDIF
    !
  ENDDO
  ! 
  xqb_run(jcat,kstep) = xqb_run(jcat,kstep) + xrun_torout(jcat,kstep)
  xqb_dr(jcat,kstep)  = xqb_dr(jcat,kstep)  + xdr_torout(jcat,kstep)
  xqtot(jcat,kstep)   = xqtot(jcat,kstep) + xrun_torout(jcat,kstep) + xdr_torout(jcat,kstep)
  !
  xrun_torout(jcat,:) = xrun_torout(jcat,:) + zrun_torout(jcat,:)
  xdr_torout(jcat,:)  = xdr_torout(jcat,:)  + zdr_torout(jcat,:)
  !
ENDDO
!
IF (lhook) CALL dr_hook('ROUTING',1,zhook_handle)
!
END SUBROUTINE routing