Juan 8/12/2016: add management of LEN_HREC in MNH & SURFEX
[MNH-git_open_source-lfs.git] / src / SURFEX / writesurf_pgd_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_PGD_ISBA_n(HPROGRAM)
7 !     ################################################
8 !
9 !!****  *WRITESURF_PGD_ISBA_n* - writes ISBA physiographic 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. Le Moigne 12/2004 : add type of photosynthesis 
37 !!      B. Decharme  06/2009 : add topographic index statistics
38 !!      A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
39 !!      B. Decharme  07/2011 : delete argument HWRITE
40 !!      M. Moge      02/2015 parallelization using WRITE_LCOVER
41 !!      M.Moge    01/2016  using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
42 !!
43 !-------------------------------------------------------------------------------
44 !
45 !*       0.    DECLARATIONS
46 !              ------------
47 !
48 USE MODD_SURF_ATM_n, ONLY : CNATURE
49 USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA,&
50                         CPEDOTF, CPHOTO, LTR_ML, XRM_PATCH,     &
51                         XCLAY, XSAND, XSOC,                     &                          
52                         XAOSIP, XAOSIM, XAOSJP, XAOSJM,         &
53                         XHO2IP, XHO2IM, XHO2JP, XHO2JM,         &
54                         XSSO_SLOPE,                             &
55                         XRUNOFFB, XWDRAIN,                      &
56                         XTI_MIN, XTI_MAX, XTI_MEAN, XTI_STD,    &
57                         XTI_SKEW, XZS,XCOVER,                   &
58                         XZ0EFFJPDIR,                            &
59                         LCOVER, LECOCLIMAP, LCTI, LSOCP, LNOF,  &
60                         XSOILGRID, XPH, XFERT, LPERM, XPERM,    &
61                         XDG, NWG_LAYER
62 !
63 USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
64 !
65 USE MODI_WRITE_SURF
66 USE MODI_WRITE_GRID
67 USE MODI_WRITESURF_PGD_ISBA_PAR_n
68 USE MODI_WRITESURF_PGD_TSZ0_PAR_n
69 !
70 USE MODI_WRITE_SURF_FIELD2D
71 USE MODI_WRITE_SURF_FIELD3D
72 !
73 USE MODI_WRITE_LCOVER
74 !
75 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
76 USE PARKIND1  ,ONLY : JPRB
77 !
78 IMPLICIT NONE
79 !
80 !*       0.1   Declarations of arguments
81 !              -------------------------
82 !
83  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling
84 !
85 !*       0.2   Declarations of local variables
86 !              -------------------------------
87 !
88 INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
89  CHARACTER(LEN=LEN_HREC) :: YRECFM         ! Name of the article to be read
90  CHARACTER(LEN=100):: YCOMMENT       ! Comment string
91  CHARACTER(LEN=100):: YCOMMENTUNIT   ! Comment string : unit of the datas in the field to write
92 REAL(KIND=JPRB) :: ZHOOK_HANDLE
93 !
94 INTEGER :: JL     ! loop counter
95 !
96 !-------------------------------------------------------------------------------
97 !
98 !
99 !* soil scheme option
100 !
101 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',0,ZHOOK_HANDLE)
102 YRECFM='ISBA'
103 YCOMMENT=YRECFM
104  CALL WRITE_SURF(HPROGRAM,YRECFM,CISBA,IRESP,HCOMMENT=YCOMMENT)
105 !
106 !* Pedo-transfert function
107 !
108 YRECFM='PEDOTF'
109 YCOMMENT=YRECFM
110  CALL WRITE_SURF(HPROGRAM,YRECFM,CPEDOTF,IRESP,HCOMMENT=YCOMMENT)
111 !
112 !* type of photosynthesis
113 !
114 YRECFM='PHOTO'
115 YCOMMENT=YRECFM
116  CALL WRITE_SURF(HPROGRAM,YRECFM,CPHOTO,IRESP,HCOMMENT=YCOMMENT)
117 !
118 !* new radiative transfert
119 !
120 YRECFM='TR_ML'
121 YCOMMENT=YRECFM
122  CALL WRITE_SURF(HPROGRAM,YRECFM,LTR_ML,IRESP,HCOMMENT=YCOMMENT)
123 !
124 !* threshold to remove little fractions of patches
125 !
126 YRECFM='RM_PATCH'
127 YCOMMENT=YRECFM
128  CALL WRITE_SURF(HPROGRAM,YRECFM,XRM_PATCH,IRESP,HCOMMENT=YCOMMENT)
129
130 !* number of soil layers
131 !
132 YRECFM='GROUND_LAYER'
133 YCOMMENT=YRECFM
134  CALL WRITE_SURF(HPROGRAM,YRECFM,NGROUND_LAYER,IRESP,HCOMMENT=YCOMMENT)
135 !
136 !* Reference grid for DIF
137 !
138 IF(CISBA=='DIF') THEN
139   YRECFM='SOILGRID'
140   YCOMMENT=YRECFM
141   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILGRID,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
142 ENDIF
143 !
144 !* number of biomass pools
145 !
146 YRECFM='NBIOMASS'
147 YCOMMENT=YRECFM
148  CALL WRITE_SURF(HPROGRAM,YRECFM,NNBIOMASS,IRESP,HCOMMENT=YCOMMENT)
149 !
150 !* number of tiles
151 !
152 YRECFM='PATCH_NUMBER'
153 YCOMMENT=YRECFM
154  CALL WRITE_SURF(HPROGRAM,YRECFM,NPATCH,IRESP,HCOMMENT=YCOMMENT)
155 !
156 !* flag indicating if fields are computed from ecoclimap or not
157 !
158 YRECFM='ECOCLIMAP'
159 YCOMMENT=YRECFM
160  CALL WRITE_SURF(HPROGRAM,YRECFM,LECOCLIMAP,IRESP,HCOMMENT=YCOMMENT)
161 !
162 !
163 !*       2.     Physiographic data fields:
164 !               -------------------------
165 !
166 !* cover classes
167 !
168 CALL WRITE_LCOVER(HPROGRAM,LCOVER)
169 !
170 YCOMMENT='COVER FIELDS'
171  CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
172 !
173 !* orography
174 !
175 YRECFM='ZS'
176 YCOMMENT='ZS'
177  CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
178 !
179 !* latitude, longitude
180 !
181  CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP,XZ0EFFJPDIR)
182 !
183 !
184 !* clay fraction
185 !
186 !
187 YRECFM='CLAY'
188 YCOMMENT='X_Y_CLAY'
189  CALL WRITE_SURF(HPROGRAM,YRECFM,XCLAY(:,1),IRESP,HCOMMENT=YCOMMENT)
190 !
191 !* sand fraction
192 !
193 YRECFM='SAND'
194 YCOMMENT='X_Y_SAND'
195  CALL WRITE_SURF(HPROGRAM,YRECFM,XSAND(:,1),IRESP,HCOMMENT=YCOMMENT)
196 !
197 !* soil organic carbon
198 !
199 YRECFM='SOCP'
200 YCOMMENT=''
201  CALL WRITE_SURF(HPROGRAM,YRECFM,LSOCP,IRESP,HCOMMENT=YCOMMENT)
202 !
203 IF(LSOCP)THEN
204   !        
205   YCOMMENT='X_Y_SOC'
206   YRECFM='SOC_TOP'
207   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,1),IRESP,HCOMMENT=YCOMMENT)
208   YRECFM='SOC_SUB'
209   CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,2),IRESP,HCOMMENT=YCOMMENT)
210   !
211 ENDIF
212 !
213 !* permafrost distribution
214 !
215 YRECFM='PERMAFROST'
216 YCOMMENT=''
217  CALL WRITE_SURF(HPROGRAM,YRECFM,LPERM,IRESP,HCOMMENT=YCOMMENT)
218 !
219 IF(LPERM)THEN
220   YCOMMENT='X_Y_PERM'
221   YRECFM='PERM'
222   CALL WRITE_SURF(HPROGRAM,YRECFM,XPERM(:),IRESP,HCOMMENT=YCOMMENT)
223 ENDIF
224 !
225 !SOILNOX
226 !
227 YRECFM='NO'
228 YCOMMENT=''
229  CALL WRITE_SURF(HPROGRAM,YRECFM,LNOF,IRESP,HCOMMENT=YCOMMENT)
230 !
231 IF (LNOF) THEN
232   !
233   YRECFM='PH'
234   YCOMMENT='X_Y_PH'
235   CALL WRITE_SURF(HPROGRAM,YRECFM,XPH(:),IRESP,HCOMMENT=YCOMMENT)
236   !
237   YRECFM='FERT'
238   YCOMMENT='X_Y_FERT'
239   CALL WRITE_SURF(HPROGRAM,YRECFM,XFERT(:),IRESP,HCOMMENT=YCOMMENT)
240   !
241 ENDIF
242 !
243 !* subgrid-scale orography parameters to compute dynamical roughness length
244 !
245 YRECFM='AOSIP'
246 YCOMMENT='X_Y_AOSIP'
247  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIP,IRESP,HCOMMENT=YCOMMENT)
248 !
249 YRECFM='AOSIM'
250 YCOMMENT='X_Y_AOSIM'
251  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIM,IRESP,HCOMMENT=YCOMMENT)
252 !
253 YRECFM='AOSJP'
254 YCOMMENT='X_Y_AOSJP'
255  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJP,IRESP,HCOMMENT=YCOMMENT)
256 !
257 YRECFM='AOSJM'
258 YCOMMENT='X_Y_AOSJM'
259  CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJM,IRESP,HCOMMENT=YCOMMENT)
260 !
261 YRECFM='HO2IP'
262 YCOMMENT='X_Y_HO2IP'
263  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IP,IRESP,HCOMMENT=YCOMMENT)
264 !
265 YRECFM='HO2IM'
266 YCOMMENT='X_Y_HO2IM'
267  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IM,IRESP,HCOMMENT=YCOMMENT)
268 !
269 YRECFM='HO2JP'
270 YCOMMENT='X_Y_HO2JP'
271  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JP,IRESP,HCOMMENT=YCOMMENT)
272 !
273 YRECFM='HO2JM'
274 YCOMMENT='X_Y_HO2JM'
275  CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JM,IRESP,HCOMMENT=YCOMMENT)
276 !
277 YRECFM='SSO_SLOPE'
278 YCOMMENT='X_Y_SSO_SLOPE (-)'
279  CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_SLOPE,IRESP,HCOMMENT=YCOMMENT)
280 !
281 !* orographic runoff coefficient
282 !
283 YRECFM='RUNOFFB'
284 YCOMMENT='X_Y_RUNOFFB'
285  CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFB,IRESP,HCOMMENT=YCOMMENT)
286 !
287 !* subgrid drainage coefficient
288 !
289 YRECFM='WDRAIN'
290 YCOMMENT='X_Y_WDRAIN'
291  CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
292 !
293 !* topographic index statistics
294 !
295 YRECFM='CTI'
296 YCOMMENT=''
297  CALL WRITE_SURF(HPROGRAM,YRECFM,LCTI,IRESP,HCOMMENT=YCOMMENT)
298 !
299 IF(LCTI)THEN
300 !
301 YRECFM='TI_MIN'
302 YCOMMENT='X_Y_TI_MIN'
303  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MIN,IRESP,HCOMMENT=YCOMMENT)
304 !
305 YRECFM='TI_MAX'
306 YCOMMENT='X_Y_TI_MAX'
307  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MAX,IRESP,HCOMMENT=YCOMMENT)
308 !
309 YRECFM='TI_MEAN'
310 YCOMMENT='X_Y_TI_MEAN'
311  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MEAN,IRESP,HCOMMENT=YCOMMENT)
312 !
313 YRECFM='TI_STD'
314 YCOMMENT='X_Y_TI_STD'
315  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_STD,IRESP,HCOMMENT=YCOMMENT)
316 !
317 YRECFM='TI_SKEW'
318 YCOMMENT='X_Y_TI_SKEW'
319  CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_SKEW,IRESP,HCOMMENT=YCOMMENT)
320 !
321 ENDIF
322 !
323 !-------------------------------------------------------------------------------
324 !
325 !*    3.      ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
326 !             ----------------------------------------------------------------------------------
327 !
328 IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
329         ! note XDG is not associated only in the zoom_pgd step. This is not a
330         ! problem because an initialization of the model is redone just after.
331         ! In all other cases, the fileds are associated and initialized.
332 !
333 !* Soil depth for each patch
334 !
335 YRECFM='ECO_DG'
336 YCOMMENT='soil depth from ecoclimap'
337 YCOMMENTUNIT='M'
338 CALL WRITE_SURF_FIELD3D(HPROGRAM,XDG,1,SIZE(XDG,2),YRECFM,YCOMMENT,YCOMMENTUNIT)
339 !* Total soil depth for moisture
340 !
341   IF (CISBA=='DIF') THEN
342     YRECFM='ECO_WG_L'
343     YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
344     YCOMMENTUNIT='-'
345     CALL WRITE_SURF_FIELD2D(HPROGRAM,FLOAT(NWG_LAYER(:,:)),YRECFM,YCOMMENT,YCOMMENTUNIT)
346   END IF
347 END IF
348 !
349 !-------------------------------------------------------------------------------
350  CALL WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
351 IF (CNATURE=='TSZ0') CALL WRITESURF_PGD_TSZ0_PAR_n(HPROGRAM)
352 !
353 IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',1,ZHOOK_HANDLE)
354 !-------------------------------------------------------------------------------
355 !
356 END SUBROUTINE WRITESURF_PGD_ISBA_n