Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / write_diag_misc_isban.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE WRITE_DIAG_MISC_ISBA_n(HPROGRAM)
7 !     #################################
8 !
9 !!****  *WRITE_DIAG_MISC_ISBA* - writes the ISBA diagnostic fields
10 !!
11 !!    PURPOSE
12 !!    -------
13 !!
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    REFERENCE
19 !!    ---------
20 !!
21 !!
22 !!    AUTHOR
23 !!    ------
24 !!      P. Le Moigne   *Meteo France*   
25 !!
26 !!    MODIFICATIONS
27 !!    -------------
28 !!      Original    10/2004
29 !!      B. Decharme    2008  Total Albedo, Total SWI and Floodplains
30 !!      B. Decharme 06/2009  key to write (or not) patch result
31 !!      A.L. Gibelin 04/09 : Add respiration diagnostics
32 !!      A.L. Gibelin 05/09 : Add carbon spinup
33 !!      A.L. Gibelin 07/09 : Suppress RDK and transform GPP as a diagnostic
34 !!      D. Carrer    04/11 : Add FAPAR and effective LAI
35 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
36 !!      B. Decharme  09/12 : Carbon fluxes in diag_evap
37 !!      B. Decharme  09/12   New diag for DIF:
38 !!                           F2 stress
39 !!                           Root zone swi, wg and wgi
40 !!                           swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers
41 !!                           active layer thickness over permafrost
42 !!                           frozen layer thickness over non-permafrost
43 !!      M.Moge    01/2016  using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
44 !!
45 !-------------------------------------------------------------------------------
46 !
47 !*       0.    DECLARATIONS
48 !              ------------
49 !
50 USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
51 !
52 USE MODD_SURF_PAR,        ONLY :   NUNDEF, XUNDEF
53 USE MODD_ISBA_n,          ONLY :   NGROUND_LAYER,       &
54                                    CRUNOFF, CRAIN, CISBA, LTR_ML,  &
55                                    XMUF, NWG_LAYER,                &
56                                    CPHOTO, CRESPSL, LFLOOD,        &
57                                    XFFLOOD, XPIFLOOD, TSNOW  
58 !                                 
59 USE MODD_DIAG_ISBA_n,     ONLY :   LPATCH_BUDGET, XTS, XAVG_TS,    &
60                                    XTSRAD, XAVG_TSRAD  
61 !                                 
62 USE MODD_AGRI,            ONLY :   LAGRIP
63 USE MODD_DIAG_MISC_ISBA_n,ONLY :   LSURF_MISC_BUDGET, LSURF_MISC_DIF,   &
64                                    XHV, XAVG_HV, XSWI, XAVG_SWI,        &
65                                    XTSWI, XAVG_TSWI, XDPSNG, XAVG_PSNG, &
66                                    XDPSNV, XAVG_PSNV, XDPSN, XAVG_PSN,  &
67                                    XSEUIL, XSOIL_TSWI, XALBT, XAVG_ALBT,&                                   
68                                    XTWSNOW, XAVG_TWSNOW, XTDSNOW,       &
69                                    XAVG_TDSNOW,XTTSNOW, XAVG_TTSNOW,    &
70                                    XDFFG, XAVG_FFG, XDFFV, XAVG_FFV,    &
71                                    XDFF, XAVG_FF, XSOIL_TWG, XSOIL_TWGI,&
72                                    XDFSAT , XAVG_FSAT,                  &
73                                    XSURF_TSWI, XSURF_TWG, XSURF_TWGI,   &
74                                    XROOT_TSWI, XROOT_TWG, XROOT_TWGI,   &
75                                    XFRD2_TSWI, XFRD2_TWG, XFRD2_TWGI,   &
76                                    XFRD3_TSWI, XFRD3_TWG, XFRD3_TWGI,   &                                   
77                                    XSNOWLIQ, XSNOWTEMP, XDLAI_EFFC,     &
78                                    XFAPAR, XFAPIR, XDFAPARC, XDFAPIRC,  &
79                                    XFAPAR_BS, XFAPIR_BS, XALT, XAVG_ALT,&
80                                    XFLT, XAVG_FLT, XAVG_LAI
81 !
82 USE MODI_INIT_IO_SURF_n
83 USE MODI_WRITE_SURF
84 USE MODI_WRITE_SURF_FIELD2D
85 USE MODI_END_IO_SURF_n
86 !
87 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
88 USE PARKIND1  ,ONLY : JPRB
89 !
90 IMPLICIT NONE
91 !
92 !*       0.1   Declarations of arguments
93 !              -------------------------
94 !
95  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
96 !
97 !*       0.2   Declarations of local variables
98 !              -------------------------------
99 !
100 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
101  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
102  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
103  CHARACTER(LEN=100):: YCOMMENTUNIT   ! Comment string : unit of the datas in the field to write
104  CHARACTER(LEN=2)  :: YLVL
105  CHARACTER(LEN=20) :: YFORM
106 !
107 INTEGER           :: JLAYER, IWORK, JJ, IDEPTH
108 !
109 REAL(KIND=JPRB) :: ZHOOK_HANDLE
110 !
111 !-------------------------------------------------------------------------------
112 !
113 !         Initialisation for IO
114 !
115 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
116  CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA  ','WRITE')
117 !
118 !-------------------------------------------------------------------------------
119 !
120 IF (LSURF_MISC_BUDGET) THEN
121   !
122   !*       2.     Miscellaneous fields :
123   !
124   !-------------------------------------------------------------------------------
125   !
126   !        2.1    Halstead coefficient
127   !               --------------------
128   !
129   YRECFM='HV_ISBA'
130   YCOMMENT='Halstead coefficient averaged over tile nature (-)'
131   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HV(:),IRESP,HCOMMENT=YCOMMENT)
132   !
133   !        2.2    Snow fractions
134   !               --------------
135   !
136   YRECFM='PSNG_ISBA'
137   YCOMMENT='snow fraction over ground averaged over tile nature (-)'
138   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNG(:),IRESP,HCOMMENT=YCOMMENT)
139   !
140   YRECFM='PSNV_ISBA'
141   YCOMMENT='snow fraction over vegetation averaged over tile nature (-)'
142   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNV(:),IRESP,HCOMMENT=YCOMMENT)
143   !
144   YRECFM='PSN_ISBA'
145   YCOMMENT='total snow fraction averaged over tile nature (-)'
146   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSN(:),IRESP,HCOMMENT=YCOMMENT)
147   !
148   !        2.3    Total Albedo and surface temperature
149   !               ------------------------------------
150   !
151   YRECFM='TALB_ISBA'
152   YCOMMENT='total albedo over tile nature (-)'
153   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALBT(:),IRESP,HCOMMENT=YCOMMENT)
154   !
155   IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
156     !        
157     YRECFM='TS_ISBA'
158     YCOMMENT='total surface temperature (isba+snow) over tile nature'
159     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
160     !
161     YRECFM='TSRAD_ISBA'
162     YCOMMENT='total radiative surface temperature (isba+snow) over tile nature'
163     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSRAD(:),IRESP,HCOMMENT=YCOMMENT)
164     !
165   END IF
166   !
167   !        2.4    Soil Wetness Index, Water content and active layer depth
168   !               --------------------------------------------------------
169   !  
170   IF(CISBA=='DIF')THEN
171     !
172     IWORK = NWG_SIZE
173     !          
174     DO JLAYER = 1,NGROUND_LAYER
175      DO JJ=1,SIZE(NWG_LAYER,1)
176         IDEPTH=MAXVAL(NWG_LAYER(JJ,:),NWG_LAYER(JJ,:)/=NUNDEF)
177         IF(JLAYER>IDEPTH)THEN  
178           XAVG_SWI (JJ,JLAYER) = XUNDEF
179           XAVG_TSWI(JJ,JLAYER) = XUNDEF
180         ENDIF
181       ENDDO 
182     ENDDO
183   ELSE
184     IWORK = NGROUND_LAYER    
185   ENDIF         
186   !
187   DO JLAYER=1,IWORK
188     !
189     WRITE(YLVL,'(I2)') JLAYER
190     !
191     YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
192     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
193     YFORM='(A29,I1.1,A4)'
194     IF (JLAYER >= 10)  YFORM='(A29,I2.2,A4)'
195     WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index for layer ',JLAYER,' (-)'
196     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
197     !
198     YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
199     YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
200     YFORM='(A29,I1.1,A4)'
201     IF (JLAYER >= 10)  YFORM='(A29,I2.2,A4)'
202     WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) for layer ',JLAYER,' (-)'
203     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
204     !
205   END DO
206   !
207   YRECFM='TSWI_T_ISBA'
208   YCOMMENT='total soil wetness index over the soil column (-)'
209   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
210   !
211   YRECFM='WGTOT_T_ISBA'
212   YCOMMENT='total water content (liquid+solid) over the soil column (kg/m2)'
213   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWG(:),IRESP,HCOMMENT=YCOMMENT)
214   !
215   YRECFM='WGI_T_ISBA'
216   YCOMMENT='total ice content (solid) over the soil column (kg/m2)'
217   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
218   !
219   IF(CISBA=='DIF') THEN
220     !
221     IF (LSURF_MISC_DIF)THEN
222       !
223       YRECFM='TSWI_R_ISBA'
224       YCOMMENT='total soil wetness index over the root zone (-)'
225       CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
226       !
227       YRECFM='WGTOT_R_ISBA'
228       YCOMMENT='total water content (liquid+solid) over the root zone (kg/m2)'
229       CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWG(:),IRESP,HCOMMENT=YCOMMENT)
230       !
231       YRECFM='WGI_R_ISBA'
232       YCOMMENT='total ice content (solid) over the root zone (kg/m2)'
233       CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWGI(:),IRESP,HCOMMENT=YCOMMENT)  
234       !    
235       YRECFM='TSWI_S_ISBA'
236       YCOMMENT='total soil wetness index over the surface (-)'
237       CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
238       !
239       YRECFM='WG_S_ISBA'
240       YCOMMENT='liquid water content over the surface (m3/m3)'
241       CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWG(:),IRESP,HCOMMENT=YCOMMENT)
242       !
243       YRECFM='WGI_S_ISBA'
244       YCOMMENT='ice content over the surface (m3/m3)'
245       CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWGI(:),IRESP,HCOMMENT=YCOMMENT)  
246       !
247       YRECFM='TSWI_D2_ISBA'
248       YCOMMENT='total soil wetness index over comparable FR-DG2 reservoir (-)'
249       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
250       !
251       YRECFM='WG_D2_ISBA'
252       YCOMMENT='liquid water content over comparable FR-DG2 reservoir (m3/m3)'
253       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWG(:),IRESP,HCOMMENT=YCOMMENT)
254       !
255       YRECFM='WGI_D2_ISBA'
256       YCOMMENT='ice content over comparable FR-DG2 reservoir (m3/m3)'
257       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWGI(:),IRESP,HCOMMENT=YCOMMENT)  
258       !
259       YRECFM='TSWI_D3_ISBA'
260       YCOMMENT='total soil wetness index over comparable FR-DG3 reservoir (-)'
261       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
262       !
263       YRECFM='WG_D3_ISBA'
264       YCOMMENT='liquid water content over comparable FR-DG3 reservoir (m3/m3)'
265       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWG(:),IRESP,HCOMMENT=YCOMMENT)
266       !
267       YRECFM='WGI_D3_ISBA'
268       YCOMMENT='ice content over comparable FR-DG3 reservoir (m3/m3)'
269       CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWGI(:),IRESP,HCOMMENT=YCOMMENT)  
270       !
271     ENDIF
272     !
273     YRECFM='ALT_ISBA'
274     YCOMMENT='active layer thickness over permafrost (m)'
275     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALT(:),IRESP,HCOMMENT=YCOMMENT)
276     !
277     YRECFM='FLT_ISBA'
278     YCOMMENT='frozen layer thickness over non-permafrost (m)'
279     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FLT(:),IRESP,HCOMMENT=YCOMMENT)
280     !
281   ENDIF
282   !
283   !        2.5    Snow outputs
284   !               -------------
285   !
286   YRECFM='WSNOW_T_ISBA'
287   YCOMMENT='Total_snow_reservoir (kg/m2)'
288   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TWSNOW(:),IRESP,HCOMMENT=YCOMMENT)
289   !
290   YRECFM='DSNOW_T_ISBA'
291   YCOMMENT='Total_snow_depth (m)'
292   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TDSNOW(:),IRESP,HCOMMENT=YCOMMENT)
293   !
294   YRECFM='TSNOW_T_ISBA'
295   YCOMMENT='Total_snow_temperature (K)'
296   CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TTSNOW(:),IRESP,HCOMMENT=YCOMMENT)
297   !
298   !        2.6    SGH scheme
299   !               ----------
300   !
301   IF(CRUNOFF=='SGH '.OR.CRUNOFF=='DT92')THEN     
302     YRECFM='FSAT_ISBA'
303     YCOMMENT='Soil saturated fraction (-)'
304     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FSAT(:),IRESP,HCOMMENT=YCOMMENT)
305   ENDIF
306   !
307   IF(CRAIN=='SGH ')THEN
308     YRECFM='MUF_ISBA'
309     YCOMMENT='fraction of the grid cell reached by the rainfall (-)'
310     CALL WRITE_SURF(HPROGRAM,YRECFM,XMUF(:),IRESP,HCOMMENT=YCOMMENT)
311   ENDIF
312   !
313   !        2.7    Flooding scheme
314   !               ---------------
315   !
316   IF(LFLOOD)THEN
317     !
318     YRECFM='FFG_ISBA'
319     YCOMMENT='flood fraction over ground averaged over tile nature (-)'
320     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFG(:),IRESP,HCOMMENT=YCOMMENT)
321     !
322     YRECFM='FFV_ISBA'
323     YCOMMENT='flood fraction over vegetation averaged over tile nature (-)'
324     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFV(:),IRESP,HCOMMENT=YCOMMENT)
325     !
326     YRECFM='FF_ISBA'
327     YCOMMENT='total flood fraction averaged over tile nature (-)'
328     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FF(:),IRESP,HCOMMENT=YCOMMENT)
329     !
330     YRECFM='FFLOOD_ISBA'
331     YCOMMENT='Grdi-cell potential flood fraction (-)'
332     CALL WRITE_SURF(HPROGRAM,YRECFM,XFFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
333     !
334     YRECFM='PIFLOOD_ISBA'
335     YCOMMENT='Grdi-cell Potential_floodplain_infiltration (kg/m2s)'
336     CALL WRITE_SURF(HPROGRAM,YRECFM,XPIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
337     !
338   ENDIF
339   !
340   !        2.8    Total LAI
341   !               ---------
342   !
343   IF(CPHOTO/='NON')THEN        
344     YRECFM='LAI_ISBA'
345     YCOMMENT='leaf area index (m2/m2)'
346     CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LAI(:),IRESP,HCOMMENT=YCOMMENT)
347   ENDIF
348   !  
349   !*       3.     Miscellaneous fields for each patch :
350   !               -------------------------------------
351   !
352   !----------------------------------------------------------------------------
353   !User wants (or not) patch output
354   IF(LPATCH_BUDGET)THEN
355     !----------------------------------------------------------------------------
356     !
357     !        3.1    Soil Wetness Index and active layer depth
358     !               -----------------------------------------   
359     !
360     DO JLAYER=1,IWORK
361       !
362       WRITE(YLVL,'(I2)') JLAYER
363       !
364       YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
365       YFORM='(A39,I1.1)'
366       IF (JLAYER >= 10)  YFORM='(A39,I2.2)'
367       WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index per patch for layer ',JLAYER
368       YCOMMENTUNIT='-'
369       CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
370       !
371       YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
372       YFORM='(A39,I1.1)'
373       IF (JLAYER >= 10)  YFORM='(A39,I2.2)'
374       WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JLAYER
375       YCOMMENTUNIT='-'
376       CALL WRITE_SURF_FIELD2D(HPROGRAM,XTSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
377       !
378     END DO
379     !
380     IF(CISBA=='DIF')THEN
381       !
382       YRECFM='ALT_P'
383       YCOMMENT='active layer thickness over permafrost per patch'
384       YCOMMENTUNIT='m'
385       CALL WRITE_SURF_FIELD2D(HPROGRAM,XALT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
386       !
387       YRECFM='FLT_P'
388       YCOMMENT='frozen layer thickness over non-permafrost per patch'
389       YCOMMENTUNIT='m'
390       CALL WRITE_SURF_FIELD2D(HPROGRAM,XFLT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
391       !
392     ENDIF
393     !    
394     !        3.2    Snow fractions
395     !               --------------
396     !
397     YRECFM='PSNG'
398     YCOMMENT='snow fraction per patch over ground'
399     YCOMMENTUNIT='-'
400     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSNG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
401     !
402     YRECFM='PSNV'
403     YCOMMENT='snow fraction per patch over vegetation'
404     YCOMMENTUNIT='-'
405     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSNV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
406     !
407     YRECFM='PSN'
408     YCOMMENT='total snow fraction per patch'
409     YCOMMENTUNIT='-'
410     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
411     !
412     !        3.3    SGH scheme
413     !               ----------
414     !
415     IF(CRUNOFF=='DT92')THEN     
416       YRECFM='FSAT_P'
417       YCOMMENT='Soil saturated fraction per patch'
418       YCOMMENTUNIT='-'
419       CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFSAT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
420     ENDIF
421     !
422     !        3.3    Flood fractions
423     !               --------------
424     !
425     IF(LFLOOD)THEN
426       !        
427       YRECFM='FFG_P'
428       YCOMMENT='flood fraction per patch over ground'
429       YCOMMENTUNIT='-'
430       CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFFG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
431       !
432       YRECFM='FFV_P'
433       YCOMMENT='flood fraction per patch over vegetation'
434       YCOMMENTUNIT='-'
435       CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFFV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
436       !
437       YRECFM='FF_P'
438       YCOMMENT='total flood fraction per patch'
439       YCOMMENTUNIT='-'
440       CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
441       !
442     ENDIF
443     !
444     !        3.4    Total Albedo
445     !               ------------
446     !
447     YRECFM='TALB'
448     YCOMMENT='total albedo per patch'
449     !
450     CALL WRITE_SURF(HPROGRAM,YRECFM,XALBT(:,:),IRESP,HCOMMENT=YCOMMENT)
451     !
452     IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
453       YRECFM='TS_P'
454       YCOMMENT='total surface temperature (isba+snow) per patch'
455       YCOMMENTUNIT='-'
456       CALL WRITE_SURF_FIELD2D(HPROGRAM,XTS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
457       YRECFM='TSRAD_P'
458       YCOMMENT='total radiative surface temperature (isba+snow) per patch'
459       YCOMMENTUNIT='-'
460       CALL WRITE_SURF_FIELD2D(HPROGRAM,XTSRAD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
461     ENDIF
462     !
463     !        3.5    Halstead coefficient
464     !               --------------------
465     !
466     YRECFM='HV'
467     YCOMMENT='Halstead coefficient per patch'
468     YCOMMENTUNIT='-'
469     CALL WRITE_SURF_FIELD2D(HPROGRAM,XHV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
470     !
471     !        3.6  Snow outputs 
472     !        -----------------
473     !
474     YRECFM='WSNOW_VEGT'
475     YCOMMENT='X_Y_WSNOW_VEG_TOT per patch'
476     YCOMMENTUNIT='kg/m2'
477     CALL WRITE_SURF_FIELD2D(HPROGRAM,XTWSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
478     !
479     YRECFM='DSNOW_VEGT'
480     YCOMMENT='X_Y_DSNOW_VEG_TOT per patch'
481     YCOMMENTUNIT='m'
482     CALL WRITE_SURF_FIELD2D(HPROGRAM,XTDSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
483     !
484     YRECFM='TSNOW_VEGT'
485     YCOMMENT='X_Y_TSNOW_VEG_TOT per patch'
486     YCOMMENTUNIT='k'
487     CALL WRITE_SURF_FIELD2D(HPROGRAM,XTTSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
488     !
489     IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
490       !
491       DO JLAYER=1,TSNOW%NLAYER
492         !
493         WRITE(YLVL,'(I2)') JLAYER
494         !
495         YRECFM='SNOWLIQ'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
496         YFORM='(A17,I1.1)'
497         IF (JLAYER >= 10)  YFORM='(A17,I2.2)'
498         WRITE(YCOMMENT,FMT=YFORM) 'snow liquid water',JLAYER
499         YCOMMENTUNIT='m'
500         CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNOWLIQ(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
501         !
502         YRECFM='SNOWTEMP'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
503         YFORM='(A16,I1.1)'
504         IF (JLAYER >= 10)  YFORM='(A16,I2.2)'
505         WRITE(YCOMMENT,FMT=YFORM) 'snow temperature',JLAYER
506         YCOMMENTUNIT='K'
507         CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNOWTEMP(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
508         !
509       END DO
510       !        
511     ENDIF
512     !
513   END IF
514   !
515   IF (LAGRIP) THEN
516     !
517     !        2.8    Irrigation threshold
518     !               --------------------
519     !
520     YRECFM='IRRISEUIL'
521     YCOMMENT='irrigation threshold per patch'
522     YCOMMENTUNIT='-'
523     CALL WRITE_SURF_FIELD2D(HPROGRAM,XSEUIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
524     !
525   ENDIF
526   !
527   IF (LTR_ML) THEN
528     !
529     YRECFM='FAPAR'
530     YCOMMENT='FAPAR'
531     YCOMMENTUNIT='-'
532     CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPAR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
533     !
534     YRECFM='FAPIR'
535     YCOMMENT='FAPIR'
536     YCOMMENTUNIT='-'
537     CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPIR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
538     !
539     YRECFM='FAPAR_BS'
540     YCOMMENT='FAPAR_BS'
541     YCOMMENTUNIT='-'
542     CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPAR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
543     !
544     YRECFM='FAPIR_BS'
545     YCOMMENT='FAPIR_BS'
546     YCOMMENTUNIT='-'
547     CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPIR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
548     !
549     YRECFM='DFAPARC'
550     YCOMMENT='DFAPARC'
551     YCOMMENTUNIT='-'
552     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFAPARC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
553     !
554     YRECFM='DFAPIRC'
555     YCOMMENT='DFAPIRC'
556     YCOMMENTUNIT='-'
557     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFAPIRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
558     !
559     YRECFM='DLAI_EFFC'
560     YCOMMENT='DLAI_EFFC'
561     YCOMMENTUNIT='m2/m2'
562     CALL WRITE_SURF_FIELD2D(HPROGRAM,XDLAI_EFFC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
563     !
564   ENDIF
565   !  
566 ENDIF
567 !         End of IO
568 !
569  CALL END_IO_SURF_n(HPROGRAM)
570 IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
571 !
572 END SUBROUTINE WRITE_DIAG_MISC_ISBA_n