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

Go to the documentation of this file.
00001 !     ##########################
00002       SUBROUTINE INIT_BUDGET_COUPL_ROUT(KNI)
00003 !     ##########################
00004 !
00005 !!
00006 !!    PURPOSE
00007 !!    -------
00008 !    Initialise varriables usefull for budget computation    
00009 !     
00010 !!**  METHOD
00011 !!    ------
00012 !!    Terms of the budget on all the domain
00013 !!    XB_VAR_TOT(forcing time step,variable)
00014 !!    Water going in the system
00015 !!      variable =1 : Rain
00016 !!      variable =2 : Snow
00017 !!    Water going out of the system
00018 !!      variable =3 : Incerception 
00019 !!      variable =4 : Evaporation
00020 !!      variable =5 : Runoff
00021 !!      variable =6 : Drainage
00022 !!      variable =7 : Variation of liquid water stocked in the ground
00023 !!      variable =8 : Variation of solid water stocked in the ground
00024 !!      variable =9 : Variation of melting snow
00025 !!    Budget 
00026 !!      variable =10:  Water going in the system- Water going out of the system
00027 !!    
00028 !!    Terms of the budget on a given catchment
00029 !!    XB_VAR_BV(forcing time step,catchment,variable)
00030 !!    XB_VAR_NOBV(forcing time step,catchment,variable)
00031 !!    
00032 !!    EXTERNAL
00033 !!    --------
00034 !!
00035 !!    none
00036 !!
00037 !!    IMPLICIT ARGUMENTS
00038 !!    ------------------ 
00039 !!      
00040 !!    REFERENCE
00041 !!    ---------
00042 !!     
00043 !!    AUTHOR
00044 !!    ------
00045 !!
00046 !!    L. Bouilloud &  B. Vincendon      * Meteo-France *
00047 
00048 !!    
00049 !!    MODIFICATIONS
00050 !!    -------------
00051 !!
00052 !!      Original  03/2008 
00053 !-------------------------------------------------------------------------------
00054 !
00055 !*       0.     DECLARATIONS
00056 !               ------------
00057 !
00058       ! declarative modules
00059 USE MODD_BUDGET_COUPL_ROUT ! contains all useful variables XB_*
00060 !
00061 USE MODD_TOPODYN,       ONLY : NNCAT, NNMC, XQTOT,&
00062                                  NNB_TOPD_STEP, XDXT, XQB_DR, XQB_RUN
00063 USE MODD_COUPLING_TOPD, ONLY : XAS_NATURE,  NNB_TOPD,&
00064                                  XRUNOFF_TOP, XATOP, XBV_IN_MESH
00065 USE MODD_ISBA_n,          ONLY : XWG, XDG,  XWR, CRUNOFF, XWGI, TSNOW
00066 USE MODD_DIAG_EVAP_ISBA_n,ONLY : XAVG_EVAPC, XAVG_LEGC, XAVG_RUNOFFC ,XAVG_DRAINC,&
00067                                  XAVG_DRAIN, XAVG_RUNOFF, XAVG_EVAP !ludo
00068 USE MODD_ISBA_GRID_n,     ONLY : XMESH_SIZE !ludo
00069 USE MODD_SURF_ATM_n,      ONLY : NR_NATURE
00070 !
00071 USE MODD_SURF_PAR,         ONLY:XUNDEF
00072 !
00073 USE MODI_UNPACK_SAME_RANK
00074 !
00075 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00076 USE PARKIND1  ,ONLY : JPRB
00077 !
00078 IMPLICIT NONE
00079 !
00080 !*      0.1    declarations of arguments
00081 !
00082 INTEGER, INTENT(IN)           :: KNI      ! expected physical size of full surface array
00083 !
00084 !*      0.2    declarations of local variables
00085 !
00086 INTEGER    :: JJ,JWRK2
00087 !
00088 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00089 !-------------------------------------------------------------------------------
00090 IF (LHOOK) CALL DR_HOOK('INIT_BUDGET_COUPL_ROUT',0,ZHOOK_HANDLE)
00091 !
00092 !*       0.     Initialization:
00093 !               ---------------
00094 !
00095 !write(*,*) 'In init_budget_coupl_rout KNI=',KNI
00096 ALLOCATE(YB_VAR(10)) 
00097 YB_VAR(1)='RAIN  '
00098 YB_VAR(2)='SNOW  '
00099 YB_VAR(3)='INTERC'
00100 YB_VAR(4)='EVATRA'
00101 YB_VAR(5)='RUNOFF'
00102 YB_VAR(6)='DRAINA'
00103 YB_VAR(7)='DSTOWG'
00104 YB_VAR(8)='DSTOWI'
00105 YB_VAR(9)='DSTOSW'
00106 YB_VAR(10)='BUDGET'
00107 !   
00108 !
00109 ALLOCATE(XB_RAIN(KNI))
00110 ALLOCATE(XB_SNOW(KNI))
00111 !
00112 ALLOCATE(XB_WR(KNI))
00113 ALLOCATE(XB_EVAP(KNI))
00114 ALLOCATE(XB_RUNOFF_ISBA(KNI))
00115 ALLOCATE(XB_DRAIN(KNI))
00116 ALLOCATE(XB_WG2(KNI))
00117 ALLOCATE(XB_WG3(KNI))
00118 ALLOCATE(XB_WGTOT(KNI))
00119 ALLOCATE(XB_WGI2(KNI))
00120 ALLOCATE(XB_WGI3(KNI))
00121 ALLOCATE(XB_WGITOT(KNI))
00122 ALLOCATE(XB_SWE1(KNI))
00123 ALLOCATE(XB_SWE2(KNI))
00124 ALLOCATE(XB_SWE3(KNI))
00125 ALLOCATE(XB_SWETOT(KNI))
00126 !
00127 ALLOCATE(XB_WRM(KNI))
00128 ALLOCATE(XB_EVAPM(KNI))
00129 ALLOCATE(XB_DRAINM(KNI))
00130 ALLOCATE(XB_RUNOFF_ISBAM(KNI))
00131 ALLOCATE(XB_WG2M(KNI))
00132 ALLOCATE(XB_WG3M(KNI))
00133 ALLOCATE(XB_WGTOTM(KNI))
00134 ALLOCATE(XB_WGI2M(KNI))
00135 ALLOCATE(XB_WGI3M(KNI))
00136 ALLOCATE(XB_WGITOTM(KNI))
00137 ALLOCATE(XB_SWE1M(KNI))
00138 ALLOCATE(XB_SWE2M(KNI))
00139 ALLOCATE(XB_SWE3M(KNI))   
00140 ALLOCATE(XB_SWETOTM(KNI))
00141 !
00142 ALLOCATE(XB_MESH_SIZE(KNI))
00143 ALLOCATE(XB_DG2(KNI))
00144 ALLOCATE(XB_DG3(KNI))
00145 !
00146  CALL UNPACK_SAME_RANK(NR_NATURE,XWR(:,1),XB_WRM)
00147  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_EVAPC,XB_EVAPM)
00148  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_RUNOFFC,XB_RUNOFF_ISBAM)
00149  CALL UNPACK_SAME_RANK(NR_NATURE,XAVG_DRAINC,XB_DRAINM)
00150  CALL UNPACK_SAME_RANK(NR_NATURE,XWG(:,2,1),XB_WG2M)
00151  CALL UNPACK_SAME_RANK(NR_NATURE,XWG(:,3,1),XB_WG3M)
00152  CALL UNPACK_SAME_RANK(NR_NATURE,XDG(:,2,1),XB_DG2)
00153  CALL UNPACK_SAME_RANK(NR_NATURE,XDG(:,3,1),XB_DG3)
00154 !
00155 WHERE ( XB_WG2M/=XUNDEF .AND. XB_DG2/=XUNDEF .AND. XB_WG3M/=XUNDEF .AND. XB_DG3/=XUNDEF )
00156   XB_WGTOTM(:) = XB_WG2M(:)*XB_DG2(:) + XB_WG3M(:)*(XB_DG3(:)-XB_DG2(:)) !m3/m2
00157 ELSEWHERE
00158   XB_WGTOTM(:) = XUNDEF
00159 ENDWHERE
00160 !
00161  CALL UNPACK_SAME_RANK(NR_NATURE,XWGI(:,2,1),XB_WGI2M)
00162  CALL UNPACK_SAME_RANK(NR_NATURE,XWGI(:,3,1),XB_WGI3M)
00163 WHERE ((XB_WGI2M/=XUNDEF).AND.(XB_DG2/=XUNDEF).AND.(XB_WGI3M/=XUNDEF).AND.(XB_DG3/=XUNDEF))
00164   XB_WGITOTM(:) = XB_WGI2M(:)*XB_DG2(:) + XB_WGI3M(:)*(XB_DG3(:)-XB_DG2(:)) !m3/m2
00165 ELSEWHERE
00166   XB_WGITOTM(:) = XUNDEF
00167 ENDWHERE
00168 !
00169  CALL UNPACK_SAME_RANK(NR_NATURE,TSNOW%WSNOW(:,1,1),XB_SWE1M)
00170  CALL UNPACK_SAME_RANK(NR_NATURE,TSNOW%WSNOW(:,2,1),XB_SWE2M)
00171  CALL UNPACK_SAME_RANK(NR_NATURE,TSNOW%WSNOW(:,3,1),XB_SWE3M)
00172 XB_SWETOTM(:) = XB_SWE1M(:)+XB_SWE2M(:)+XB_SWE3M(:)
00173 !
00174  CALL UNPACK_SAME_RANK(NR_NATURE,XMESH_SIZE,XB_MESH_SIZE)
00175 !
00176 ALLOCATE(XB_ABV_BYMESH(KNI,NNCAT))
00177 DO JJ=1,KNI
00178   XB_ABV_BYMESH(JJ,:) = XBV_IN_MESH(JJ,:)/XB_MESH_SIZE(JJ) !*NNMC(:)*XDXT(:)**2 ! 
00179   XB_ABV_BYMESH(JJ,:) = MIN(1.,XB_ABV_BYMESH(JJ,:))      
00180 ENDDO
00181 ! 
00182 ALLOCATE(XB_VAR_BV(NNB_TOPD_STEP,NNCAT,10))
00183 XB_VAR_BV(:,:,:) = 0.
00184 ALLOCATE(XB_VAR_NOBV(NNB_TOPD_STEP,NNCAT,10))
00185 XB_VAR_NOBV(:,:,:) = 0.
00186 ! 
00187 ALLOCATE(XB_VAR_TOT(NNB_TOPD_STEP,10))
00188 XB_VAR_TOT(:,:) = 0.
00189 !
00190 ALLOCATE(XB_RUNOFF_TOPD(KNI))
00191 ALLOCATE(XB_RUNOFF_TOPDM(KNI))
00192 ALLOCATE(XB_ATOP_BYMESH(KNI))
00193 !  
00194  CALL UNPACK_SAME_RANK(NR_NATURE,XATOP,XB_ATOP_BYMESH)
00195 IF(CRUNOFF=='TOPD')THEN
00196   CALL UNPACK_SAME_RANK(NR_NATURE,XRUNOFF_TOP,XB_RUNOFF_TOPDM)
00197 ELSE
00198   XB_RUNOFF_TOPDM = XB_RUNOFF_ISBAM
00199 ENDIF
00200 !
00201 ALLOCATE(YB_VARQ(5)) 
00202 YB_VARQ(1)='Q_TOT '
00203 YB_VARQ(2)='Q_RUN '
00204 YB_VARQ(3)='Q_DR  '
00205 YB_VARQ(4)='ST_RUN'
00206 YB_VARQ(5)='ST_DR '
00207 !
00208 !
00209 ALLOCATE(XB_QTOT(NNCAT))
00210 ALLOCATE(XB_QDR(NNCAT))
00211 ALLOCATE(XB_QRUN(NNCAT))
00212 ALLOCATE(XB_VAR_Q(NNB_TOPD_STEP,NNCAT,5))
00213 !
00214 ALLOCATE(XB_QTOTM(NNCAT))
00215 ALLOCATE(XB_QDRM(NNCAT))
00216 ALLOCATE(XB_QRUNM(NNCAT))
00217 ! 
00218 !init var bilan q
00219 !
00220 XB_QTOT(:)=0.
00221 XB_QDR(:) =0.
00222 XB_QRUN(:)=0.
00223 !
00224 XB_VAR_Q(:,:,:)=0
00225 !
00226 DO JJ=1,NNCAT
00227   XB_QTOTM(JJ) = SUM(XQTOT(JJ,:))
00228   XB_QRUNM(JJ) = SUM(XQB_RUN(JJ,:))
00229   XB_QDRM(JJ)  = SUM(XQB_DR(JJ,:))
00230 ENDDO
00231 !
00232 IF (LHOOK) CALL DR_HOOK('INIT_BUDGET_COUPL_ROUT',1,ZHOOK_HANDLE)
00233 !
00234 END SUBROUTINE INIT_BUDGET_COUPL_ROUT