SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/diag_evap

Go to the documentation of this file.
00001 !     #########
00002 SUBROUTINE DIAG_EVAP_ISBA_n(HPHOTO,PTSTEP,KMASK,KSIZE,KPATCH,PRHOA)
00003 !     ###############################################################################
00004 !
00005 !!****  *DIAG_EVAP-ISBA_n * - additional diagnostics for ISBA
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !
00010 !!**  METHOD
00011 !!    ------
00012 !!
00013 !!    REFERENCE
00014 !!    ---------
00015 !!      
00016 !!
00017 !!    AUTHOR
00018 !!    ------
00019 !!     P. LeMoigne 
00020 !!
00021 !!    MODIFICATIONS
00022 !!    -------------
00023 !!      Original    01/2004
00024 !!                     2008      New diag
00025 !!      B. Decharme    2012      New snow diag LESL
00026 !!                               Add carbon fluxes diag
00027 !!                               Add isba water budget diag
00028 !!------------------------------------------------------------------
00029 !
00030 USE MODD_ISBA_n,              ONLY : LGLACIER, CPHOTO, TSNOW
00031 !
00032 USE MODD_PACK_ISBA,           ONLY : XP_LE
00033 USE MODD_PACK_DIAG_ISBA,      ONLY : XP_RN, XP_H, XP_GFLUX, XP_LEI,  &
00034                                        XP_LEG, XP_LEGI, XP_LEV,      &
00035                                        XP_LES, XP_LER, XP_LETR,      &
00036                                        XP_EVAP, XP_DRAIN, XP_RUNOFF, &
00037                                        XP_HORT, XP_MELT, XP_DRIP,    &
00038                                        XP_IFLOOD, XP_PFLOOD,         &
00039                                        XP_LE_FLOOD, XP_SWD, XP_SWU,  &
00040                                        XP_LWD, XP_LWU, XP_FMU,       &
00041                                        XP_FMV, XP_ICEFLUX, XP_LESL,  &
00042                                        XP_LEI_FLOOD, XP_RRVEG,       & 
00043                                        XP_IRRIG_FLUX, XP_GPP,        &
00044                                        XP_RESP_AUTO, XP_RESP_ECO,    &
00045                                        XP_DWG,XP_DWGI,XP_DWR,        &
00046                                        XP_DSWE,XP_WATBUD                                       
00047 
00048 USE MODD_DIAG_EVAP_ISBA_n,    ONLY : LSURF_EVAP_BUDGET, LSURF_BUDGETC,    &
00049                                        LWATER_BUDGET,                     &
00050                                        XLEG, XLEGI, XLEV, XLES, XLESL,    &
00051                                        XLER, XLETR, XEVAP, XDRAIN,        &
00052                                        XRUNOFF, XHORT, XMELT, XDRIP,      &
00053                                        XRRVEG, XRNC, XHC, XLEC, XGFLUXC,  &
00054                                        XLEGC, XLEGIC, XLEVC, XLESC,       &
00055                                        XLESLC, XLERC, XLETRC, XEVAPC,     &
00056                                        XLEIC, XDRAINC, XRUNOFFC, XHORTC,  &
00057                                        XMELTC, XDRIPC, XRRVEGC,           &
00058                                        XIFLOOD, XIFLOODC,                 &
00059                                        XPFLOOD, XPFLOODC,                 &
00060                                        XLE_FLOOD, XLE_FLOODC,             &
00061                                        XLEI_FLOOD, XLEI_FLOODC, XICEFLUXC,&
00062                                        XIRRIG_FLUX, XIRRIG_FLUXC,         &
00063                                        XGPP, XRESP_AUTO, XRESP_ECO,       &
00064                                        XGPPC, XRESPC_AUTO, XRESPC_ECO,    &
00065                                        XDWG,XDWGI,XDWR,XDSWE,XWATBUD,     &
00066                                        XDWGC,XDWGIC,XDWRC,XDSWEC,XWATBUDC
00067 
00068 !
00069 USE MODD_DIAG_ISBA_n,         ONLY : XSWDC, XSWUC, XLWDC, XLWUC, XFMUC, XFMVC
00070 !
00071 !
00072 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00073 USE PARKIND1  ,ONLY : JPRB
00074 !
00075 IMPLICIT NONE
00076 !
00077 !*      0.1    declarations of arguments
00078 !
00079  CHARACTER(LEN=*), INTENT(IN)      :: HPHOTO        ! type of photosynthesis
00080 REAL,    INTENT(IN)               :: PTSTEP        ! time step
00081 INTEGER, INTENT(IN)               :: KSIZE, KPATCH   
00082 !
00083 INTEGER, DIMENSION(:), INTENT(IN) :: KMASK
00084 REAL,    DIMENSION(:), INTENT(IN) :: PRHOA         ! air density for unit change
00085 !
00086 INTEGER :: JJ
00087 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00088 !
00089 !*      0.2    declarations of local variables
00090 !
00091 !-------------------------------------------------------------------------------------
00092 !
00093 IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_ISBA_N',0,ZHOOK_HANDLE)
00094 !
00095 IF (LSURF_EVAP_BUDGET) THEN
00096 !cdir nodep
00097   DO JJ=1,KSIZE
00098      !
00099      XLEG       (KMASK(JJ), KPATCH)  =  XP_LEG        (JJ)
00100      XLEGI      (KMASK(JJ), KPATCH)  =  XP_LEGI       (JJ)
00101      XLEV       (KMASK(JJ), KPATCH)  =  XP_LEV        (JJ)
00102      XLES       (KMASK(JJ), KPATCH)  =  XP_LES        (JJ)
00103      XLER       (KMASK(JJ), KPATCH)  =  XP_LER        (JJ)
00104      XLETR      (KMASK(JJ), KPATCH)  =  XP_LETR       (JJ)
00105      XEVAP      (KMASK(JJ), KPATCH)  =  XP_EVAP       (JJ)
00106      XDRAIN     (KMASK(JJ), KPATCH)  =  XP_DRAIN      (JJ)
00107      XRUNOFF    (KMASK(JJ), KPATCH)  =  XP_RUNOFF     (JJ)
00108      XHORT      (KMASK(JJ), KPATCH)  =  XP_HORT       (JJ)
00109      XDRIP      (KMASK(JJ), KPATCH)  =  XP_DRIP       (JJ)
00110      XRRVEG     (KMASK(JJ), KPATCH)  =  XP_RRVEG      (JJ)
00111      XMELT      (KMASK(JJ), KPATCH)  =  XP_MELT       (JJ)
00112      XIFLOOD    (KMASK(JJ), KPATCH)  =  XP_IFLOOD     (JJ)
00113      XPFLOOD    (KMASK(JJ), KPATCH)  =  XP_PFLOOD     (JJ)
00114      XLE_FLOOD  (KMASK(JJ), KPATCH)  =  XP_LE_FLOOD   (JJ)
00115      XLEI_FLOOD (KMASK(JJ), KPATCH)  =  XP_LEI_FLOOD  (JJ)
00116      XIRRIG_FLUX(KMASK(JJ), KPATCH)  =  XP_IRRIG_FLUX (JJ)
00117      !
00118   END DO
00119   !
00120   IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00121 !cdir nodep
00122      DO JJ=1,KSIZE
00123         XLESL    (KMASK(JJ), KPATCH)  =  XP_LESL       (JJ)
00124      END DO
00125   END IF
00126   !
00127   IF(HPHOTO/='NON')THEN
00128 !cdir nodep
00129      DO JJ=1,KSIZE
00130         ! Transform units from kgCO2/kgair m/s to kgCO2/m2/s
00131         XGPP       (KMASK(JJ), KPATCH)  =  XP_GPP       (JJ) * PRHOA(JJ)
00132         XRESP_AUTO (KMASK(JJ), KPATCH)  =  XP_RESP_AUTO (JJ) * PRHOA(JJ)
00133         XRESP_ECO  (KMASK(JJ), KPATCH)  =  XP_RESP_ECO  (JJ) * PRHOA(JJ)
00134         !
00135      END DO
00136   ELSE  
00137      XGPP      (:,:)=0.0
00138      XRESP_AUTO(:,:)=0.0
00139      XRESP_ECO (:,:)=0.0
00140   ENDIF
00141   !
00142   IF(LWATER_BUDGET)THEN
00143 !cdir nodep
00144      DO JJ=1,KSIZE
00145         XDWG   (KMASK(JJ), KPATCH)  =  XP_DWG   (JJ)
00146         XDWGI  (KMASK(JJ), KPATCH)  =  XP_DWGI  (JJ)
00147         XDWR   (KMASK(JJ), KPATCH)  =  XP_DWR   (JJ)
00148         XDSWE  (KMASK(JJ), KPATCH)  =  XP_DSWE  (JJ)
00149         XWATBUD(KMASK(JJ), KPATCH)  =  XP_WATBUD(JJ)
00150      END DO
00151   ENDIF
00152   !
00153 END IF
00154 !
00155 IF (LSURF_BUDGETC) THEN
00156 !cdir nodep
00157   DO JJ=1,KSIZE
00158      !
00159      XRNC        (KMASK(JJ), KPATCH)  =  XRNC        (KMASK(JJ), KPATCH) + XP_RN        (JJ) * PTSTEP
00160      XHC         (KMASK(JJ), KPATCH)  =  XHC         (KMASK(JJ), KPATCH) + XP_H         (JJ) * PTSTEP
00161      XLEC        (KMASK(JJ), KPATCH)  =  XLEC        (KMASK(JJ), KPATCH) + XP_LE        (JJ) * PTSTEP
00162      XLEIC       (KMASK(JJ), KPATCH)  =  XLEIC       (KMASK(JJ), KPATCH) + XP_LEI       (JJ) * PTSTEP
00163      XGFLUXC     (KMASK(JJ), KPATCH)  =  XGFLUXC     (KMASK(JJ), KPATCH) + XP_GFLUX     (JJ) * PTSTEP
00164      XLEGC       (KMASK(JJ), KPATCH)  =  XLEGC       (KMASK(JJ), KPATCH) + XP_LEG       (JJ) * PTSTEP
00165      XLEGIC      (KMASK(JJ), KPATCH)  =  XLEGIC      (KMASK(JJ), KPATCH) + XP_LEGI      (JJ) * PTSTEP
00166      XLEVC       (KMASK(JJ), KPATCH)  =  XLEVC       (KMASK(JJ), KPATCH) + XP_LEV       (JJ) * PTSTEP
00167      XLESC       (KMASK(JJ), KPATCH)  =  XLESC       (KMASK(JJ), KPATCH) + XP_LES       (JJ) * PTSTEP
00168      XLERC       (KMASK(JJ), KPATCH)  =  XLERC       (KMASK(JJ), KPATCH) + XP_LER       (JJ) * PTSTEP
00169      XLETRC      (KMASK(JJ), KPATCH)  =  XLETRC      (KMASK(JJ), KPATCH) + XP_LETR      (JJ) * PTSTEP
00170      XEVAPC      (KMASK(JJ), KPATCH)  =  XEVAPC      (KMASK(JJ), KPATCH) + XP_EVAP      (JJ) * PTSTEP
00171      XDRAINC     (KMASK(JJ), KPATCH)  =  XDRAINC     (KMASK(JJ), KPATCH) + XP_DRAIN     (JJ) * PTSTEP
00172      XRUNOFFC    (KMASK(JJ), KPATCH)  =  XRUNOFFC    (KMASK(JJ), KPATCH) + XP_RUNOFF    (JJ) * PTSTEP
00173      XHORTC      (KMASK(JJ), KPATCH)  =  XHORTC      (KMASK(JJ), KPATCH) + XP_HORT      (JJ) * PTSTEP
00174      XDRIPC      (KMASK(JJ), KPATCH)  =  XDRIPC      (KMASK(JJ), KPATCH) + XP_DRIP      (JJ) * PTSTEP
00175      XRRVEGC     (KMASK(JJ), KPATCH)  =  XRRVEGC     (KMASK(JJ), KPATCH) + XP_RRVEG     (JJ) * PTSTEP
00176      XMELTC      (KMASK(JJ), KPATCH)  =  XMELTC      (KMASK(JJ), KPATCH) + XP_MELT      (JJ) * PTSTEP
00177      XIFLOODC    (KMASK(JJ), KPATCH)  =  XIFLOODC    (KMASK(JJ), KPATCH) + XP_IFLOOD    (JJ) * PTSTEP
00178      XPFLOODC    (KMASK(JJ), KPATCH)  =  XPFLOODC    (KMASK(JJ), KPATCH) + XP_PFLOOD    (JJ) * PTSTEP
00179      XLE_FLOODC  (KMASK(JJ), KPATCH)  =  XLE_FLOODC  (KMASK(JJ), KPATCH) + XP_LE_FLOOD  (JJ) * PTSTEP
00180      XLEI_FLOODC (KMASK(JJ), KPATCH)  =  XLEI_FLOODC (KMASK(JJ), KPATCH) + XP_LEI_FLOOD (JJ) * PTSTEP
00181      XIRRIG_FLUXC(KMASK(JJ), KPATCH)  =  XIRRIG_FLUXC(KMASK(JJ), KPATCH) + XP_IRRIG_FLUX(JJ) * PTSTEP
00182      !
00183      XSWDC(KMASK(JJ), KPATCH)  = XSWDC(KMASK(JJ), KPATCH) + XP_SWD(JJ) * PTSTEP
00184      XSWUC(KMASK(JJ), KPATCH)  = XSWUC(KMASK(JJ), KPATCH) + XP_SWU(JJ) * PTSTEP
00185      XLWDC(KMASK(JJ), KPATCH)  = XLWDC(KMASK(JJ), KPATCH) + XP_LWD(JJ) * PTSTEP
00186      XLWUC(KMASK(JJ), KPATCH)  = XLWUC(KMASK(JJ), KPATCH) + XP_LWU(JJ) * PTSTEP
00187      XFMUC(KMASK(JJ), KPATCH)  = XFMUC(KMASK(JJ), KPATCH) + XP_FMU(JJ) * PTSTEP
00188      XFMVC(KMASK(JJ), KPATCH)  = XFMVC(KMASK(JJ), KPATCH) + XP_FMV(JJ) * PTSTEP
00189      !
00190   END DO
00191   !
00192   IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00193 !cdir nodep
00194      DO JJ=1,KSIZE
00195         XLESLC (KMASK(JJ), KPATCH) = XLESLC (KMASK(JJ), KPATCH) + XP_LESL (JJ) * PTSTEP
00196      END DO
00197   END IF
00198   !
00199   IF(HPHOTO/='NON')THEN
00200 !cdir nodep
00201      DO JJ=1,KSIZE
00202         !Transform units from kgCO2/kgair m/s to kgCO2/m2
00203         XGPPC       (KMASK(JJ), KPATCH)  =  XGPPC       (KMASK(JJ), KPATCH)+  XP_GPP       (JJ) * PRHOA(JJ) * PTSTEP
00204         XRESPC_AUTO (KMASK(JJ), KPATCH)  =  XRESPC_AUTO (KMASK(JJ), KPATCH)+  XP_RESP_AUTO (JJ) * PRHOA(JJ) * PTSTEP
00205         XRESPC_ECO  (KMASK(JJ), KPATCH)  =  XRESPC_ECO  (KMASK(JJ), KPATCH)+  XP_RESP_ECO  (JJ) * PRHOA(JJ) * PTSTEP
00206      END DO
00207   ELSE  
00208      XGPPC      (:,:)=0.0
00209      XRESPC_AUTO(:,:)=0.0
00210      XRESPC_ECO (:,:)=0.0       
00211   ENDIF
00212   !
00213   IF(LGLACIER)THEN
00214 !cdir nodep
00215     DO JJ=1,KSIZE
00216        XICEFLUXC(KMASK(JJ), KPATCH)  = XICEFLUXC(KMASK(JJ), KPATCH) + XP_ICEFLUX(JJ) * PTSTEP
00217     END DO  
00218   END IF
00219   !  
00220   IF(LWATER_BUDGET)THEN
00221 !cdir nodep
00222      DO JJ=1,KSIZE
00223         XDWGC   (KMASK(JJ), KPATCH)  =  XDWGC   (KMASK(JJ), KPATCH) + XP_DWG   (JJ) * PTSTEP
00224         XDWGIC  (KMASK(JJ), KPATCH)  =  XDWGIC  (KMASK(JJ), KPATCH) + XP_DWGI  (JJ) * PTSTEP
00225         XDWRC   (KMASK(JJ), KPATCH)  =  XDWRC   (KMASK(JJ), KPATCH) + XP_DWR   (JJ) * PTSTEP
00226         XDSWEC  (KMASK(JJ), KPATCH)  =  XDSWEC  (KMASK(JJ), KPATCH) + XP_DSWE  (JJ) * PTSTEP
00227         XWATBUDC(KMASK(JJ), KPATCH)  =  XWATBUDC(KMASK(JJ), KPATCH) + XP_WATBUD(JJ) * PTSTEP
00228      END DO
00229   ENDIF
00230   !  
00231 END IF
00232 IF (LHOOK) CALL DR_HOOK('DIAG_EVAP_ISBA_N',1,ZHOOK_HANDLE)
00233 !
00234 !-------------------------------------------------------------------------------------
00235 !
00236 END SUBROUTINE DIAG_EVAP_ISBA_n