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

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     #####################
00003       SUBROUTINE ROUT_DATA_ISBA(HPROGRAM,KI,KSTEP)
00004 !     #####################
00005 !
00006 !!****  *ROUT_DATA_ISBA*  
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !
00011 !    Routes runoff and drainage of ISBA with coupling with Topmodel
00012 !         
00013 !     
00014 !!**  METHOD
00015 !!    ------
00016 !
00017 !!    EXTERNAL
00018 !!    --------
00019 !!
00020 !!    none
00021 !!
00022 !!    IMPLICIT ARGUMENTS
00023 !!    ------------------ 
00024 !!
00025 !!    
00026 !!    
00027 !!
00028 !!      
00029 !!    REFERENCE
00030 !!    ---------
00031 !!
00032 !!    
00033 !!      
00034 !!    AUTHOR
00035 !!    ------
00036 !!
00037 !!      B. Vincendon    *  Meteo-France *
00038 !!
00039 !!    MODIFICATIONS
00040 !!    -------------
00041 !!
00042 !!      Original   15/06/2007
00043 !-------------------------------------------------------------------------------
00044 !
00045 !*       0.     DECLARATIONS
00046 !               ------------
00047 !
00048 USE MODI_GET_LUOUT
00049 USE MODI_UNPACK_SAME_RANK
00050 USE MODI_DIAG_ISBA_TO_ROUT
00051 USE MODI_ISBA_TO_TOPD
00052 USE MODI_ROUTING
00053 !
00054 USE MODD_TOPODYN,        ONLY : NNCAT, NMESHT, NNMC
00055 USE MODD_COUPLING_TOPD,  ONLY : NMASKT, XRUNOFF_TOP, XATOP, NNPIX,&
00056                                   XAVG_RUNOFFCM, XAVG_DRAINCM
00057 !
00058 USE MODD_DIAG_EVAP_ISBA_n, ONLY : XAVG_DRAINC
00059 USE MODD_SURF_ATM_n,       ONLY : NR_NATURE
00060 USE MODD_SURF_PAR,         ONLY : XUNDEF
00061 !
00062 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00063 USE PARKIND1  ,ONLY : JPRB
00064 !
00065 IMPLICIT NONE
00066 !
00067 !*      0.1    declarations of arguments
00068 !
00069  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
00070 INTEGER, INTENT(IN)          :: KI     ! Grid dimensions
00071 INTEGER, INTENT(IN)          :: KSTEP  ! current time step 
00072 !
00073 !*      0.2    declarations of local variables
00074 !
00075 INTEGER                       :: JJ,JI  ! loop control 
00076 INTEGER                       :: IUNIT       ! unit number of results files
00077 INTEGER                       :: ILUOUT      ! unit number of listing file
00078  CHARACTER(LEN=30)             :: YVAR
00079 REAL, DIMENSION(KI)           :: ZRUNOFFC_FULL  ! Cumulated runoff from isba on the full domain (kg/m2)
00080 REAL, DIMENSION(KI)           :: ZRUNOFFC_FULLM ! Cumulated runoff from isba on the full domain (kg/m2) at t-dt
00081 REAL, DIMENSION(KI)           :: ZRUNOFF_ISBA   ! Runoff from Isba (kg/m2)
00082 REAL, DIMENSION(KI)           :: ZDRAINC_FULL   ! Cumulated drainage from Isba on the full domain (kg/m2)
00083 REAL, DIMENSION(KI)           :: ZDRAINC_FULLM  ! Cumulated drainage from Isba on the full domain (kg/m2) at t-dt
00084 REAL, DIMENSION(KI)           :: ZDRAIN_ISBA    ! Drainage from Isba (m3/s)
00085 REAL, DIMENSION(NNCAT,NMESHT) :: ZRUNOFF_TOPD   ! Runoff on the Topodyn grid (m3/s)
00086 REAL, DIMENSION(NNCAT,NMESHT) :: ZDRAIN_TOPD    ! Drainage from Isba on Topodyn grid (m3/s)
00087 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00088 !-------------------------------------------------------------------------------
00089 IF (LHOOK) CALL DR_HOOK('ROUT_DATA_ISBA',0,ZHOOK_HANDLE)
00090 !
00091  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00092 !
00093 ZRUNOFFC_FULL (:) = 0.
00094 ZRUNOFFC_FULLM(:) = 0.
00095 ZRUNOFF_ISBA  (:) = 0.
00096 ZRUNOFF_TOPD(:,:) = 0.
00097 ZDRAINC_FULL  (:) = 0.
00098 ZDRAINC_FULLM (:) = 0.
00099 ZDRAIN_ISBA   (:) = 0.
00100 ZDRAIN_TOPD (:,:) = 0.
00101 !
00102 !    Runoff on TOPODYN grid
00103 !   ---------------------------------------
00104 !
00105  CALL UNPACK_SAME_RANK(NR_NATURE,XRUNOFF_TOP,ZRUNOFFC_FULL)
00106  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_RUNOFFCM,ZRUNOFFC_FULLM)
00107 !
00108  CALL DIAG_ISBA_TO_ROUT(ZRUNOFFC_FULL,ZRUNOFFC_FULLM,ZRUNOFF_ISBA)
00109 !
00110 XAVG_RUNOFFCM(:) = XRUNOFF_TOP(:)
00111 ZRUNOFF_TOPD(:,:) = 0.0
00112 !
00113  CALL ISBA_TO_TOPD(ZRUNOFF_ISBA,ZRUNOFF_TOPD)
00114 !
00115 DO JJ=1,NNCAT
00116   DO JI=1,NNMC(JJ)
00117     ZRUNOFF_TOPD(JJ,JI) = ZRUNOFF_TOPD(JJ,JI) / NNPIX(NMASKT(JJ,JI))
00118   ENDDO
00119 ENDDO
00120 !
00121 !    Drainage treatment
00122 !    ----------------------------------------
00123 !
00124  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_DRAINC*XATOP,ZDRAINC_FULL)
00125  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_DRAINCM*XATOP,ZDRAINC_FULLM)
00126 !
00127  CALL DIAG_ISBA_TO_ROUT(ZDRAINC_FULL,ZDRAINC_FULLM,ZDRAIN_ISBA)
00128 !
00129 XAVG_DRAINCM(:)  = XAVG_DRAINC(:)
00130 ZDRAIN_TOPD(:,:) = 0.0
00131 !
00132  CALL ISBA_TO_TOPD(ZDRAIN_ISBA,ZDRAIN_TOPD)
00133 !
00134 DO JJ=1,NNCAT
00135   DO JI=1,NNMC(JJ)
00136     ZDRAIN_TOPD(JJ,JI) = ZDRAIN_TOPD(JJ,JI) / NNPIX(NMASKT(JJ,JI))
00137   ENDDO
00138 ENDDO
00139 !*     Routing (runoff + drainage)
00140 !     ----------------------------------------
00141 !
00142  CALL ROUTING(ZRUNOFF_TOPD,ZDRAIN_TOPD,KSTEP)
00143 !
00144 IF (LHOOK) CALL DR_HOOK('ROUT_DATA_ISBA',1,ZHOOK_HANDLE)
00145 !
00146 END SUBROUTINE ROUT_DATA_ISBA