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

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