SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/isba_to

Go to the documentation of this file.
00001 !-------------------------------------------------------------------------------
00002 !     ####################
00003       SUBROUTINE ISBA_TO_TOPDSAT(PKAPPA,PKAPPAC,KI,PRO_I,PRO_T)
00004 !     ####################
00005 !
00006 !!****  *ISBA_TO_TOPDSAT*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !     
00011 !         
00012 !     
00013 !!**  METHOD
00014 !!    ------
00015 !
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!    none
00020 !!
00021 !!    IMPLICIT ARGUMENTS
00022 !!    ------------------ 
00023 !!
00024 !!
00025 !!      
00026 !!    REFERENCE
00027 !!    ---------
00028 !!
00029 !!    
00030 !!      
00031 !!    AUTHOR
00032 !!    ------
00033 !!
00034 !!      K. Chancibault  * LTHE / Meteo-France *
00035 !!
00036 !!    MODIFICATIONS
00037 !!    -------------
00038 !!
00039 !!      Original   23/11/2005
00040 !-------------------------------------------------------------------------------
00041 !
00042 !*       0.     DECLARATIONS
00043 !               ------------
00044 !
00045 USE MODD_SURF_PAR,  ONLY : XUNDEF,NUNDEF
00046 !
00047 USE MODD_TOPODYN, ONLY : NNCAT, NNMC, NMESHT
00048 USE MODD_COUPLING_TOPD,ONLY: NMASKI, NMASKT, NNPIX
00049 !
00050 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00051 USE PARKIND1  ,ONLY : JPRB
00052 !
00053 IMPLICIT NONE
00054 !
00055 !*      0.1    declarations of arguments
00056 !
00057 INTEGER, INTENT(IN)              :: KI      ! Number of Isba meshes
00058 REAL, DIMENSION(:,:), INTENT(IN) :: PKAPPA  ! Hydrological indexes on the catchments 
00059                                             ! at the previous time step
00060 REAL, DIMENSION(:), INTENT(IN)   :: PKAPPAC ! Hydrological index at saturation at the 
00061                                             ! previous time step
00062 REAL, DIMENSION(:), INTENT(IN)   :: PRO_I   ! Runoff on Isba grid
00063 REAL, DIMENSION(:,:), INTENT(OUT):: PRO_T   ! Runoff on TOPODYN grid
00064 !
00065 !
00066 !*      0.2    declarations of local variables
00067 !
00068 INTEGER                          :: JCAT, JPIX, JMESH_ISBA,JJ ! Loop indexes
00069 INTEGER, DIMENSION(KI)           :: INSAT       ! number of saturated pixels in an ISBA mesh
00070 INTEGER, DIMENSION(KI)           :: INDRY       ! Number of non-saturated pixels in an ISBA mesh
00071 REAL, DIMENSION(NNCAT,NMESHT)    :: ZROSAT      ! 
00072 REAL, DIMENSION(NNCAT,NMESHT)    :: ZRODRY      ! 
00073  CHARACTER(LEN=30)                :: YVAR        ! name of results file
00074 !
00075 REAL::ZSMALL,ZTMP,ZTMP2
00076 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00077 !-------------------------------------------------------------------------------
00078 IF (LHOOK) CALL DR_HOOK('ISBA_TO_TOPDSAT',0,ZHOOK_HANDLE)
00079 !
00080 !*       0.     Initialization :
00081 !               --------------
00082 !
00083 INSAT(:)=0
00084 INDRY(:)=0
00085 ZROSAT(:,:)=0.0
00086 ZRODRY(:,:)=0.0
00087 !
00088 ! Only Isba meshes over studied catchments are scanned
00089 DO JMESH_ISBA = 1,KI
00090   !
00091   DO JCAT = 1,NNCAT
00092     !
00093     JJ=1
00094     JPIX=NMASKI(JMESH_ISBA,JCAT,JJ)
00095     !
00096     DO WHILE (JPIX/=NUNDEF .AND.(JJ<=SIZE(NMASKI,3)))
00097       !
00098       IF (PKAPPA(JCAT,JPIX)/=XUNDEF .AND. NMASKT(JCAT,JPIX)/=NUNDEF) THEN
00099         ! Calculation of the saturated and dry catchment pixels in each Isba mesh
00100         IF (PKAPPA(JCAT,JPIX).GE.PKAPPAC(JCAT)) THEN
00101           INSAT(NMASKT(JCAT,JPIX)) = INSAT(NMASKT(JCAT,JPIX)) + 1
00102           ZROSAT(JCAT,JPIX) = PRO_I(NMASKT(JCAT,JPIX))
00103         ELSE
00104           INDRY(NMASKT(JCAT,JPIX)) = INDRY(NMASKT(JCAT,JPIX)) + 1 
00105           ZRODRY(JCAT,JPIX) = PRO_I(NMASKT(JCAT,JPIX))
00106         ENDIF
00107       ENDIF
00108       !
00109       JJ=JJ+1
00110       IF (JJ<=SIZE(NMASKI,3)) JPIX=NMASKI(JMESH_ISBA,JCAT,JJ)
00111       !
00112     ENDDO
00113     !
00114   ENDDO
00115   !
00116 ENDDO
00117 !
00118 !
00119 DO JCAT = 1,NNCAT
00120   !
00121   DO JPIX = 1,NNMC(JCAT)
00122     !
00123     IF (NMASKT(JCAT,JPIX)/=NUNDEF) THEN
00124       ! calculation of the runoff and deep drainage to rout in each Isba mesh, for each catchment
00125       IF (INSAT(NMASKT(JCAT,JPIX)).GT.0 .AND. PKAPPA(JCAT,JPIX)/=XUNDEF) THEN
00126         PRO_T(JCAT,JPIX) = ZROSAT(JCAT,JPIX) / INSAT(NMASKT(JCAT,JPIX))
00127         ! if no runoff : calculation of the deep drainage to rout in each Isba mesh for each catchment
00128       ELSEIF (INDRY(NMASKT(JCAT,JPIX)).GT.0 .AND. PKAPPA(JCAT,JPIX)/=XUNDEF) THEN
00129         PRO_T(JCAT,JPIX) = ZRODRY(JCAT,JPIX) / INDRY(NMASKT(JCAT,JPIX))
00130       ELSE
00131         PRO_T(JCAT,JPIX) = 0.
00132       ENDIF
00133     ENDIF
00134     !
00135   ENDDO
00136   !
00137   ! budget control 
00138   ZTMP=0.
00139   ZTMP2=0.
00140   !
00141   DO JPIX = 1,NNMC(JCAT)
00142     !
00143     IF (PRO_T(JCAT,JPIX)/=XUNDEF) ZTMP = ZTMP + PRO_T(JCAT,JPIX)
00144     IF ( NMASKT(JCAT,JPIX)/=NUNDEF) THEN
00145       IF (PRO_I(NMASKT(JCAT,JPIX))/=XUNDEF .AND. NNPIX(NMASKT(JCAT,JPIX))/=0 ) &
00146       ZTMP2 = ZTMP2 + PRO_I(NMASKT(JCAT,JPIX)) / NNPIX(NMASKT(JCAT,JPIX))
00147     ENDIF
00148     !
00149   ENDDO!JPIX
00150   !
00151   ZSMALL=ABS(ZTMP2*0.001)
00152   !
00153   IF( ABS(ZTMP-ZTMP2) > ZSMALL ) THEN
00154     WHERE ( PRO_T(JCAT,:)/=XUNDEF )
00155       PRO_T(JCAT,:) = PRO_T(JCAT,:)- ((ZTMP-ZTMP2)/NNMC(JCAT))
00156     ENDWHERE
00157   ENDIF
00158   !
00159 ENDDO
00160 !
00161 IF (LHOOK) CALL DR_HOOK('ISBA_TO_TOPDSAT',1,ZHOOK_HANDLE)
00162 !
00163 END SUBROUTINE ISBA_TO_TOPDSAT