Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_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 WRITESURF_ISBA_n(HPROGRAM,OLAND_USE)
7 !     #####################################
8 !
9 !!****  *WRITESURF_ISBA_n* - writes ISBA prognostic fields
10 !!                        
11 !!
12 !!    PURPOSE
13 !!    -------
14 !!
15 !!**  METHOD
16 !!    ------
17 !!
18 !!    EXTERNAL
19 !!    --------
20 !!
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!
29 !!    AUTHOR
30 !!    ------
31 !!      V. Masson   *Meteo France*      
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original    01/2003 
36 !!      P. LeMoigne 12/2004 : correct dimensionning if more than 10 layers in
37 !!                            the soil (diffusion version)
38 !!      B. Decharme  2008    : Floodplains
39 !!      B. Decharme  01/2009 : Optional Arpege deep soil temperature write
40 !!      A.L. Gibelin   03/09 : modifications for CENTURY model 
41 !!      A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays 
42 !!      A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
43 !!      B. Decharme  07/2011 : land_use semi-prognostic variables
44 !!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)
45 !!      B. Decharme  09/2012 : write some key for prep_read_external
46 !!      M.Moge    01/2016  using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
47 !!
48 !-------------------------------------------------------------------------------
49 !
50 !*       0.    DECLARATIONS
51 !              ------------
52 !
53 USE MODD_SURF_PAR, ONLY : NUNDEF
54 !
55 USE MODD_ISBA_n, ONLY :   NGROUND_LAYER, CISBA, CPHOTO, CRESPSL, CSOC, &
56                           NNBIOMASS, NNLITTER, NNSOILCARB, NNLITTLEVS, &
57                           XTG, XWG, XWGI, XWR, XLAI, TSNOW, XTSRAD_NAT,&
58                           XRESA, XAN, XANFM, XLE, XANDAY, TTIME,       &
59                           XRESP_BIOMASS, XBIOMASS, XPATCH, XDG,        &
60                           XLITTER, XSOILCARB, XLIGNIN_STRUC, LFLOOD,   &
61                           XZ0_FLOOD, LTEMP_ARP, NTEMPLAYER_ARP,        &
62                           LGLACIER, XICE_STO, LSPINUPCARBS,            &
63                           LSPINUPCARBW, NNBYEARSOLD
64 !
65 USE MODD_ASSIM, ONLY : LASSIM, CASSIM
66 !
67 USE MODD_CH_ISBA_n,    ONLY : NDSTEQ
68 USE MODD_DST_n
69 USE MODD_DST_SURF
70 !
71 USE MODI_WRITE_SURF
72 USE MODI_WRITESURF_GR_SNOW
73 !
74 USE MODI_WRITE_SURF_FIELD3D
75 USE MODI_WRITE_SURF_FIELD2D
76 !
77 !
78 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
79 USE PARKIND1  ,ONLY : JPRB
80 !
81 IMPLICIT NONE
82 !
83 !*       0.1   Declarations of arguments
84 !              -------------------------
85 !
86  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
87 LOGICAL,           INTENT(IN)  :: OLAND_USE !
88 !
89 !*       0.2   Declarations of local variables
90 !              -------------------------------
91 !
92 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
93  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
94  CHARACTER(LEN=4 ) :: YLVL
95  CHARACTER(LEN=5 ) :: YPATCH
96  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
97  CHARACTER(LEN=100):: YCOMMENTUNIT   ! Comment string : unit of the datas in the field to write
98  CHARACTER(LEN=25) :: YFORM          ! Writing format
99 !
100 INTEGER :: JJ, JLAYER, JP, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on levels
101 INTEGER :: IWORK   ! Work integer
102 INTEGER :: JSV
103 REAL(KIND=JPRB) :: ZHOOK_HANDLE
104 !
105 !------------------------------------------------------------------------------
106 !
107 !*       2.     Prognostic fields:
108 !               -----------------
109 !
110 IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',0,ZHOOK_HANDLE)
111 !* soil temperatures
112 !
113 IF(LTEMP_ARP)THEN
114   IWORK=NTEMPLAYER_ARP
115 ELSE
116   IWORK=NGROUND_LAYER
117 ENDIF
118 !
119 YRECFM='TG'
120 YCOMMENT='X_Y_TG'
121 YCOMMENTUNIT='K'
122 CALL WRITE_SURF_FIELD3D(HPROGRAM,XTG,1,IWORK,YRECFM,YCOMMENT,YCOMMENTUNIT)
123 !
124 !* soil liquid water contents
125 !
126 YRECFM='WG'
127 YCOMMENT='X_Y_WG'
128 YCOMMENTUNIT='m3/m3'
129 CALL WRITE_SURF_FIELD3D(HPROGRAM,XWG,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
130 !
131 !* soil ice water contents
132 !
133 YRECFM='WGI'
134 YCOMMENT='X_Y_WGI'
135 YCOMMENTUNIT='m3/m3'
136 CALL WRITE_SURF_FIELD3D(HPROGRAM,XWGI,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
137 !
138 !* water intercepted on leaves
139 !
140 YRECFM='WR'
141 YCOMMENT='X_Y_WR'
142 YCOMMENTUNIT='kg/m2'
143 CALL WRITE_SURF_FIELD2D(HPROGRAM,XWR,YRECFM,YCOMMENT,YCOMMENTUNIT)
144 !
145 !* roughness length of Flood water
146 !
147 IF(LFLOOD)THEN
148   YRECFM='Z0_FLOOD'
149   YCOMMENT='X_Y_Z0_FLOOD'
150   YCOMMENTUNIT='-'
151   CALL WRITE_SURF_FIELD2D(HPROGRAM,XZ0_FLOOD,YRECFM,YCOMMENT,YCOMMENTUNIT)
152 ENDIF
153 !
154 !* Glacier ice storage
155 !
156 IF(LGLACIER)THEN
157   YRECFM='ICE_STO'
158   YCOMMENT='X_Y_ICE_STO'
159   YCOMMENTUNIT='kg/m2'
160   CALL WRITE_SURF_FIELD2D(HPROGRAM,XICE_STO,YRECFM,YCOMMENT,YCOMMENTUNIT)
161 ENDIF
162 !
163 !* Leaf Area Index
164 !
165 IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
166   !
167   IF(LASSIM) THEN
168     IF(CASSIM=='PLUS ') THEN
169       YRECFM='LAIp'
170     ELSEIF(CASSIM=='AVERA') THEN
171       YRECFM='LAIa'
172     ELSEIF(CASSIM=='2DVAR') THEN
173       YRECFM='LAI'
174     ENDIF
175   ELSE
176     YRECFM='LAI'
177   ENDIF
178   !
179   YCOMMENT='X_Y_LAI'
180   YCOMMENTUNIT='m2/m2'
181   CALL WRITE_SURF_FIELD2D(HPROGRAM,XLAI,YRECFM,YCOMMENT,YCOMMENTUNIT)
182   !
183 END IF
184 !
185 !* snow mantel
186 !
187  CALL WRITESURF_GR_SNOW(HPROGRAM,'VEG','     ',TSNOW)
188 !
189 !
190 !* key and/or field usefull to make an external prep
191 !
192 YRECFM = 'GLACIER'
193 YCOMMENT='LGLACIER key for external prep'
194  CALL WRITE_SURF(HPROGRAM,YRECFM,LGLACIER,IRESP,HCOMMENT=YCOMMENT)
195 !
196 IF(CISBA=='DIF')THEN
197 !
198   YRECFM = 'SOC'
199   YCOMMENT='SOC key for external prep'
200   CALL WRITE_SURF(HPROGRAM,YRECFM,CSOC,IRESP,HCOMMENT=YCOMMENT)
201 !
202   IF(CSOC=='SGH')THEN
203 !   Fraction for each patch
204     YRECFM='PATCH'
205     YCOMMENT='X_Y_PATCH for external prep with SOC'
206     YCOMMENTUNIT='-'
207     CALL WRITE_SURF_FIELD2D(HPROGRAM,XPATCH,YRECFM,YCOMMENT,YCOMMENTUNIT)
208   ENDIF
209 !
210 ELSE
211 !
212   YRECFM = 'TEMPARP'
213   YCOMMENT='LTEMP_ARP key for external prep'
214   CALL WRITE_SURF(HPROGRAM,YRECFM,LTEMP_ARP,IRESP,HCOMMENT=YCOMMENT)
215 !
216   IF(LTEMP_ARP)THEN
217     YRECFM = 'NTEMPLARP'
218     YCOMMENT='NTEMPLAYER_ARP for external prep'
219     CALL WRITE_SURF(HPROGRAM,YRECFM,NTEMPLAYER_ARP,IRESP,HCOMMENT=YCOMMENT)
220   ENDIF
221 !
222 ENDIF
223 !
224 !-------------------------------------------------------------------------------
225 !
226 !*       4.  Semi-prognostic variables
227 !            -------------------------
228 !
229 !
230 !* patch averaged radiative temperature (K)
231 !
232 YRECFM='TSRAD_NAT'
233 YCOMMENT='X_TSRAD_NAT (K)'
234  CALL WRITE_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
235 !
236 !* aerodynamical resistance
237 !
238 YRECFM='RESA'
239 YCOMMENT='X_Y_RESA (s/m)'
240 YCOMMENTUNIT='s/m'
241 CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESA,YRECFM,YCOMMENT,YCOMMENTUNIT)
242 !#endif
243 !
244 !* Land use variables
245 !
246 IF(OLAND_USE)THEN
247 !     
248   YRECFM='OLD_PATCH'
249   YCOMMENT='X_Y_OLD_PATCH (-)'
250   YCOMMENTUNIT='-'
251   CALL WRITE_SURF_FIELD2D(HPROGRAM,XPATCH,YRECFM,YCOMMENT,YCOMMENTUNIT)
252 !
253   YRECFM='OLD_DG'
254   YCOMMENT='X_Y_OLD_DG'
255   YCOMMENTUNIT='m'
256   CALL WRITE_SURF_FIELD3D(HPROGRAM,XDG,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
257 !
258 ENDIF
259 !
260 !* ISBA-AGS variables
261 !
262 IF (CPHOTO/='NON') THEN
263   YRECFM='AN'
264   YCOMMENT='X_Y_AN'
265   YCOMMENTUNIT='kgCO2/kgair m/s'
266   CALL WRITE_SURF_FIELD2D(HPROGRAM,XAN,YRECFM,YCOMMENT,YCOMMENTUNIT)
267 !
268   YRECFM='ANDAY'
269   YCOMMENT='X_Y_ANDAY'
270   YCOMMENTUNIT='kgCO2/m2/day'
271   CALL WRITE_SURF_FIELD2D(HPROGRAM,XANDAY,YRECFM,YCOMMENT,YCOMMENTUNIT)
272 !
273   YRECFM='ANFM'
274   YCOMMENT='X_Y_ANFM'
275   YCOMMENTUNIT='kgCO2/kgair m/s'
276   CALL WRITE_SURF_FIELD2D(HPROGRAM,XANFM,YRECFM,YCOMMENT,YCOMMENTUNIT)
277 !
278   YRECFM='LE_AGS'
279   YCOMMENT='X_Y_LE_AGS'
280   YCOMMENTUNIT='W/m2'
281   CALL WRITE_SURF_FIELD2D(HPROGRAM,XLE,YRECFM,YCOMMENT,YCOMMENTUNIT)
282 END IF
283 !
284 !
285 IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
286   !
287 YRECFM='BIOMA'
288 YCOMMENT='X_Y_BIOMASS'
289 YCOMMENTUNIT='kgDM/m2'
290 CALL WRITE_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM,YCOMMENT,YCOMMENTUNIT)
291   !
292   !
293   YRECFM='RESPI'
294   YCOMMENT='X_Y_RESP_BIOMASS'
295   YCOMMENTUNIT='kg/m2/s'
296   CALL WRITE_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS-2,YRECFM,YCOMMENT,YCOMMENTUNIT)
297   !
298   IF (CPHOTO=='NIT') THEN
299     !
300     YRECFM='RESPI'
301     YCOMMENT='X_Y_RESP_BIOMASS'
302     YCOMMENTUNIT='kg/m2/s'
303     CALL WRITE_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,NNBIOMASS-1,NNBIOMASS,YRECFM,YCOMMENT,YCOMMENTUNIT)
304     !
305   ENDIF
306   !
307 END IF
308 !
309 !* Soil carbon
310 !
311 YRECFM = 'RESPSL'
312 YCOMMENT=YRECFM
313  CALL WRITE_SURF(HPROGRAM,YRECFM,CRESPSL,IRESP,HCOMMENT=YCOMMENT)
314 !
315 YRECFM='NLITTER'
316 YCOMMENT=YRECFM
317  CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTER,IRESP,HCOMMENT=YCOMMENT)
318 !
319 YRECFM='NLITTLEVS'
320 YCOMMENT=YRECFM
321  CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTLEVS,IRESP,HCOMMENT=YCOMMENT)
322 !
323 YRECFM='NSOILCARB'
324 YCOMMENT=YRECFM
325  CALL WRITE_SURF(HPROGRAM,YRECFM,NNSOILCARB,IRESP,HCOMMENT=YCOMMENT)
326 !
327 IF(LSPINUPCARBS.OR.LSPINUPCARBW)THEN
328   YRECFM='NBYEARSOLD'
329   YCOMMENT='yrs'
330   CALL WRITE_SURF(HPROGRAM,YRECFM,NNBYEARSOLD,IRESP,HCOMMENT=YCOMMENT)
331 ENDIF
332 !
333 IF (CRESPSL=='CNT') THEN
334   !
335   DO JNLITTER=1,NNLITTER
336     DO JNLITTLEVS=1,NNLITTLEVS
337       YFORM='(A10,I1.1,A1,I1.1)'
338       WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNLITTER,' ',JNLITTLEVS
339       WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
340       YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
341       YCOMMENTUNIT='gC/m2'
342       CALL WRITE_SURF_FIELD2D(HPROGRAM,XLITTER(:,JNLITTER,JNLITTLEVS,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
343     END DO
344   END DO
345 !
346   YRECFM='SOILCARB'
347   YCOMMENT='X_Y_SOILCARB'
348   YCOMMENTUNIT='gC/m2'
349   CALL WRITE_SURF_FIELD3D(HPROGRAM,XSOILCARB,1,NNSOILCARB,YRECFM,YCOMMENT,YCOMMENTUNIT)
350 !
351   YRECFM='LIGNIN_STR'
352   YCOMMENT='X_Y_LIGNIN_STRUC'
353   YCOMMENTUNIT='-'
354   CALL WRITE_SURF_FIELD3D(HPROGRAM,XLIGNIN_STRUC,1,NNLITTLEVS,YRECFM,YCOMMENT,YCOMMENTUNIT)
355 !
356 ENDIF
357 !
358 !
359 IF (NDSTEQ > 0)THEN
360   YRECFM='FLX_DSTM'
361   YCOMMENT='X_Y_FLX_DSTM'
362   YCOMMENTUNIT='kg/m2'
363   CALL WRITE_SURF_FIELD3D(HPROGRAM,XSFDSTM,1,NDSTMDE,YRECFM,YCOMMENT,YCOMMENTUNIT)
364 ENDIF
365 !
366 !-------------------------------------------------------------------------------
367 !
368 !*       5.  Time
369 !            ----
370 !
371 YRECFM='DTCUR'
372 YCOMMENT='s'
373  CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
374 IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',1,ZHOOK_HANDLE)
375 !
376 !-------------------------------------------------------------------------------
377 !
378 END SUBROUTINE WRITESURF_ISBA_n