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

Go to the documentation of this file.
00001 !     #########
00002       SUBROUTINE WRITE_DIAG_SEB_ISBA_n(HPROGRAM)
00003 !     #################################
00004 !
00005 !!****  *WRITE_DIAG_SEB_ISBA* - writes the ISBA diagnostic fields
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    REFERENCE
00015 !!    ---------
00016 !!
00017 !!
00018 !!    AUTHOR
00019 !!    ------
00020 !!      V. Masson   *Meteo France*      
00021 !!
00022 !!    MODIFICATIONS
00023 !!    -------------
00024 !!      Original    01/2004
00025 !!      B. Decharme 06/2009  key to write (or not) patch result
00026 !!      B. Decharme 08/2009  cumulative radiative budget
00027 !!      B. Decharme  09/2012 : Bug in local variables declaration in PROVAR_TO_DIAG
00028 !!      B. Decharme 09/2012  New diag :
00029 !!                           carbon fluxes and reservoirs
00030 !!                           soil liquid and ice water content in kg/m2 and m3/m3
00031 !-------------------------------------------------------------------------------
00032 !
00033 !*       0.    DECLARATIONS
00034 !              ------------
00035 !
00036 USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
00037 !
00038 USE MODD_SURF_PAR,   ONLY : XUNDEF, NUNDEF
00039 !
00040 USE MODD_CSTS,       ONLY : XRHOLW, XTT, XLMTT
00041 !
00042 USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG,  LRESET_BUDGETC
00043 !
00044 USE MODD_ISBA_n,     ONLY :   NPATCH, XPATCH, LFLOOD, CISBA, CHORT,   &
00045                               LGLACIER, NGROUND_LAYER, LTEMP_ARP,     &
00046                               NTEMPLAYER_ARP, TSNOW, XLE, XDG, XTG,   &
00047                               XWG, XWGI, XWR, XICE_STO, XWSAT, XDZG,  &
00048                               NWG_LAYER, CPHOTO, CRESPSL, XBIOMASS,   &
00049                               XLITTER, XSOILCARB, XLIGNIN_STRUC,      &
00050                               NNBIOMASS, NNLITTER, NNSOILCARB,        &
00051                               NNLITTLEVS
00052 !         
00053 USE MODD_AGRI  ,     ONLY : LAGRIP
00054 !
00055 USE MODD_DIAG_ISBA_n,ONLY :   N2M, LSURF_BUDGET, LRAD_BUDGET, LCOEF,            &
00056                               LSURF_VARS,LPATCH_BUDGET,                         &
00057                               XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX,   &
00058                               XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE,               &
00059                               XAVG_T2M, XAVG_Q2M, XAVG_HU2M,                    &
00060                               XAVG_ZON10M, XAVG_MER10M, XAVG_Z0, XAVG_Z0H,      &
00061                               XAVG_QS, XAVG_T2M_MIN, XAVG_T2M_MAX,              &
00062                               XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU,         &
00063                               XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV,           &
00064                               XRN, XH, XGFLUX, XLEI,                            &
00065                               XRI,XT2M, XQ2M, XHU2M, XZON10M, XMER10M,          &
00066                               XZ0_WITH_SNOW, XZ0H_WITH_SNOW, XQS, XWIND10M,     &
00067                               XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU, XFMU, XFMV, &
00068                               XSWDC, XSWUC, XLWDC, XLWUC, XFMUC, XFMVC,         &
00069                               XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC,       &
00070                               XAVG_FMUC, XAVG_FMVC, XAVG_HU2M_MIN,              &
00071                               XAVG_HU2M_MAX, XAVG_WIND10M, XAVG_WIND10M_MAX,    &  
00072                               XAVG_SFCO2
00073 !
00074 USE MODI_INIT_IO_SURF_n
00075 USE MODI_WRITE_SURF
00076 USE MODI_END_IO_SURF_n
00077 USE MODD_DIAG_EVAP_ISBA_n,ONLY :   LSURF_EVAP_BUDGET, LSURF_BUDGETC,              &
00078                                    LWATER_BUDGET,                                 &
00079                                    XRNC, XAVG_RNC, XHC, XAVG_HC,                  &
00080                                    XLEC, XAVG_LEC, XGFLUXC, XAVG_GFLUXC,          &
00081                                    XLEIC, XAVG_LEIC,                              &
00082                                    XLEG, XLEGC, XAVG_LEG, XAVG_LEGC,              &
00083                                    XLEGI, XLEGIC, XAVG_LEGI, XAVG_LEGIC,          &
00084                                    XLEV, XLEVC, XAVG_LEV, XAVG_LEVC,              &
00085                                    XLES, XLESC, XAVG_LES, XAVG_LESC,              &
00086                                    XLESL, XLESLC, XAVG_LESL, XAVG_LESLC,          &
00087                                    XLER, XLERC, XAVG_LER, XAVG_LERC,              &
00088                                    XLETR, XLETRC, XAVG_LETR, XAVG_LETRC,          &
00089                                    XEVAP, XEVAPC, XAVG_EVAP, XAVG_EVAPC,          &
00090                                    XDRAIN, XDRAINC, XAVG_DRAIN, XAVG_DRAINC,      &
00091                                    XRUNOFF, XRUNOFFC, XAVG_RUNOFF, XAVG_RUNOFFC,  &
00092                                    XHORT, XHORTC, XAVG_HORT, XAVG_HORTC,          &
00093                                    XDRIP, XDRIPC, XAVG_DRIP, XAVG_DRIPC,          &
00094                                    XMELT, XMELTC, XAVG_MELT, XAVG_MELTC,          &
00095                                    XIFLOOD, XIFLOODC, XAVG_IFLOOD, XAVG_IFLOODC,  &
00096                                    XPFLOOD, XPFLOODC, XAVG_PFLOOD, XAVG_PFLOODC,  &
00097                                    XLE_FLOOD, XLE_FLOODC, XAVG_LE_FLOOD,          &
00098                                    XAVG_LE_FLOODC, XLEI_FLOOD, XLEI_FLOODC,       &
00099                                    XAVG_LEI_FLOOD, XAVG_LEI_FLOODC,               &
00100                                    XICEFLUXC, XAVG_ICEFLUXC,                      &
00101                                    XRRVEG, XRRVEGC, XAVG_RRVEG, XAVG_RRVEGC,      &
00102                                    XIRRIG_FLUX, XIRRIG_FLUXC, XAVG_IRRIG_FLUX,    &
00103                                    XAVG_IRRIG_FLUXC,                              &
00104                                    XGPP,XGPPC,XAVG_GPP,XAVG_GPPC, XRESP_AUTO,     &
00105                                    XRESPC_AUTO,XAVG_RESP_AUTO,XAVG_RESPC_AUTO,    &
00106                                    XRESP_ECO,XRESPC_ECO,XAVG_RESP_ECO,            &
00107                                    XAVG_RESPC_ECO,                                & 
00108                                    XDWG, XDWGC, XAVG_DWG, XAVG_DWGC,              &
00109                                    XDWGI, XDWGIC, XAVG_DWGI, XAVG_DWGIC,          &
00110                                    XDWR, XDWRC, XAVG_DWR, XAVG_DWRC,              &
00111                                    XDSWE, XDSWEC, XAVG_DSWE, XAVG_DSWEC,          &
00112                                    XRAINFALL, XRAINFALLC, XSNOWFALL, XSNOWFALLC,  &
00113                                    XWATBUD, XWATBUDC, XAVG_WATBUD, XAVG_WATBUDC                               
00114 !
00115 USE MODD_CH_ISBA_n,    ONLY : XDEP, CCH_DRY_DEP, LCH_BIO_FLUX, CCH_NAMES, NBEQ, &
00116                               NDSTEQ, LCH_NO_FLUX
00117 USE MODD_GR_BIOG_n,    ONLY : XFISO, XFMONO, XNOFLUX
00118 USE MODD_DST_n
00119 USE MODD_DST_SURF
00120 !
00121 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00122 USE PARKIND1  ,ONLY : JPRB
00123 !
00124 IMPLICIT NONE
00125 !
00126 !*       0.1   Declarations of arguments
00127 !              -------------------------
00128 !
00129  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
00130 !
00131 !*       0.2   Declarations of local variables
00132 !              -------------------------------
00133 !
00134 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
00135  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be write
00136  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
00137  CHARACTER(LEN=2)  :: YNUM
00138 !
00139 INTEGER           :: JSV, JSW
00140 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00141 !
00142 !-------------------------------------------------------------------------------
00143 !
00144 !         Initialisation for IO
00145 !
00146 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',0,ZHOOK_HANDLE)
00147  CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA  ','WRITE')
00148 !
00149 !-------------------------------------------------------------------------------
00150 !
00151 !*       2.     Richardson number :
00152 !               -----------------
00153 !
00154 IF (N2M>=1) THEN
00155   !
00156   YRECFM='RI_ISBA'
00157   YCOMMENT='Richardson number over tile nature'
00158   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
00159   !
00160 END IF
00161 !
00162 !*       3.     Energy fluxes :
00163 !               -------------
00164 !
00165 IF (LSURF_BUDGET) THEN
00166   !
00167   YRECFM='RN_ISBA'
00168   YCOMMENT='Net radiation over tile nature'//' (W/m2)'
00169   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
00170   !
00171   YRECFM='H_ISBA'
00172   YCOMMENT='Sensible heat flux over tile nature'//' (W/m2)'
00173   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
00174   !
00175   YRECFM='LE_ISBA'
00176   YCOMMENT='total latent heat flux over tile nature'//' (W/m2)'
00177   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
00178   !
00179   YRECFM='LEI_ISBA'
00180   YCOMMENT='sublimation latent heat flux over tile nature'//' (W/m2)'
00181   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
00182   !
00183   YRECFM='GFLUX_ISBA'
00184   YCOMMENT='Ground flux over tile nature'//' (W/m2)'
00185   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
00186   !
00187   IF (LRAD_BUDGET  .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
00188     !
00189     YRECFM='SWD_ISBA'
00190     YCOMMENT='short wave downward radiation over tile nature'//' (W/m2)'
00191     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
00192     !
00193     YRECFM='SWU_ISBA'
00194     YCOMMENT='short wave upward radiation over tile nature'//' (W/m2)'
00195     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
00196     !
00197     YRECFM='LWD_ISBA'
00198     YCOMMENT='long wave downward radiation over tile nature'//' (W/m2)'
00199     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
00200     !
00201     YRECFM='LWU_ISBA'
00202     YCOMMENT='long wave upward radiation over tile nature'//' (W/m2)'
00203     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
00204     !
00205     DO JSW=1, SIZE(XSWBD,2)
00206       YNUM=ACHAR(48+JSW)
00207       !
00208       YRECFM='SWD_ISBA_'//YNUM
00209       YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
00210       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00211       !
00212       YRECFM='SWU_ISBA_'//YNUM
00213       YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
00214       CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
00215       !
00216     ENDDO
00217     !
00218   ENDIF
00219   !
00220   YRECFM='FMU_ISBA'
00221   YCOMMENT='u component of wind stress'//' (Pa)'  
00222   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
00223   !
00224   YRECFM='FMV_ISBA'
00225   YCOMMENT='v component of wind stress'//' (Pa)'  
00226   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
00227   !
00228 END IF
00229 !
00230 !*       4.    Specific Energy fluxes :(for each patch)
00231 !              ----------------------------------------
00232 !
00233 IF (LSURF_EVAP_BUDGET) THEN
00234   !
00235   YRECFM='LEG_ISBA'
00236   YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)'
00237   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEG(:),IRESP,HCOMMENT=YCOMMENT)
00238   !
00239   YRECFM='LEGI_ISBA'
00240   YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)'
00241   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGI(:),IRESP,HCOMMENT=YCOMMENT)
00242   !
00243   YRECFM='LEV_ISBA'
00244   YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)'
00245   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEV(:),IRESP,HCOMMENT=YCOMMENT)
00246   !
00247   YRECFM='LES_ISBA'
00248   YCOMMENT='snow sublimation for tile nature'//' (W/m2)'  
00249   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LES(:),IRESP,HCOMMENT=YCOMMENT)
00250   !
00251   IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN  
00252     YRECFM='LESL_ISBA'
00253     YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)'
00254     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESL(:),IRESP,HCOMMENT=YCOMMENT)
00255   ENDIF
00256   !  
00257   YRECFM='LER_ISBA'
00258   YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)'
00259   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LER(:),IRESP,HCOMMENT=YCOMMENT)
00260   !
00261   YRECFM='LETR_ISBA'
00262   YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)'
00263   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETR(:),IRESP,HCOMMENT=YCOMMENT)
00264   !
00265   YRECFM='EVAP_ISBA'
00266   YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
00267   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAP(:),IRESP,HCOMMENT=YCOMMENT)
00268   !
00269   YRECFM='DRAIN_ISBA'
00270   YCOMMENT='drainage for tile nature'//' (Kg/m2/s)'
00271   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAIN(:),IRESP,HCOMMENT=YCOMMENT)
00272   !
00273   YRECFM='RUNOFF_ISBA'
00274   YCOMMENT='runoff for tile nature'//' (Kg/m2/s)'
00275   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
00276   !
00277   IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
00278     YRECFM='HORTON_ISBA'
00279     YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)'
00280     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORT(:),IRESP,HCOMMENT=YCOMMENT)
00281   ENDIF
00282   !
00283   YRECFM='DRIVEG_ISBA'
00284   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00285   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIP(:),IRESP,HCOMMENT=YCOMMENT)
00286   !
00287   YRECFM='RRVEG_ISBA'
00288   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00289   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEG(:),IRESP,HCOMMENT=YCOMMENT)
00290   !
00291   YRECFM='SNOMLT_ISBA'
00292   YCOMMENT='snow melting rate'//' (Kg/m2/s)'
00293   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELT(:),IRESP,HCOMMENT=YCOMMENT)
00294   !
00295   IF(LAGRIP)THEN
00296     YRECFM='IRRIG_ISBA'
00297     YCOMMENT='irrigation rate'//' (Kg/m2/s)'
00298     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT)
00299   ENDIF  
00300   !
00301   IF(LFLOOD)THEN
00302     !        
00303     YRECFM='IFLOOD_ISBA'
00304     YCOMMENT='flood soil infiltration (Kg/m2/s)'    
00305     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
00306     !
00307     YRECFM='PFLOOD_ISBA'
00308     YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)'    
00309     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
00310     !
00311     YRECFM='LEF_ISBA'
00312     YCOMMENT='total floodplains evaporation (W/m2)'   
00313     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
00314     !
00315     YRECFM='LEIF_ISBA'
00316     YCOMMENT='solid floodplains evaporation (W/m2)'    
00317     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
00318     !
00319   ENDIF
00320   !
00321   IF(CPHOTO/='NON')THEN
00322     !
00323     YRECFM='GPP_ISBA'
00324     YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)'
00325     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPP(:),IRESP,HCOMMENT=YCOMMENT)
00326     !
00327     YRECFM='R_AUTO_ISBA'
00328     YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)'
00329     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
00330     !
00331     YRECFM='R_ECO_ISBA'
00332     YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)'
00333     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_ECO(:),IRESP,HCOMMENT=YCOMMENT)
00334     !
00335   ENDIF
00336   !  
00337   IF(LWATER_BUDGET)THEN 
00338     !
00339     YRECFM='RAINF_ISBA'
00340     YCOMMENT='input rainfall rate (Kg/m2/s)'
00341     CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT)
00342     !
00343     YRECFM='SNOWF_ISBA'
00344     YCOMMENT='input snowfall rate (Kg/m2/s)'
00345     CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT)
00346     !
00347     YRECFM='DWG_ISBA'
00348     YCOMMENT='change in liquid soil moisture (Kg/m2/s)'
00349     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWG(:),IRESP,HCOMMENT=YCOMMENT)
00350     !
00351     YRECFM='DWGI_ISBA'
00352     YCOMMENT='change in solid soil moisture (Kg/m2/s)'
00353     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGI(:),IRESP,HCOMMENT=YCOMMENT)
00354     !
00355     YRECFM='DWR_ISBA'
00356     YCOMMENT='change in water on canopy (Kg/m2/s)'
00357     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWR(:),IRESP,HCOMMENT=YCOMMENT)
00358     !
00359     YRECFM='DSWE_ISBA'
00360     YCOMMENT='change in snow water equivalent (Kg/m2/s)'
00361     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWE(:),IRESP,HCOMMENT=YCOMMENT)
00362     !
00363     YRECFM='WATBUD_ISBA'
00364     YCOMMENT='isba water budget as residue (Kg/m2/s)'
00365     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUD(:),IRESP,HCOMMENT=YCOMMENT)
00366     !
00367   ENDIF
00368   !  
00369 ENDIF
00370 !
00371 !*       5.    Cumulated Energy fluxes
00372 !              -----------------------
00373 !
00374 IF (LSURF_BUDGETC) THEN
00375   !
00376   YRECFM='LEGC_ISBA'
00377   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00378   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGC(:),IRESP,HCOMMENT=YCOMMENT)
00379   !
00380   YRECFM='LEGIC_ISBA'
00381   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00382   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGIC(:),IRESP,HCOMMENT=YCOMMENT)
00383   !
00384   YRECFM='LEVC_ISBA'
00385   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00386   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEVC(:),IRESP,HCOMMENT=YCOMMENT)
00387   !
00388   YRECFM='LESC_ISBA'
00389   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00390   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESC(:),IRESP,HCOMMENT=YCOMMENT)
00391   !
00392   IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN  
00393     YRECFM='LESLC_ISBA'
00394     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00395     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESLC(:),IRESP,HCOMMENT=YCOMMENT)
00396   ENDIF
00397   !  
00398   YRECFM='LERC_ISBA'
00399   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00400   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LERC(:),IRESP,HCOMMENT=YCOMMENT)
00401   !
00402   YRECFM='LETRC_ISBA'
00403   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00404   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETRC(:),IRESP,HCOMMENT=YCOMMENT)
00405   !
00406   YRECFM='EVAPC_ISBA'
00407   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00408   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAPC(:),IRESP,HCOMMENT=YCOMMENT)
00409   !
00410   YRECFM='DRAINC_ISBA'
00411   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00412   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAINC(:),IRESP,HCOMMENT=YCOMMENT)
00413   !
00414   YRECFM='RUNOFFC_ISBA'
00415   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00416   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFFC(:),IRESP,HCOMMENT=YCOMMENT)
00417   !
00418   IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
00419     YRECFM='HORTONC_ISBA'
00420     YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00421     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORTC(:),IRESP,HCOMMENT=YCOMMENT)
00422   ENDIF
00423   !
00424   YRECFM='DRIVEGC_ISBA'
00425   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00426   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIPC(:),IRESP,HCOMMENT=YCOMMENT)
00427   !
00428   YRECFM='RRVEGC_ISBA'
00429   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00430   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEGC(:),IRESP,HCOMMENT=YCOMMENT)
00431   !
00432   YRECFM='SNOMLTC_ISBA'
00433   YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00434   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELTC(:),IRESP,HCOMMENT=YCOMMENT)
00435   !
00436   IF(LAGRIP)THEN
00437     YRECFM='IRRIGC_ISBA'
00438     YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00439     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUXC(:),IRESP,HCOMMENT=YCOMMENT)
00440   ENDIF
00441   !  
00442   IF(LGLACIER)THEN
00443     YRECFM='ICE_FC_ISBA'
00444     YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00445     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ICEFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
00446   ENDIF
00447   !
00448   IF(LFLOOD)THEN
00449     !
00450     YRECFM='IFLOODC_ISBA'
00451     YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00452     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
00453     !
00454     YRECFM='PFLOODC_ISBA'
00455     YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00456     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
00457     !
00458     YRECFM='LEFC_ISBA'
00459     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00460     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
00461     !
00462     YRECFM='LEIFC_ISBA'
00463     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00464     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
00465     !
00466   ENDIF
00467   !
00468   YRECFM='RNC_ISBA'
00469   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00470   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
00471   !
00472   YRECFM='HC_ISBA'
00473   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00474   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
00475   !
00476   YRECFM='LEC_ISBA'
00477   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00478   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
00479   !
00480   YRECFM='LEIC_ISBA'
00481   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00482   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
00483   !
00484   YRECFM='GFLUXC_ISBA'
00485   YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00486   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
00487   !
00488   IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
00489     !
00490     YRECFM='SWDC_ISBA'
00491     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00492     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
00493     !
00494     YRECFM='SWUC_ISBA'
00495     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00496     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
00497     !
00498     YRECFM='LWDC_ISBA'
00499     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00500     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
00501     !
00502     YRECFM='LWUC_ISBA'
00503     YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00504     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
00505     !
00506   ENDIF
00507   !
00508   YRECFM='FMUC_ISBA'
00509   YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'  
00510   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
00511   !
00512   YRECFM='FMVC_ISBA'
00513   YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'  
00514   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
00515   !
00516   IF(CPHOTO/='NON')THEN
00517     !
00518     YRECFM='GPPC_ISBA'
00519     YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
00520     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPPC(:),IRESP,HCOMMENT=YCOMMENT)
00521     !
00522     YRECFM='RC_AUTO_ISBA'
00523     YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
00524     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
00525     !
00526     YRECFM='RC_ECO_ISBA'
00527     YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
00528     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_ECO(:),IRESP,HCOMMENT=YCOMMENT)
00529     !
00530   ENDIF
00531   !  
00532   IF(LWATER_BUDGET)THEN 
00533     !
00534     YRECFM='RAINFC_ISBA'
00535     YCOMMENT='cumulated input rainfall rate (Kg/m2)'
00536     CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALLC(:),IRESP,HCOMMENT=YCOMMENT)
00537     !
00538     YRECFM='SNOWFC_ISBA'
00539     YCOMMENT='cumulated input snowfall rate (Kg/m2)'
00540     CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALLC(:),IRESP,HCOMMENT=YCOMMENT)
00541     !
00542     YRECFM='DWGC_ISBA'
00543     YCOMMENT='cumulated change in liquid soil moisture (Kg/m2)'
00544     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGC(:),IRESP,HCOMMENT=YCOMMENT)
00545     !
00546     YRECFM='DWGIC_ISBA'
00547     YCOMMENT='cumulated change in solid soil moisture (Kg/m2)'
00548     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGIC(:),IRESP,HCOMMENT=YCOMMENT)
00549     !
00550     YRECFM='DWRC_ISBA'
00551     YCOMMENT='cumulated change in water on canopy (Kg/m2)'
00552     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWRC(:),IRESP,HCOMMENT=YCOMMENT)
00553     !
00554     YRECFM='DSWEC_ISBA'
00555     YCOMMENT='cumulated change in snow water equivalent (Kg/m2)'
00556     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWEC(:),IRESP,HCOMMENT=YCOMMENT)
00557     !
00558     YRECFM='WATBUDC_ISBA'
00559     YCOMMENT='cumulated isba water budget as residue (Kg/m2)'
00560     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUDC(:),IRESP,HCOMMENT=YCOMMENT)
00561     !
00562   ENDIF 
00563   !  
00564 ENDIF
00565 !
00566 !*       6.     parameters at 2 and 10 meters :
00567 !               -------------------------------
00568 !
00569 IF (N2M>=1) THEN
00570   !
00571   YRECFM='T2M_ISBA'
00572   YCOMMENT='X_Y_'//YRECFM//' (K)'
00573   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
00574   !
00575   YRECFM='T2MMIN_ISBA'
00576   YCOMMENT='X_Y_'//YRECFM//' (K)'
00577   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00578   XAVG_T2M_MIN(:)=XUNDEF
00579   !
00580   YRECFM='T2MMAX_ISBA'
00581   YCOMMENT='X_Y_'//YRECFM//' (K)'
00582   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00583   XAVG_T2M_MAX(:)=0.0
00584   !
00585   YRECFM='Q2M_ISBA'
00586   YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00587   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
00588   !
00589   YRECFM='HU2M_ISBA'
00590   YCOMMENT='X_Y_'//YRECFM//' (-)'
00591   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
00592   !
00593   YRECFM='HU2MMIN_ISBA'
00594   YCOMMENT='X_Y_'//YRECFM//' (-)'
00595   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
00596   XAVG_HU2M_MIN(:)=XUNDEF
00597   !
00598   YRECFM='HU2MMAX_ISBA'
00599   YCOMMENT='X_Y_'//YRECFM//' (-)'
00600   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00601   XAVG_HU2M_MAX(:)=-XUNDEF
00602   !
00603   YRECFM='ZON10M_ISBA'
00604   YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00605   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
00606   !
00607   YRECFM='MER10M_ISBA'
00608   YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00609   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
00610   !
00611   YRECFM='W10M_ISBA'
00612   YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00613   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
00614   !
00615   YRECFM='W10MMAX_ISBA'
00616   YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00617   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
00618   XAVG_WIND10M_MAX(:)=0.0
00619   !
00620   YRECFM='SFCO2_ISBA'
00621   YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
00622   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
00623   !  
00624 END IF
00625 !----------------------------------------------------------------------------
00626 !
00627 !*       7.     Transfer coefficients
00628 !               ---------------------
00629 !
00630 IF (LCOEF) THEN
00631   !
00632   YRECFM='CD_ISBA'
00633   YCOMMENT='X_Y_'//YRECFM
00634   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
00635   !
00636   YRECFM='CH_ISBA'
00637   YCOMMENT='X_Y_'//YRECFM
00638   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
00639   !
00640   YRECFM='CE_ISBA'
00641   YCOMMENT='X_Y_'//YRECFM
00642   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
00643   !
00644   YRECFM='Z0_ISBA'
00645   YCOMMENT='X_Y_'//YRECFM//' (M)'
00646   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
00647   !
00648   YRECFM='Z0H_ISBA'
00649   YCOMMENT='X_Y_'//YRECFM//' (M)'
00650   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
00651   !
00652 ENDIF
00653 !
00654 !----------------------------------------------------------------------------
00655 !
00656 !*       8.     Surface humidity
00657 !               ----------------
00658 IF (LSURF_VARS) THEN
00659   !
00660   YRECFM='QS_ISBA'
00661   YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00662   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_QS(:),IRESP,HCOMMENT=YCOMMENT)
00663   !
00664 ENDIF
00665 !
00666 !----------------------------------------------------------------------------
00667 !
00668 !*       9.     Diag of prognostic fields
00669 !               -------------------------
00670 !
00671 IF (LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG
00672 !
00673 !----------------------------------------------------------------------------
00674 !
00675 !User want (or not) patch output
00676 IF(LPATCH_BUDGET.AND.(NPATCH >1))THEN
00677     !----------------------------------------------------------------------------
00678     !
00679     !*      10.     Richardson number (for each patch)
00680     !               -----------------
00681     !
00682     IF (N2M>=1) THEN
00683       !
00684       YRECFM='RI_P'
00685       YCOMMENT='X_Y_'//YRECFM
00686       CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:,:),IRESP,HCOMMENT=YCOMMENT)
00687       !
00688     END IF
00689     !
00690     !*       11.     Energy fluxes :(for each patch)
00691     !                -------------
00692     !
00693     IF (LSURF_BUDGET) THEN
00694       !
00695       YRECFM='RN_P'
00696       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00697       CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:,:),IRESP,HCOMMENT=YCOMMENT)
00698       !
00699       YRECFM='H_P'
00700       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00701       CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:,:),IRESP,HCOMMENT=YCOMMENT)
00702       !
00703       YRECFM='LE_P'
00704       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00705       CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP,HCOMMENT=YCOMMENT)
00706       !
00707       YRECFM='LEI_P'
00708       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00709       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:,:),IRESP,HCOMMENT=YCOMMENT)
00710       !
00711       YRECFM='GFLUX_P'
00712       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00713       CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:,:),IRESP,HCOMMENT=YCOMMENT)
00714       !
00715       IF (LRAD_BUDGET) THEN
00716         !
00717         YRECFM='SWD_P'
00718         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00719         CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:,:),IRESP,HCOMMENT=YCOMMENT)
00720         !
00721         YRECFM='SWU_P'
00722         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00723         CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:,:),IRESP,HCOMMENT=YCOMMENT)
00724         !
00725         YRECFM='LWD_P'
00726         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00727         CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:,:),IRESP,HCOMMENT=YCOMMENT)
00728         !
00729         YRECFM='LWU_P'
00730         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00731         CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:,:),IRESP,HCOMMENT=YCOMMENT)
00732         !
00733         DO JSW=1, SIZE(XSWBD,2)
00734           YNUM=ACHAR(48+JSW)
00735           !
00736           YRECFM='SWD_P'//YNUM
00737           YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00738           CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW,:),IRESP,HCOMMENT=YCOMMENT)
00739           !
00740           YRECFM='SWU_P'//YNUM
00741           YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00742           CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW,:),IRESP,HCOMMENT=YCOMMENT)
00743           !
00744         ENDDO
00745         !
00746       ENDIF
00747       !
00748       YRECFM='FMU_P'
00749       YCOMMENT='X_Y_'//YRECFM//' (Pa)'      
00750       CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:,:),IRESP,HCOMMENT=YCOMMENT)
00751       !
00752       YRECFM='FMV_P'
00753       YCOMMENT='X_Y_'//YRECFM//' (Pa)'      
00754       CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:,:),IRESP,HCOMMENT=YCOMMENT)
00755       !
00756     END IF
00757     !
00758     !*       12.    Specific Energy fluxes :(for each patch)
00759     !               ----------------------------------------
00760     !
00761     IF (LSURF_EVAP_BUDGET) THEN
00762       !
00763       YRECFM='LEG_P'
00764       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00765       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEG(:,:),IRESP,HCOMMENT=YCOMMENT)
00766       !
00767       YRECFM='LEGI_P'
00768       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00769       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGI(:,:),IRESP,HCOMMENT=YCOMMENT)
00770       !
00771       YRECFM='LEV_P'
00772       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00773       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEV(:,:),IRESP,HCOMMENT=YCOMMENT)
00774       !
00775       YRECFM='LES_P'
00776       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00777       CALL WRITE_SURF(HPROGRAM,YRECFM,XLES(:,:),IRESP,HCOMMENT=YCOMMENT)
00778       !
00779       IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN  
00780         YRECFM='LESL_P'
00781         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00782         CALL WRITE_SURF(HPROGRAM,YRECFM,XLESL(:,:),IRESP,HCOMMENT=YCOMMENT)
00783       ENDIF
00784       !      
00785       YRECFM='LER_P'
00786       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00787       CALL WRITE_SURF(HPROGRAM,YRECFM,XLER(:,:),IRESP,HCOMMENT=YCOMMENT)
00788       !
00789       YRECFM='LETR_P'
00790       YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00791       CALL WRITE_SURF(HPROGRAM,YRECFM,XLETR(:,:),IRESP,HCOMMENT=YCOMMENT)
00792       !
00793       YRECFM='EVAP_P'
00794       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00795       CALL WRITE_SURF(HPROGRAM,YRECFM,XEVAP(:,:),IRESP,HCOMMENT=YCOMMENT)
00796       !
00797       YRECFM='DRAIN_P'
00798       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00799       CALL WRITE_SURF(HPROGRAM,YRECFM,XDRAIN(:,:),IRESP,HCOMMENT=YCOMMENT)
00800       !
00801       YRECFM='RUNOFF_P'
00802       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00803       CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFF(:,:),IRESP,HCOMMENT=YCOMMENT)
00804       !
00805       IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
00806         YRECFM='HORTON_P'
00807         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00808         CALL WRITE_SURF(HPROGRAM,YRECFM,XHORT(:,:),IRESP,HCOMMENT=YCOMMENT)
00809       ENDIF
00810       !
00811       YRECFM='DRIVEG_P'
00812       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00813       CALL WRITE_SURF(HPROGRAM,YRECFM,XDRIP(:,:),IRESP,HCOMMENT=YCOMMENT)
00814       !
00815       YRECFM='RRVEG_P'
00816       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00817       CALL WRITE_SURF(HPROGRAM,YRECFM,XRRVEG(:,:),IRESP,HCOMMENT=YCOMMENT)
00818       !
00819       YRECFM='SNOMLT_P'
00820       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00821       CALL WRITE_SURF(HPROGRAM,YRECFM,XMELT(:,:),IRESP,HCOMMENT=YCOMMENT)
00822       !
00823       IF(LAGRIP)THEN
00824         YRECFM='IRRIG_P'
00825         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00826         CALL WRITE_SURF(HPROGRAM,YRECFM,XIRRIG_FLUX(:,:),IRESP,HCOMMENT=YCOMMENT)
00827       ENDIF
00828       !      
00829       IF(LFLOOD)THEN
00830         !
00831         YRECFM='IFLOOD_P'
00832         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00833         CALL WRITE_SURF(HPROGRAM,YRECFM,XIFLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
00834         !
00835         YRECFM='PFLOOD_P'
00836         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
00837         CALL WRITE_SURF(HPROGRAM,YRECFM,XPFLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
00838         !
00839         YRECFM='LEF_P'
00840         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00841         CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
00842         !
00843         YRECFM='LEIF_P'
00844         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
00845         CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
00846         !
00847       ENDIF
00848       !
00849       IF(CPHOTO/='NON')THEN
00850         !
00851         YRECFM='GPP_P'
00852         YCOMMENT='gross primary production per patch (kgCO2/m2/s)'
00853         CALL WRITE_SURF(HPROGRAM,YRECFM,XGPP(:,:),IRESP,HCOMMENT=YCOMMENT)
00854         !
00855         YRECFM='R_AUTO_P'
00856         YCOMMENT='autotrophic respiration per patch (kgCO2/m2/s)'
00857         CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_AUTO(:,:),IRESP,HCOMMENT=YCOMMENT)
00858         !
00859         YRECFM='R_ECO_P'
00860         YCOMMENT='ecosystem respiration per patch (kgCO2/m2/s)'
00861         CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_ECO(:,:),IRESP,HCOMMENT=YCOMMENT)
00862         !
00863       ENDIF
00864       !
00865       IF(LWATER_BUDGET)THEN 
00866         !
00867         YRECFM='DWG_P'
00868         YCOMMENT='change in liquid soil moisture per patch (Kg/m2/s)'
00869         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWG(:,:),IRESP,HCOMMENT=YCOMMENT)
00870         !
00871         YRECFM='DWGI_P'
00872         YCOMMENT='change in solid soil moisture per patch (Kg/m2/s)'
00873         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGI(:,:),IRESP,HCOMMENT=YCOMMENT)
00874         !
00875         YRECFM='DWR_P'
00876         YCOMMENT='change in water on canopy per patch (Kg/m2/s)'
00877         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWR(:,:),IRESP,HCOMMENT=YCOMMENT)
00878         !
00879         YRECFM='DSWE_P'
00880         YCOMMENT='change in snow water equivalent per patch (Kg/m2/s)'
00881         CALL WRITE_SURF(HPROGRAM,YRECFM,XDSWE(:,:),IRESP,HCOMMENT=YCOMMENT)
00882         !
00883         YRECFM='WATBUD_P'
00884         YCOMMENT='isba water budget as residue per patch (Kg/m2/s)'
00885         CALL WRITE_SURF(HPROGRAM,YRECFM,XWATBUD(:,:),IRESP,HCOMMENT=YCOMMENT)
00886         !
00887       ENDIF
00888       !      
00889     ENDIF
00890     !
00891     !*       13.    surface temperature parameters at 2 and 10 meters (for each patch):
00892     !               -------------------------------------------------------------------
00893     !
00894     IF (N2M>=1) THEN
00895       !
00896       YRECFM='T2M_P'
00897       YCOMMENT='X_Y_'//YRECFM//' (K)'
00898       CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:,:),IRESP,HCOMMENT=YCOMMENT)
00899       !
00900       YRECFM='Q2M_P'
00901       YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
00902       CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:,:),IRESP,HCOMMENT=YCOMMENT)
00903       !
00904       YRECFM='HU2M_P'
00905       YCOMMENT='X_Y_'//YRECFM//' (PERCENT)'
00906       CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:,:),IRESP,HCOMMENT=YCOMMENT)
00907       !
00908       YRECFM='ZON10M_P'
00909       YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00910       CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:,:),IRESP,HCOMMENT=YCOMMENT)
00911       !
00912       YRECFM='MER10M_P'
00913       YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00914       CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:,:),IRESP,HCOMMENT=YCOMMENT)
00915       !
00916       YRECFM='W10M_P'
00917       YCOMMENT='X_Y_'//YRECFM//' (M/S)'
00918       CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:,:),IRESP,HCOMMENT=YCOMMENT)
00919       !
00920     END IF
00921     !
00922     !*       14.    Cumulated Energy fluxes :(for each patch)
00923     !               -----------------------------------------
00924     !
00925     IF (LSURF_BUDGETC) THEN
00926       !
00927       YRECFM='LEGC_P'
00928       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00929       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGC(:,:),IRESP,HCOMMENT=YCOMMENT)
00930       !
00931       YRECFM='LEGIC_P'
00932       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00933       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGIC(:,:),IRESP,HCOMMENT=YCOMMENT)
00934       !
00935       YRECFM='LEVC_P'
00936       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00937       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEVC(:,:),IRESP,HCOMMENT=YCOMMENT)
00938       !
00939       YRECFM='LESC_P'
00940       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00941       CALL WRITE_SURF(HPROGRAM,YRECFM,XLESC(:,:),IRESP,HCOMMENT=YCOMMENT)
00942       !
00943       IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN  
00944         YRECFM='LESLC_P'
00945         YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00946         CALL WRITE_SURF(HPROGRAM,YRECFM,XLESLC(:,:),IRESP,HCOMMENT=YCOMMENT)
00947       ENDIF      
00948       !
00949       YRECFM='LERC_P'
00950       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00951       CALL WRITE_SURF(HPROGRAM,YRECFM,XLERC(:,:),IRESP,HCOMMENT=YCOMMENT)
00952       !
00953       YRECFM='LETRC_P'
00954       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
00955       CALL WRITE_SURF(HPROGRAM,YRECFM,XLETRC(:,:),IRESP,HCOMMENT=YCOMMENT)
00956       !
00957       YRECFM='EVAPC_P'
00958       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00959       CALL WRITE_SURF(HPROGRAM,YRECFM,XEVAPC(:,:),IRESP,HCOMMENT=YCOMMENT)
00960       !
00961       YRECFM='DRAINC_P'
00962       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00963       CALL WRITE_SURF(HPROGRAM,YRECFM,XDRAINC(:,:),IRESP,HCOMMENT=YCOMMENT)
00964       !
00965       YRECFM='RUNOFFC_P'
00966       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00967       CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFC(:,:),IRESP,HCOMMENT=YCOMMENT)
00968       !
00969       IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
00970         YRECFM='HORTONC_P'
00971         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00972         CALL WRITE_SURF(HPROGRAM,YRECFM,XHORTC(:,:),IRESP,HCOMMENT=YCOMMENT)
00973       ENDIF
00974       !
00975       YRECFM='DRIVEGC_P'
00976       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00977       CALL WRITE_SURF(HPROGRAM,YRECFM,XDRIPC(:,:),IRESP,HCOMMENT=YCOMMENT)
00978       !
00979       YRECFM='RRVEGC_P'
00980       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00981       CALL WRITE_SURF(HPROGRAM,YRECFM,XRRVEGC(:,:),IRESP,HCOMMENT=YCOMMENT)
00982       !
00983       YRECFM='SNOMLTC_P'
00984       YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00985       CALL WRITE_SURF(HPROGRAM,YRECFM,XMELTC(:,:),IRESP,HCOMMENT=YCOMMENT)
00986       !
00987       IF(LAGRIP)THEN
00988         YRECFM='IRRIGC_P'
00989         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00990         CALL WRITE_SURF(HPROGRAM,YRECFM,XIRRIG_FLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
00991       ENDIF      
00992       !
00993       IF(LGLACIER)THEN
00994         YRECFM='ICE_FC_P'
00995         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
00996         CALL WRITE_SURF(HPROGRAM,YRECFM,XICEFLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
00997       ENDIF
00998       !
00999       IF(LFLOOD)THEN
01000         !        
01001         YRECFM='IFLOODC_P'
01002         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
01003         CALL WRITE_SURF(HPROGRAM,YRECFM,XIFLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
01004         !
01005         YRECFM='PFLOODC_P'
01006         YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
01007         CALL WRITE_SURF(HPROGRAM,YRECFM,XPFLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
01008         !
01009         YRECFM='LEFC_P'
01010         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
01011         CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_FLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
01012         !
01013         YRECFM='LEIFC_P'
01014         YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
01015         CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI_FLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
01016         !
01017       ENDIF
01018       !
01019       YRECFM='RNC_P'
01020       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01021       CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:,:),IRESP,HCOMMENT=YCOMMENT)
01022       !
01023       YRECFM='HC_P'
01024       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01025       CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:,:),IRESP,HCOMMENT=YCOMMENT)
01026       !
01027       YRECFM='LEC_P'
01028       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01029       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:,:),IRESP,HCOMMENT=YCOMMENT)
01030       !
01031       YRECFM='LEIC_P'
01032       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01033       CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:,:),IRESP,HCOMMENT=YCOMMENT)
01034       !
01035       YRECFM='GFLUXC_P'
01036       YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01037       CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
01038       !
01039       IF (LRAD_BUDGET) THEN
01040         !
01041         YRECFM='SWDC_P'
01042         YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01043         CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:,:),IRESP,HCOMMENT=YCOMMENT)
01044         !
01045         YRECFM='SWUC_P'
01046         YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01047         CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:,:),IRESP,HCOMMENT=YCOMMENT)
01048         !
01049         YRECFM='LWDC_P'
01050         YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01051         CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:,:),IRESP,HCOMMENT=YCOMMENT)
01052         !
01053         YRECFM='LWUC_P'
01054         YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
01055         CALL WRITE_SURF(HPROGRAM,YRECFM,XLWUC(:,:),IRESP,HCOMMENT=YCOMMENT)
01056         !
01057       ENDIF
01058       !
01059       YRECFM='FMUC_P'
01060       YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'      
01061       CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:,:),IRESP,HCOMMENT=YCOMMENT)
01062       !
01063       YRECFM='FMVC_P'
01064       YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'      
01065       CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:,:),IRESP,HCOMMENT=YCOMMENT)
01066       !
01067       IF(CPHOTO/='NON')THEN
01068         !
01069         YRECFM='GPPC_P'
01070         YCOMMENT='cumulated gross primary production per patch (kgCO2/m2)'
01071         CALL WRITE_SURF(HPROGRAM,YRECFM,XGPPC(:,:),IRESP,HCOMMENT=YCOMMENT)
01072         !
01073         YRECFM='RC_AUTO_P'
01074         YCOMMENT='cumulated autotrophic respiration per patch (kgCO2/m2)'
01075         CALL WRITE_SURF(HPROGRAM,YRECFM,XRESPC_AUTO(:,:),IRESP,HCOMMENT=YCOMMENT)
01076         !
01077         YRECFM='RC_ECO_P'
01078         YCOMMENT='cumulated ecosystem respiration per patch (kgCO2/m2)'
01079         CALL WRITE_SURF(HPROGRAM,YRECFM,XRESPC_ECO(:,:),IRESP,HCOMMENT=YCOMMENT)
01080         !
01081       ENDIF
01082       !  
01083       IF(LWATER_BUDGET)THEN 
01084         !
01085         YRECFM='DWGC_P'
01086         YCOMMENT='cumulated change in liquid soil moisture per patch (Kg/m2)'
01087         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGC(:,:),IRESP,HCOMMENT=YCOMMENT)
01088         !
01089         YRECFM='DWGIC_P'
01090         YCOMMENT='cumulated change in solid soil moisture per patch (Kg/m2)'
01091         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGIC(:,:),IRESP,HCOMMENT=YCOMMENT)
01092         !
01093         YRECFM='DWRC_P'
01094         YCOMMENT='cumulated change in water on canopy per patch (Kg/m2)'
01095         CALL WRITE_SURF(HPROGRAM,YRECFM,XDWRC(:,:),IRESP,HCOMMENT=YCOMMENT)
01096         !
01097         YRECFM='DSWEC_P'
01098         YCOMMENT='cumulated change in snow water equivalent per patch (Kg/m2)'
01099         CALL WRITE_SURF(HPROGRAM,YRECFM,XDSWEC(:,:),IRESP,HCOMMENT=YCOMMENT)
01100         !
01101         YRECFM='WATBUDC_P'
01102         YCOMMENT='cumulated isba water budget as residue per patch (Kg/m2)'
01103         CALL WRITE_SURF(HPROGRAM,YRECFM,XWATBUDC(:,:),IRESP,HCOMMENT=YCOMMENT)
01104         !
01105       ENDIF
01106       !      
01107     ENDIF
01108     !-------------------------------------------------------------------------------
01109 ENDIF
01110 !User want (or not) patch output
01111 !-------------------------------------------------------------------------------
01112 !
01113 !*       15.     chemical diagnostics:
01114 !               --------------------
01115 !
01116 IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
01117   !
01118   DO JSV = 1,SIZE(CCH_NAMES,1)
01119     YRECFM='DV_NAT_'//TRIM(CCH_NAMES(JSV))
01120     WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_NAT_',JSV
01121     CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
01122   END DO
01123   !
01124 ENDIF
01125 !
01126 IF (NBEQ>0 .AND. LCH_BIO_FLUX) THEN
01127   !
01128   IF (ASSOCIATED(XFISO)) THEN
01129     YRECFM='FISO'
01130     WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)'
01131     CALL WRITE_SURF(HPROGRAM,YRECFM,XFISO(:),IRESP,HCOMMENT=YCOMMENT)
01132   END IF
01133   !
01134   IF (ASSOCIATED(XFISO)) THEN
01135     YRECFM='FMONO'
01136     WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)'
01137     CALL WRITE_SURF(HPROGRAM,YRECFM,XFMONO(:),IRESP,HCOMMENT=YCOMMENT)
01138   END IF
01139   !
01140 ENDIF
01141 !
01142 IF (LCH_NO_FLUX) THEN
01143   IF (ASSOCIATED(XNOFLUX)) THEN
01144     YRECFM='NOFLUX'
01145     WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)'
01146     CALL WRITE_SURF(HPROGRAM,YRECFM,XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT)
01147   END IF
01148 END IF
01149 !
01150 IF (NDSTEQ > 0)THEN
01151   !
01152   DO JSV = 1,NDSTMDE ! for all dust modes
01153     WRITE(YRECFM,'(A7,I3.3)')'FLX_DST',JSV
01154     YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
01155     CALL WRITE_SURF(HPROGRAM,YRECFM,XSFDST(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
01156   END DO
01157   !
01158 ENDIF
01159 !
01160 !-------------------------------------------------------------------------------
01161 !
01162 !         End of IO
01163 !
01164  CALL END_IO_SURF_n(HPROGRAM)
01165 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE)
01166 !
01167 CONTAINS
01168 !
01169 !-------------------------------------------------------------------------------
01170 !
01171 SUBROUTINE PROVAR_TO_DIAG
01172 !
01173 REAL, DIMENSION(SIZE(XTG,1))             :: ZPATCH, ZWORK
01174 REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWG
01175 REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWGI
01176 REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZMOIST
01177 REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZICE
01178 REAL, DIMENSION(SIZE(XTG,1),SIZE(XTG,2)) :: ZTG
01179 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2)) :: ZDG_TOT
01180 REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZDG
01181 !
01182 REAL, DIMENSION(SIZE(XDG,1),NNBIOMASS)   :: ZBIOMASS
01183 REAL, DIMENSION(SIZE(XDG,1),NNSOILCARB)  :: ZSOILCARB
01184 REAL, DIMENSION(SIZE(XDG,1),NNLITTLEVS)  :: ZLIGNIN_STRUC
01185 REAL, DIMENSION(SIZE(XDG,1),NNLITTER,NNLITTLEVS)  :: ZLITTER
01186 !
01187  CHARACTER(LEN=8 ) :: YUNIT
01188  CHARACTER(LEN=4 ) :: YLVL
01189 INTEGER :: JLAYER, JPATCH, JJ, INI, IWORK, IDEPTH
01190 REAL(KIND=JPRB) :: ZHOOK_HANDLE
01191 !
01192 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',0,ZHOOK_HANDLE)
01193 !
01194 INI=SIZE(XDG,1)
01195 !
01196 ! * soil temperatures (K)
01197 !
01198 IF(LTEMP_ARP)THEN
01199   IWORK=NTEMPLAYER_ARP
01200 ELSEIF(CISBA/='DIF')THEN
01201   IWORK=NGROUND_LAYER-1
01202 ELSE
01203   IWORK=NGROUND_LAYER
01204 ENDIF
01205 !
01206 ZTG(:,:)=0.0
01207 DO JPATCH=1,NPATCH
01208    DO JLAYER=1,IWORK
01209       DO JJ=1,INI 
01210          ZTG(JJ,JLAYER) = ZTG(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XTG(JJ,JLAYER,JPATCH)
01211       ENDDO
01212    ENDDO
01213 ENDDO
01214 !
01215 DO JLAYER=1,IWORK
01216   WRITE(YLVL,'(I4)') JLAYER
01217   YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01218   YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01219   YCOMMENT='X_Y_'//YRECFM//' (K)'
01220   CALL WRITE_SURF(HPROGRAM,YRECFM,ZTG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
01221 END DO
01222 !
01223 ! * Compute soil liquid and ice water content (kg/m2 and m3/m3) 
01224 !
01225 ZWG (:,:)=0.0
01226 ZWGI(:,:)=0.0
01227 ZDG_TOT(:,:)=0.0
01228 ZMOIST (:,:)=XUNDEF
01229 ZICE   (:,:)=XUNDEF
01230 !  
01231 IF(CISBA=='DIF')THEN
01232   !
01233   IWORK = NWG_SIZE
01234   !
01235   DO JPATCH=1,NPATCH
01236      DO JLAYER=1,NGROUND_LAYER
01237         DO JJ=1,INI 
01238 !
01239 !          liquid and ice water content
01240            IDEPTH=NWG_LAYER(JJ,JPATCH)
01241            IF(JLAYER<=IDEPTH)THEN    
01242              ZWG    (JJ,JLAYER)=ZWG    (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
01243              ZWGI   (JJ,JLAYER)=ZWGI   (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
01244              ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
01245            ENDIF
01246 !                      
01247         ENDDO
01248      ENDDO
01249   ENDDO
01250 !  
01251 ELSE
01252   !  
01253   IWORK = NGROUND_LAYER
01254   !
01255   ZDG(:,1,:) = XDG(:,1,:)
01256   ZDG(:,2,:) = XDG(:,2,:)
01257   IF(CISBA=='3-L')THEN
01258     ZDG(:,3,:) = XDG(:,3,:)-XDG(:,2,:)
01259   ENDIF
01260 !
01261   DO JPATCH=1,NPATCH
01262      DO JLAYER=1,NGROUND_LAYER
01263         DO JJ=1,INI 
01264            ZWG    (JJ,JLAYER)=ZWG    (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
01265            ZWGI   (JJ,JLAYER)=ZWGI   (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
01266            ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
01267         ENDDO
01268      ENDDO
01269   ENDDO
01270 !  
01271 ENDIF
01272 !
01273 WHERE(ZDG_TOT(:,:)>0.0)
01274       ZMOIST(:,:)=ZWG (:,:)*XRHOLW
01275       ZICE  (:,:)=ZWGI(:,:)*XRHOLW        
01276       ZWG   (:,:)=ZWG (:,:)/ZDG_TOT(:,:)
01277       ZWGI  (:,:)=ZWGI(:,:)/ZDG_TOT(:,:)
01278 ELSEWHERE
01279       ZMOIST(:,:)=XUNDEF
01280       ZICE  (:,:)=XUNDEF       
01281       ZWG   (:,:)=XUNDEF
01282       ZWGI  (:,:)=XUNDEF      
01283 ENDWHERE
01284 !
01285 ! * soil liquid water content (m3/m3) and soil moisture (kg/m2)
01286 !
01287 YUNIT=' (m3/m3)'
01288 DO JLAYER=1,IWORK
01289   WRITE(YLVL,'(I4)') JLAYER
01290   YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01291   YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01292   YCOMMENT='X_Y_'//YRECFM//YUNIT  
01293   CALL WRITE_SURF(HPROGRAM,YRECFM,ZWG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
01294 END DO
01295 !
01296 YUNIT=' (kg/m2)'
01297 DO JLAYER=1,IWORK
01298   WRITE(YLVL,'(I4)') JLAYER
01299   YRECFM='SOILM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01300   YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01301   YCOMMENT='X_Y_'//YRECFM//YUNIT
01302   CALL WRITE_SURF(HPROGRAM,YRECFM,ZMOIST(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
01303 END DO
01304 !
01305 ! * soil ice water content (m3/m3) and soil ice mass (kg/m2)
01306 !
01307 IWORK=NGROUND_LAYER
01308 IF(CISBA/='DIF')THEN
01309   IWORK=NGROUND_LAYER-1 ! No ice in the FR 3-layers
01310 ENDIF
01311 !
01312 YUNIT=' (m3/m3)'
01313 DO JLAYER=1,IWORK
01314   WRITE(YLVL,'(I4)') JLAYER
01315   YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01316   YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01317   YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
01318   CALL WRITE_SURF(HPROGRAM,YRECFM,ZWGI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT) 
01319 END DO   
01320 !
01321 YUNIT=' (kg/m2)'
01322 DO JLAYER=1,IWORK
01323   WRITE(YLVL,'(I4)') JLAYER
01324   YRECFM='SOILI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01325   YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01326   YCOMMENT='X_Y_'//YRECFM//YUNIT
01327   CALL WRITE_SURF(HPROGRAM,YRECFM,ZICE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
01328 END DO
01329 !
01330 ! * water intercepted on leaves (kg/m2)
01331 !
01332 ZWORK(:)=0.0
01333 DO JPATCH=1,NPATCH
01334   ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XWR(:,JPATCH)
01335 ENDDO
01336 !
01337 YRECFM='WR_ISBA'
01338 YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
01339  CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01340 !
01341 ! * Glacier ice storage (semi-prognostic) (kg/m2)
01342 !
01343 IF(LGLACIER)THEN
01344   !
01345   ZWORK(:)=0.0
01346   DO JPATCH=1,NPATCH
01347     ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XICE_STO(:,JPATCH)
01348   ENDDO    
01349   !
01350   YRECFM='ICE_STO_ISBA'
01351   YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
01352   CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01353   !
01354 ENDIF
01355 !
01356 ! * Snow albedo (-) 
01357 !
01358 ZPATCH(:) = 0.0
01359 ZWORK (:) = 0.0
01360 DO JPATCH=1,NPATCH
01361   WHERE(TSNOW%ALB(:,JPATCH)/=XUNDEF)
01362     ZWORK (:) = ZWORK(:)  + XPATCH(:,JPATCH) * TSNOW%ALB(:,JPATCH)
01363     ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
01364   ENDWHERE
01365 ENDDO
01366 !
01367 WHERE(ZPATCH(:)>0.0)
01368   ZWORK(:) = ZWORK(:) / ZPATCH(:)
01369 ELSEWHERE
01370   ZWORK(:) = XUNDEF
01371 ENDWHERE
01372 !
01373 YRECFM='ASNOW_ISBA'
01374 YCOMMENT='X_Y_'//YRECFM//' (-)'
01375  CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01376 !  
01377 IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
01378   !
01379   ! * Snow reservoir (kg/m2) by layer
01380   !
01381   DO JLAYER = 1,TSNOW%NLAYER
01382     !
01383     ZWORK(:)=0.0
01384     DO JPATCH=1,NPATCH
01385       ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)
01386     ENDDO
01387     !
01388     WRITE(YLVL,'(I4)') JLAYER
01389     YRECFM='WSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01390     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01391     YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
01392     CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01393     !
01394   ENDDO
01395   !
01396   ! * Snow depth (m)
01397   !
01398   DO JLAYER = 1,TSNOW%NLAYER
01399     !
01400     ZWORK(:)=0.0
01401     DO JPATCH=1,NPATCH
01402       ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)/TSNOW%RHO(:,JLAYER,JPATCH)
01403     ENDDO
01404     !
01405     WRITE(YLVL,'(I4)') JLAYER
01406     YRECFM='DSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01407     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01408     YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
01409     CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01410     !
01411   ENDDO
01412   !
01413   ! * Snow temperature (k)
01414   !    
01415   DO JLAYER = 1,TSNOW%NLAYER
01416     !
01417     ZWORK (:) = 0.0
01418     ZPATCH(:) = 0.0
01419     DO JPATCH=1,NPATCH
01420       WHERE(TSNOW%WSNOW(:,JLAYER,JPATCH)>0.)
01421         ZWORK (:) = ZWORK (:) + XPATCH(:,JPATCH) * TSNOW%TEMP(:,JLAYER,JPATCH) 
01422         ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
01423       ENDWHERE
01424     ENDDO
01425     !
01426     WHERE(ZPATCH(:)>0.0)
01427       ZWORK(:) = ZWORK(:) / ZPATCH(:)
01428     ELSEWHERE
01429       ZWORK(:) = XUNDEF
01430     ENDWHERE
01431     !
01432     WRITE(YLVL,'(I4)') JLAYER
01433     YRECFM='TSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01434     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01435     YCOMMENT='X_Y_'//YRECFM//' (K)'
01436     CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
01437     !
01438   ENDDO
01439   !
01440 ENDIF
01441 !
01442 ! * Isba-Ags biomass reservoir
01443 !
01444 ! * Isba-Ags biomass reservoir
01445 !
01446 IF(CPHOTO=='NIT'.OR.CPHOTO=='NCB')THEN
01447 !
01448   ZBIOMASS(:,:)=0.0
01449   DO JPATCH=1,NPATCH
01450      DO JLAYER=1,NNBIOMASS
01451         DO JJ=1,INI 
01452          ZBIOMASS(JJ,JLAYER) = ZBIOMASS(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XBIOMASS(JJ,JLAYER,JPATCH)
01453         ENDDO
01454      ENDDO
01455   ENDDO
01456 !
01457   DO JLAYER = 1,NNBIOMASS
01458     WRITE(YLVL,'(I4)') JLAYER
01459     YRECFM='BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01460     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01461     YCOMMENT='X_Y_'//YRECFM//' (kgDM/m2)'
01462     CALL WRITE_SURF(HPROGRAM,YRECFM,ZBIOMASS(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)  
01463   ENDDO
01464 !
01465 ENDIF
01466 !
01467 ! * Isba-CC carbon reservoir
01468 !
01469 IF(CRESPSL=='CNT')THEN
01470 !
01471   ZLITTER(:,:,:)=0.0
01472   ZLIGNIN_STRUC(:,:)=0.0
01473   DO JPATCH=1,NPATCH
01474      DO JLAYER=1,NNLITTLEVS
01475        DO JJ=1,INI 
01476           ZLITTER(JJ,1,JLAYER) = ZLITTER(JJ,1,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,1,JLAYER,JPATCH)
01477           ZLITTER(JJ,2,JLAYER) = ZLITTER(JJ,2,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,2,JLAYER,JPATCH)
01478           ZLIGNIN_STRUC(JJ,JLAYER) = ZLIGNIN_STRUC(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XLIGNIN_STRUC(JJ,JLAYER,JPATCH)
01479        ENDDO
01480     ENDDO
01481   ENDDO
01482 !       
01483   DO JLAYER=1,NNLITTLEVS
01484      WRITE(YLVL,'(I4)') JLAYER
01485      YRECFM='LIT1_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01486      YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01487      YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
01488      CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,1,JLAYER),IRESP,HCOMMENT=YCOMMENT)  
01489      WRITE(YLVL,'(I4)') JLAYER
01490      YRECFM='LIT2_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01491      YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01492      YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
01493      CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,2,JLAYER),IRESP,HCOMMENT=YCOMMENT)
01494      WRITE(YLVL,'(I4)') JLAYER
01495      YRECFM='LIGSTR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01496      YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01497      YCOMMENT='X_Y_'//YRECFM//' (-)'
01498      CALL WRITE_SURF(HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)      
01499   END DO
01500 !
01501   ZSOILCARB(:,:)=0.0
01502   DO JPATCH=1,NPATCH
01503      DO JLAYER=1,NNSOILCARB
01504        DO JJ=1,INI 
01505           ZSOILCARB(JJ,JLAYER) = ZSOILCARB(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XSOILCARB(JJ,JLAYER,JPATCH)
01506        ENDDO
01507     ENDDO
01508   ENDDO
01509 !
01510   DO JLAYER = 1,NNSOILCARB
01511     WRITE(YLVL,'(I4)') JLAYER
01512     YRECFM='SCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
01513     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
01514     YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
01515     CALL WRITE_SURF(HPROGRAM,YRECFM,ZSOILCARB(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)  
01516   ENDDO
01517 !
01518 ENDIF
01519 !
01520 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',1,ZHOOK_HANDLE)
01521 !
01522 END SUBROUTINE PROVAR_TO_DIAG
01523 !
01524 END SUBROUTINE WRITE_DIAG_SEB_ISBA_n