flowdown.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 flowdown(KNMC,PVAR,PCONN,KLINE)
!     ###################
!
!!****  *FLOWDOWN*
!
!!    PURPOSE
!!    -------
! to propagate data between pixels of a catchment in function of its topography
!
!
!!**  METHOD
!!    ------
!
!!    EXTERNAL
!!    --------
!!
!!    none
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    
!!    
!!
!!      
!!    REFERENCE
!!    ---------
!!
!!    
!!      
!!    AUTHOR
!!    ------
!!
!!      K. Chancibault  * CNRM / Meteo-France *
!!      G-M Saulnier    * LTHE *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original   14/01/2005
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1     declarations of arguments
!
INTEGER, INTENT(IN) :: knmc  ! catchment grid points number
REAL, DIMENSION(:), INTENT(INOUT)   :: pvar  ! variable to propagate
REAL, DIMENSION(:,:), INTENT(IN)    :: pconn ! catchment grid points connections
INTEGER, DIMENSION(:), INTENT(IN)   :: kline ! 
!
!*      0.2    declarations of local variables
!
INTEGER                  :: jj, ji ! work variables
INTEGER                  :: jnup  ! number of upslope pixels
INTEGER                  :: jcol  ! third index of the pixel in the array XCONN
INTEGER                  :: jref  ! index of the upslope pixel in the topo domain
REAL                     :: zfac  ! propagation factor between this pixel and the
                                  ! upslope one
REAL(KIND=JPRB) :: zhook_handle
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('FLOWDOWN',0,zhook_handle)
!
DO jj=1,knmc
   jnup = int(pconn(jj,4))
   DO ji=1,jnup
      jcol = ((ji-1)*2) + 5
      jref = int(pconn(jj,jcol))
      zfac = pconn(jj,jcol+1)
      pvar(jj) = pvar(jj) + pvar(kline(jref)) * zfac
   ENDDO
ENDDO
!
IF (lhook) CALL dr_hook('FLOWDOWN',1,zhook_handle)
!
END SUBROUTINE flowdown