SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/flowdown.F90 Source File

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     ###################
00003       SUBROUTINE FLOWDOWN(KNMC,PVAR,PCONN,KLINE)
00004 !     ###################
00005 !
00006 !!****  *FLOWDOWN*
00007 !
00008 !!    PURPOSE
00009 !!    -------
00010 ! to propagate data between pixels of a catchment in function of its topography
00011 !
00012 !
00013 !!**  METHOD
00014 !!    ------
00015 !
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!    none
00020 !!
00021 !!    IMPLICIT ARGUMENTS
00022 !!    ------------------ 
00023 !!
00024 !!    
00025 !!    
00026 !!
00027 !!      
00028 !!    REFERENCE
00029 !!    ---------
00030 !!
00031 !!    
00032 !!      
00033 !!    AUTHOR
00034 !!    ------
00035 !!
00036 !!      K. Chancibault  * CNRM / Meteo-France *
00037 !!      G-M Saulnier    * LTHE *
00038 !!
00039 !!    MODIFICATIONS
00040 !!    -------------
00041 !!
00042 !!      Original   14/01/2005
00043 !-------------------------------------------------------------------------------
00044 !
00045 !*       0.     DECLARATIONS
00046 !               ------------
00047 !
00048 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00049 USE PARKIND1  ,ONLY : JPRB
00050 !
00051 IMPLICIT NONE
00052 !
00053 !*      0.1     declarations of arguments
00054 !
00055 INTEGER, INTENT(IN) :: KNMC  ! catchment grid points number
00056 REAL, DIMENSION(:), INTENT(INOUT)   :: PVAR  ! variable to propagate
00057 REAL, DIMENSION(:,:), INTENT(IN)    :: PCONN ! catchment grid points connections
00058 INTEGER, DIMENSION(:), INTENT(IN)   :: KLINE ! 
00059 !
00060 !*      0.2    declarations of local variables
00061 !
00062 INTEGER                  :: JJ, JI ! work variables
00063 INTEGER                  :: JNUP  ! number of upslope pixels
00064 INTEGER                  :: JCOL  ! third index of the pixel in the array XCONN
00065 INTEGER                  :: JREF  ! index of the upslope pixel in the topo domain
00066 REAL                     :: ZFAC  ! propagation factor between this pixel and the
00067                                   ! upslope one
00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00069 !------------------------------------------------------------------------------
00070 IF (LHOOK) CALL DR_HOOK('FLOWDOWN',0,ZHOOK_HANDLE)
00071 !
00072 DO JJ=1,KNMC
00073    JNUP = INT(PCONN(JJ,4))
00074    DO JI=1,JNUP
00075       JCOL = ((JI-1)*2) + 5
00076       JREF = INT(PCONN(JJ,JCOL))
00077       ZFAC = PCONN(JJ,JCOL+1)
00078       PVAR(JJ) = PVAR(JJ) + PVAR(KLINE(JREF)) * ZFAC
00079    ENDDO
00080 ENDDO
00081 !
00082 IF (LHOOK) CALL DR_HOOK('FLOWDOWN',1,ZHOOK_HANDLE)
00083 !
00084 END SUBROUTINE FLOWDOWN