SURFEX v8.1
General documentation of Surfex
writesurf_pgd_isba_parn.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE writesurf_pgd_isba_par_n (HSELECT, DTV, HPROGRAM)
7 ! ################################################
8 !
9 !!**** *WRITESURF_PGD_ISBA_PAR_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 !! P. Samuelsson 10/2014: MEB
38 !-------------------------------------------------------------------------------
39 !
40 !* 0. DECLARATIONS
41 ! ------------
42 !
43 USE modd_data_isba_n, ONLY : data_isba_t
44 !
45 USE modn_write_surf_atm
46 !
47 USE modi_write_surf
48 !
49 USE yomhook ,ONLY : lhook, dr_hook
50 USE parkind1 ,ONLY : jprb
51 !
52 IMPLICIT NONE
53 !
54 !* 0.1 Declarations of arguments
55 ! -------------------------
56 !
57 !
58  CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
59 !
60 TYPE(data_isba_t), INTENT(INOUT) :: DTV
61 !
62  CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
63 !
64 !* 0.2 Declarations of local variables
65 ! -------------------------------
66 !
67 LOGICAL :: GFOUND ! Return code when searching namelist
68 INTEGER :: ILUOUT ! logical unit of output file
69 INTEGER :: INAM ! logical unit of namelist file
70 INTEGER :: IRESP ! IRESP : return-code if a problem appears
71  CHARACTER(LEN=2) :: YPAT
72  CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
73  CHARACTER(LEN=100):: YCOMMENT ! Comment string
74 INTEGER :: JTIME ! loop index
75 INTEGER :: JL ! loop index
76 INTEGER :: JV ! loop index
77 REAL, DIMENSION(:), ALLOCATABLE :: ZWORK
78 REAL(KIND=JPRB) :: ZHOOK_HANDLE
79 !
80 !-------------------------------------------------------------------------------
81 !
82 IF (lhook) CALL dr_hook('WRITESURF_PGD_ISBA_PAR_N',0,zhook_handle)
83 !
84 yrecfm='L_VEGTYPE'
85 ycomment=yrecfm
86  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_VEGTYPE,iresp,hcomment=ycomment)
87 IF (dtv%LDATA_VEGTYPE) THEN
88  ycomment='X_Y_DATA_ISBATYPE'
89  IF (lsplit_patch) THEN
90  DO jv=1,dtv%NVEGTYPE
91  WRITE(ypat,'(I2)') jv
92  yrecfm = 'D_VEGTY_P'//adjustl(ypat)
93  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_VEGTYPE(:,jv),iresp,hcomment=ycomment)
94  ENDDO
95  ELSE
96  yrecfm='D_VEGTYPE'
97  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_VEGTYPE(:,:),iresp,hcomment=ycomment,hnam_dim="Number_of_covers")
98  ENDIF
99 ENDIF
100 !
101 yrecfm='NDATA_TIME'
102 ycomment='(-)'
103  CALL write_surf(hselect, hprogram,yrecfm,dtv%NTIME,iresp,hcomment=ycomment)
104 !
105 yrecfm='L_VEG'
106 ycomment=yrecfm
107  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_VEG,iresp,hcomment=ycomment,hdir='-')
108 DO jtime=1,dtv%NTIME
109  ycomment='X_Y_D_VEG'
110  DO jv=1,dtv%NVEGTYPE
111  IF (dtv%LDATA_VEG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
112  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_VEG_T',jtime,'V',jv
113  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_VEG(:,jtime,jv),iresp,hcomment=ycomment)
114  ENDIF
115  ENDDO
116 END DO
117 !
118 yrecfm='L_LAI'
119 ycomment=yrecfm
120  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_LAI,iresp,hcomment=ycomment,hdir='-')
121 !for each defined time
122 DO jtime=1,dtv%NTIME
123  ycomment='X_Y_D_LAI'
124  !for each vegtype for this time
125  DO jv=1,dtv%NVEGTYPE
126  ! we write the field only if the data exists
127  IF (dtv%LDATA_LAI((jtime-1)*dtv%NVEGTYPE+jv)) THEN
128  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_LAI_T',jtime,'V',jv
129  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_LAI(:,jtime,jv),iresp,hcomment=ycomment)
130  ENDIF
131  ENDDO
132 END DO
133 !
134 yrecfm='L_Z0'
135 ycomment=yrecfm
136  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_Z0,iresp,hcomment=ycomment,hdir='-')
137 DO jtime=1,dtv%NTIME
138  ycomment='X_Y_D_Z0'
139  DO jv=1,dtv%NVEGTYPE
140  IF (dtv%LDATA_Z0((jtime-1)*dtv%NVEGTYPE+jv)) THEN
141  WRITE(yrecfm,fmt='(A6,I2.2,A1,I2.2)') 'D_Z0_T',jtime,'V',jv
142  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_Z0(:,jtime,jv),iresp,hcomment=ycomment)
143  ENDIF
144  ENDDO
145 END DO
146 !
147 yrecfm='L_EMIS'
148 ycomment=yrecfm
149  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_EMIS,iresp,hcomment=ycomment,hdir='-')
150 DO jtime=1,dtv%NTIME
151  ycomment='X_Y_D_EMIS'
152  DO jv=1,dtv%NVEGTYPE
153  IF (dtv%LDATA_EMIS((jtime-1)*dtv%NVEGTYPE+jv)) THEN
154  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_EMI_T',jtime,'V',jv
155  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_EMIS(:,jtime,jv),iresp,hcomment=ycomment)
156  ENDIF
157  END DO
158 ENDDO
159 !
160 yrecfm='L_H_VEG'
161 ycomment=yrecfm
162  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_H_VEG,iresp,hcomment=ycomment,hdir='-')
163 DO jtime=1,dtv%NTIME
164  ycomment='X_Y_D_H_VEG'
165  DO jv=1,dtv%NVEGTYPE
166  IF (dtv%LDATA_H_VEG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
167  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_HVG_T',jtime,'V',jv
168  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_H_VEG(:,jtime,jv),iresp,hcomment=ycomment)
169  ENDIF
170  ENDDO
171 END DO
172 !
173 yrecfm='L_GNDLITTER'
174 ycomment=yrecfm
175  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_GNDLITTER,iresp,hcomment=ycomment,hdir='-')
176 DO jtime=1,dtv%NTIME
177  ycomment='X_Y_D_GNDLITTER'
178  DO jv=1,dtv%NVEGTYPE
179  IF (dtv%LDATA_GNDLITTER((jtime-1)*dtv%NVEGTYPE+jv)) THEN
180  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_GLI_T',jtime,'V',jv
181  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_GNDLITTER(:,jtime,jv),iresp,hcomment=ycomment)
182  ENDIF
183  ENDDO
184 END DO
185 !
186 yrecfm='L_Z0LITTER'
187 ycomment=yrecfm
188  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_Z0LITTER,iresp,hcomment=ycomment,hdir='-')
189 DO jtime=1,dtv%NTIME
190  ycomment='X_Y_D_Z0LITTER'
191  DO jv=1,dtv%NVEGTYPE
192  IF (dtv%LDATA_Z0LITTER((jtime-1)*dtv%NVEGTYPE+jv)) THEN
193  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_Z0L_T',jtime,'V',jv
194  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_Z0LITTER(:,jtime,jv),iresp,hcomment=ycomment)
195  ENDIF
196  ENDDO
197 END DO
198 !
199 yrecfm='L_ALBNIR_VEG'
200 ycomment=yrecfm
201  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBNIR_VEG,iresp,hcomment=ycomment,hdir='-')
202 DO jtime=1,dtv%NTIME
203  DO jv=1,dtv%NVEGTYPE
204  IF (dtv%LDATA_ALBNIR_VEG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
205  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_ANV_T',jtime,'V',jv
206  ycomment='X_Y_'//yrecfm
207  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBNIR_VEG(:,jtime,jv),iresp,hcomment=ycomment)
208  ENDIF
209  ENDDO
210 ENDDO
211 !
212 yrecfm='L_ALBVIS_VEG'
213 ycomment=yrecfm
214 ycomment=yrecfm
215  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBVIS_VEG,iresp,hcomment=ycomment,hdir='-')
216 DO jtime=1,dtv%NTIME
217  DO jv=1,dtv%NVEGTYPE
218  IF (dtv%LDATA_ALBVIS_VEG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
219  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_AVV_T',jtime,'V',jv
220  ycomment='X_Y_'//yrecfm
221  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBVIS_VEG(:,jtime,jv),iresp,hcomment=ycomment)
222  ENDIF
223  ENDDO
224 ENDDO
225 !
226 yrecfm='L_ALBUV_VEG'
227 ycomment=yrecfm
228  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBUV_VEG,iresp,hcomment=ycomment,hdir='-')
229 DO jtime=1,dtv%NTIME
230  DO jv=1,dtv%NVEGTYPE
231  IF (dtv%LDATA_ALBUV_VEG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
232  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_AUV_T',jtime,'V',jv
233  ycomment='X_Y_'//yrecfm
234  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBUV_VEG(:,jtime,jv),iresp,hcomment=ycomment)
235  ENDIF
236  ENDDO
237 ENDDO
238 !
239 yrecfm='L_ALBNIR_SOI'
240 ycomment=yrecfm
241  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBNIR_SOIL,iresp,hcomment=ycomment,hdir='-')
242 DO jtime=1,dtv%NTIME
243  DO jv=1,dtv%NVEGTYPE
244  IF (dtv%LDATA_ALBNIR_SOIL((jtime-1)*dtv%NVEGTYPE+jv)) THEN
245  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_ANS_T',jtime,'V',jv
246  ycomment='X_Y_'//yrecfm
247  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBNIR_SOIL(:,jtime,jv),iresp,hcomment=ycomment)
248  ENDIF
249  ENDDO
250 ENDDO
251 !
252 yrecfm='L_ALBVIS_SOI'
253 ycomment=yrecfm
254  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBVIS_SOIL,iresp,hcomment=ycomment,hdir='-')
255 DO jtime=1,dtv%NTIME
256  DO jv=1,dtv%NVEGTYPE
257  IF (dtv%LDATA_ALBVIS_SOIL((jtime-1)*dtv%NVEGTYPE+jv)) THEN
258  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_AVS_T',jtime,'V',jv
259  ycomment='X_Y_'//yrecfm
260  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBVIS_SOIL(:,jtime,jv),iresp,hcomment=ycomment)
261  ENDIF
262  ENDDO
263 ENDDO
264 !
265 yrecfm='L_ALBUV_SOI'
266 ycomment=yrecfm
267  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ALBUV_SOIL,iresp,hcomment=ycomment,hdir='-')
268 DO jtime=1,dtv%NTIME
269  DO jv=1,dtv%NVEGTYPE
270  IF (dtv%LDATA_ALBUV_SOIL((jtime-1)*dtv%NVEGTYPE+jv)) THEN
271  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_AUS_T',jtime,'V',jv
272  ycomment='X_Y_'//yrecfm
273  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ALBUV_SOIL(:,jtime,jv),iresp,hcomment=ycomment)
274  ENDIF
275  ENDDO
276 ENDDO
277 !
278 !
279 yrecfm='L_RSMIN'
280 ycomment=yrecfm
281  CALL write_surf(hselect, hprogram,yrecfm,dtv%LDATA_RSMIN,iresp,hcomment=ycomment,hdir='-')
282 ycomment='X_Y_D_RSMIN'
283 DO jv=1,dtv%NVEGTYPE
284  IF (dtv%LDATA_RSMIN(jv)) THEN
285  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_RSMIN_V',jv
286  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_RSMIN(:,jv),iresp,hcomment=ycomment)
287  ENDIF
288 ENDDO
289 !
290 yrecfm='L_GAMMA'
291 ycomment=yrecfm
292  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_GAMMA,iresp,hcomment=ycomment,hdir='-')
293 ycomment='X_Y_D_GAMMA'
294 DO jv=1,dtv%NVEGTYPE
295  IF (dtv%LDATA_GAMMA(jv)) THEN
296  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_GAMMA_V',jv
297  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_GAMMA(:,jv),iresp,hcomment=ycomment)
298  ENDIF
299 ENDDO
300 !
301 yrecfm='L_WRMAX_CF'
302 ycomment=yrecfm
303  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_WRMAX_CF,iresp,hcomment=ycomment,hdir='-')
304 ycomment='X_Y_D_WRMAX_CF'
305 DO jv=1,dtv%NVEGTYPE
306  IF (dtv%LDATA_WRMAX_CF(jv)) THEN
307  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_WRMAX_V',jv
308  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_WRMAX_CF(:,jv),iresp,hcomment=ycomment)
309  ENDIF
310 ENDDO
311 !
312 yrecfm='L_RGL'
313 ycomment=yrecfm
314  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_RGL,iresp,hcomment=ycomment,hdir='-')
315 ycomment='X_Y_D_RGL'
316 DO jv=1,dtv%NVEGTYPE
317  IF (dtv%LDATA_RGL(jv)) THEN
318  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_RGL_V',jv
319  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_RGL(:,jv),iresp,hcomment=ycomment)
320  ENDIF
321 ENDDO
322 !
323 yrecfm='L_CV'
324 ycomment=yrecfm
325  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_CV,iresp,hcomment=ycomment,hdir='-')
326 ycomment='X_Y_D_CV'
327 DO jv=1,dtv%NVEGTYPE
328  IF (dtv%LDATA_CV(jv)) THEN
329  WRITE(yrecfm,fmt='(A6,I2.2)') 'D_CV_V',jv
330  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_CV(:,jv),iresp,hcomment=ycomment)
331  ENDIF
332 ENDDO
333 !
334 yrecfm='L_Z0_O_Z0H'
335 ycomment=yrecfm
336  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_Z0_O_Z0H,iresp,hcomment=ycomment,hdir='-')
337 ycomment='X_Y_D_Z0_O_Z0H'
338 DO jv=1,dtv%NVEGTYPE
339  IF (dtv%LDATA_Z0_O_Z0H(jv)) THEN
340  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_Z0H_V',jv
341  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_Z0_O_Z0H(:,jv),iresp,hcomment=ycomment)
342  ENDIF
343 ENDDO
344 !
345 yrecfm='L_DG'
346 ycomment=yrecfm
347  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_DG,iresp,hcomment=ycomment,hdir='-')
348 DO jv=1,dtv%NVEGTYPE
349  IF (dtv%LDATA_DG(jv)) THEN
350  DO jl=1,SIZE(dtv%XPAR_DG,2)
351  WRITE(yrecfm,fmt='(A6,I2.2,A1,I2.2)') 'D_DG_L',jl,'V',jv
352  ycomment='X_Y_'//yrecfm
353  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_DG(:,jl,jv),iresp,hcomment=ycomment)
354  ENDDO
355  ENDIF
356 ENDDO
357 !
358 yrecfm='L_ROOTFRAC'
359 ycomment=yrecfm
360  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ROOTFRAC,iresp,hcomment=ycomment,hdir='-')
361 DO jv=1,dtv%NVEGTYPE
362  IF (dtv%LDATA_ROOTFRAC(jv)) THEN
363  DO jl=1,SIZE(dtv%XPAR_ROOTFRAC,2)
364  WRITE(yrecfm,fmt='(A6,I2.2,A1,I2.2)') 'D_RTF_L',jl,'V',jv
365  ycomment='X_Y_'//yrecfm
366  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ROOTFRAC(:,jl,jv),iresp,hcomment=ycomment)
367  ENDDO
368  ENDIF
369 ENDDO
370 !
371 yrecfm='L_GROUND_DPT'
372 ycomment=yrecfm
373  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_GROUND_DEPTH,iresp,hcomment=ycomment,hdir='-')
374 DO jv=1,dtv%NVEGTYPE
375  IF (dtv%LDATA_GROUND_DEPTH(jv)) THEN
376  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_GRDPT_V',jv
377  ycomment='X_Y_'//yrecfm
378  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_GROUND_DEPTH(:,jv),iresp,hcomment=ycomment)
379  ENDIF
380 ENDDO
381 !
382 yrecfm='L_ROOT_DEPTH'
383 ycomment=yrecfm
384  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ROOT_DEPTH,iresp,hcomment=ycomment,hdir='-')
385 DO jv=1,dtv%NVEGTYPE
386  IF (dtv%LDATA_ROOT_DEPTH(jv)) THEN
387  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_RTDPT_V',jv
388  ycomment='X_Y_'//yrecfm
389  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ROOT_DEPTH(:,jv),iresp,hcomment=ycomment)
390  ENDIF
391 ENDDO
392 !
393 yrecfm='L_ROOT_EXT'
394 ycomment=yrecfm
395  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ROOT_EXTINCTION,iresp,hcomment=ycomment,hdir='-')
396 DO jv=1,dtv%NVEGTYPE
397  IF (dtv%LDATA_ROOT_EXTINCTION(jv)) THEN
398  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_RTEXT_V',jv
399  ycomment='X_Y_'//yrecfm
400  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ROOT_EXTINCTION(:,jv),iresp,hcomment=ycomment)
401  ENDIF
402 ENDDO
403 !
404 yrecfm='L_ROOT_LIN'
405 ycomment=yrecfm
406  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_ROOT_LIN,iresp,hcomment=ycomment,hdir='-')
407 DO jv=1,dtv%NVEGTYPE
408  IF (dtv%LDATA_ROOT_LIN(jv)) THEN
409  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_RTLIN_V',jv
410  ycomment='X_Y_'//yrecfm
411  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_ROOT_LIN(:,jv),iresp,hcomment=ycomment)
412  ENDIF
413 ENDDO
414 !
415 yrecfm='L_DICE'
416  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_DICE,iresp,hcomment=ycomment,hdir='-')
417 DO jv=1,dtv%NVEGTYPE
418  IF (dtv%LDATA_DICE(jv)) THEN
419  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_DICE_V',jv
420  ycomment='X_Y_'//yrecfm
421  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_DICE(:,jv),iresp,hcomment=ycomment)
422  ENDIF
423 ENDDO
424 !
425 yrecfm='L_GMES'
426 ycomment=yrecfm
427  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_GMES,iresp,hcomment=ycomment,hdir='-')
428 DO jv=1,dtv%NVEGTYPE
429  IF (dtv%LDATA_GMES(jv)) THEN
430  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_GMES_V',jv
431  ycomment='X_Y_'//yrecfm
432  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_GMES(:,jv),iresp,hcomment=ycomment)
433  ENDIF
434 ENDDO
435 !
436 yrecfm='L_BSLAI'
437 ycomment=yrecfm
438  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_BSLAI,iresp,hcomment=ycomment,hdir='-')
439 DO jv=1,dtv%NVEGTYPE
440  IF (dtv%LDATA_BSLAI(jv)) THEN
441  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_BSLAI_V',jv
442  ycomment='X_Y_'//yrecfm
443  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_BSLAI(:,jv),iresp,hcomment=ycomment)
444  ENDIF
445 ENDDO
446 !
447 yrecfm='L_LAIMIN'
448 ycomment=yrecfm
449  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_LAIMIN,iresp,hcomment=ycomment,hdir='-')
450 DO jv=1,dtv%NVEGTYPE
451  IF (dtv%LDATA_LAIMIN(jv)) THEN
452  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_LAIMIN_V',jv
453  ycomment='X_Y_'//yrecfm
454  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_LAIMIN(:,jv),iresp,hcomment=ycomment)
455  ENDIF
456 ENDDO
457 !
458 yrecfm='L_SEFOLD'
459 ycomment=yrecfm
460  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_SEFOLD,iresp,hcomment=ycomment,hdir='-')
461 DO jv=1,dtv%NVEGTYPE
462  IF (dtv%LDATA_SEFOLD(jv)) THEN
463  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_SEFOLD_V',jv
464  ycomment='X_Y_'//yrecfm
465  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_SEFOLD(:,jv),iresp,hcomment=ycomment)
466  ENDIF
467 ENDDO
468 !
469 yrecfm='L_GC'
470 ycomment=yrecfm
471  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_GC,iresp,hcomment=ycomment,hdir='-')
472 DO jv=1,dtv%NVEGTYPE
473  IF (dtv%LDATA_GC(jv)) THEN
474  WRITE(yrecfm,fmt='(A6,I2.2)') 'D_GC_V',jv
475  ycomment='X_Y_'//yrecfm
476  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_GC(:,jv),iresp,hcomment=ycomment)
477  ENDIF
478 ENDDO
479 !
480 yrecfm='L_DMAX'
481 ycomment=yrecfm
482  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_DMAX,iresp,hcomment=ycomment,hdir='-')
483 DO jv=1,dtv%NVEGTYPE
484  IF (dtv%LDATA_DMAX(jv)) THEN
485  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_DMAX_V',jv
486  ycomment='X_Y_'//yrecfm
487  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_DMAX(:,jv),iresp,hcomment=ycomment)
488  ENDIF
489 ENDDO
490 !
491 yrecfm='L_F2I'
492 ycomment=yrecfm
493  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_F2I,iresp,hcomment=ycomment,hdir='-')
494 DO jv=1,dtv%NVEGTYPE
495  IF (dtv%LDATA_F2I(jv)) THEN
496  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_F2I_V',jv
497  ycomment='X_Y_'//yrecfm
498  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_F2I(:,jv),iresp,hcomment=ycomment)
499  ENDIF
500 ENDDO
501 !
502 yrecfm='L_STRESS'
503 ycomment=yrecfm
504  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_STRESS,iresp,hcomment=ycomment,hdir='-')
505 ALLOCATE(zwork(SIZE(dtv%LPAR_STRESS,1)))
506 DO jv=1,dtv%NVEGTYPE
507  IF (dtv%LDATA_STRESS(jv)) THEN
508  zwork=0.
509  WHERE(dtv%LPAR_STRESS(:,jv)) zwork=1.
510  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_STRESS_V',jv
511  ycomment='X_Y_'//yrecfm
512  CALL write_surf(hselect,hprogram,yrecfm,zwork(:),iresp,hcomment=ycomment)
513  ENDIF
514 ENDDO
515 DEALLOCATE(zwork)
516 !
517 yrecfm='L_H_TREE'
518 ycomment=yrecfm
519  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_H_TREE,iresp,hcomment=ycomment,hdir='-')
520 DO jv=1,dtv%NVEGTYPE
521  IF (dtv%LDATA_H_TREE(jv)) THEN
522  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_H_TREE_V',jv
523  ycomment='X_Y_'//yrecfm
524  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_H_TREE(:,jv),iresp,hcomment=ycomment)
525  ENDIF
526 ENDDO
527 !
528 yrecfm='L_RE25'
529 ycomment=yrecfm
530  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_RE25,iresp,hcomment=ycomment,hdir='-')
531 DO jv=1,dtv%NVEGTYPE
532  IF (dtv%LDATA_RE25(jv)) THEN
533  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_RE25_V',jv
534  ycomment='X_Y_'//yrecfm
535  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_RE25(:,jv),iresp,hcomment=ycomment)
536  ENDIF
537 ENDDO
538 !
539 yrecfm='L_CE_NITRO'
540 ycomment=yrecfm
541  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_CE_NITRO,iresp,hcomment=ycomment,hdir='-')
542 DO jv=1,dtv%NVEGTYPE
543  IF (dtv%LDATA_CE_NITRO(jv)) THEN
544  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_CENITR_V',jv
545  ycomment='X_Y_'//yrecfm
546  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_CE_NITRO(:,jv),iresp,hcomment=ycomment)
547  ENDIF
548 ENDDO
549 !
550 yrecfm='L_CF_NITRO'
551 ycomment=yrecfm
552  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_CF_NITRO,iresp,hcomment=ycomment,hdir='-')
553 DO jv=1,dtv%NVEGTYPE
554  IF (dtv%LDATA_CF_NITRO(jv)) THEN
555  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_CFNITR_V',jv
556  ycomment='X_Y_'//yrecfm
557  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_CF_NITRO(:,jv),iresp,hcomment=ycomment)
558  ENDIF
559 ENDDO
560 !
561 yrecfm='L_CNA_NITRO'
562 ycomment=yrecfm
563  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_CNA_NITRO,iresp,hcomment=ycomment,hdir='-')
564 DO jv=1,dtv%NVEGTYPE
565  IF (dtv%LDATA_CNA_NITRO(jv)) THEN
566  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_CNANIT_V',jv
567  ycomment='X_Y_'//yrecfm
568  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_CNA_NITRO(:,jv),iresp,hcomment=ycomment)
569  ENDIF
570 ENDDO
571 !
572 yrecfm='L_IRRIG'
573 ycomment=yrecfm
574  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_IRRIG,iresp,hcomment=ycomment,hdir='-')
575 ycomment='X_Y_IRRIG'
576 DO jtime=1,dtv%NTIME
577  DO jv=1,dtv%NVEGTYPE
578  IF (dtv%LDATA_IRRIG((jtime-1)*dtv%NVEGTYPE+jv)) THEN
579  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_IRR_T',jtime,'V',jv
580  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_IRRIG(:,jtime,jv),iresp,hcomment=ycomment)
581  ENDIF
582  ENDDO
583 ENDDO
584 !
585 yrecfm='L_WATSUP'
586 ycomment=yrecfm
587  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_WATSUP,iresp,hcomment=ycomment,hdir='-')
588 ycomment='X_Y_WATSUP'
589 DO jtime=1,dtv%NTIME
590  DO jv=1,dtv%NVEGTYPE
591  IF (dtv%LDATA_WATSUP((jtime-1)*dtv%NVEGTYPE+jv)) THEN
592  WRITE(yrecfm,fmt='(A7,I2.2,A1,I2.2)') 'D_WAT_T',jtime,'V',jv
593  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_WATSUP(:,jtime,jv),iresp,hcomment=ycomment)
594  ENDIF
595  ENDDO
596 ENDDO
597 !
598 yrecfm='L_SEED_M'
599 ycomment=yrecfm
600  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_SEED_M,iresp,hcomment=ycomment,hdir='-')
601 ycomment='X_Y_SEED_M'
602 DO jv=1,dtv%NVEGTYPE
603  IF (dtv%LDATA_SEED_M(jv)) THEN
604  WRITE(yrecfm,fmt='(A10,I2.2,A1)') 'D_SEED_M_V',jv
605  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_SEED_M(:,jv),iresp,hcomment=ycomment)
606  ENDIF
607 ENDDO
608 !
609 yrecfm='L_SEED_D'
610 ycomment=yrecfm
611  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_SEED_D,iresp,hcomment=ycomment,hdir='-')
612 ycomment='X_Y_SEED_D'
613 DO jv=1,dtv%NVEGTYPE
614  IF (dtv%LDATA_SEED_D(jv)) THEN
615  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_SEED_D_V',jv
616  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_SEED_D(:,jv),iresp,hcomment=ycomment)
617  ENDIF
618 ENDDO
619 !
620 yrecfm='L_REAP_M'
621 ycomment=yrecfm
622  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_REAP_M,iresp,hcomment=ycomment,hdir='-')
623 ycomment='X_Y_REAP_M'
624 DO jv=1,dtv%NVEGTYPE
625  IF (dtv%LDATA_REAP_M(jv)) THEN
626  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_REAP_M_V',jv
627  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_REAP_M(:,jv),iresp,hcomment=ycomment)
628  ENDIF
629 ENDDO
630 !
631 yrecfm='L_REAP_D'
632 ycomment=yrecfm
633  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_REAP_D,iresp,hcomment=ycomment,hdir='-')
634 ycomment='X_Y_REAP_D'
635 DO jv=1,dtv%NVEGTYPE
636  IF (dtv%LDATA_REAP_D(jv)) THEN
637  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_REAP_D_V',jv
638  CALL write_surf(hselect,hprogram,yrecfm,dtv%XPAR_REAP_D(:,jv),iresp,hcomment=ycomment)
639  ENDIF
640 ENDDO
641 !
642 !
643 yrecfm='L_CONDSAT'
644 ycomment=yrecfm
645  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_CONDSAT,iresp,hcomment=ycomment)
646 IF (dtv%LDATA_CONDSAT) THEN
647  DO jl=1,SIZE(dtv%XPAR_CONDSAT,2)
648  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_CNDSAT_L',jl
649  ycomment='X_Y_'//yrecfm
650  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_CONDSAT(:,jl),iresp,hcomment=ycomment)
651  END DO
652 ENDIF
653 !
654 yrecfm='L_MPOTSAT'
655 ycomment=yrecfm
656  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_MPOTSAT,iresp,hcomment=ycomment)
657 IF (dtv%LDATA_MPOTSAT) THEN
658  DO jl=1,SIZE(dtv%XPAR_MPOTSAT,2)
659  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_MPTSAT_L',jl
660  ycomment='X_Y_'//yrecfm
661  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_MPOTSAT(:,jl),iresp,hcomment=ycomment)
662  END DO
663 ENDIF
664 !
665 yrecfm='L_BCOEF'
666 ycomment=yrecfm
667  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_BCOEF,iresp,hcomment=ycomment)
668 IF (dtv%LDATA_BCOEF) THEN
669  DO jl=1,SIZE(dtv%XPAR_BCOEF,2)
670  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_BCOEF_L',jl
671  ycomment='X_Y_'//yrecfm
672  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_BCOEF(:,jl),iresp,hcomment=ycomment)
673  END DO
674 ENDIF
675 !
676 yrecfm='L_WWILT'
677 ycomment=yrecfm
678  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_WWILT,iresp,hcomment=ycomment)
679 IF (dtv%LDATA_WWILT) THEN
680  DO jl=1,SIZE(dtv%XPAR_WWILT,2)
681  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_WWILT_L',jl
682  ycomment='X_Y_'//yrecfm
683  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_WWILT(:,jl),iresp,hcomment=ycomment)
684  END DO
685 ENDIF
686 !
687 yrecfm='L_WFC'
688 ycomment=yrecfm
689  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_WFC,iresp,hcomment=ycomment)
690 IF (dtv%LDATA_WFC) THEN
691  DO jl=1,SIZE(dtv%XPAR_WFC,2)
692  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_WFC_L',jl
693  ycomment='X_Y_'//yrecfm
694  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_WFC(:,jl),iresp,hcomment=ycomment)
695  END DO
696 ENDIF
697 !
698 yrecfm='L_WSAT'
699 ycomment=yrecfm
700  CALL write_surf(hselect,hprogram,yrecfm,dtv%LDATA_WSAT,iresp,hcomment=ycomment)
701 IF (dtv%LDATA_WSAT) THEN
702  DO jl=1,SIZE(dtv%XPAR_WSAT,2)
703  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_WSAT_L',jl
704  ycomment='X_Y_'//yrecfm
705  CALL write_surf(hselect, hprogram,yrecfm,dtv%XPAR_WSAT(:,jl),iresp,hcomment=ycomment)
706  END DO
707 ENDIF
708 !
709 IF (lhook) CALL dr_hook('WRITESURF_PGD_ISBA_PAR_N',1,zhook_handle)
710 !
711 !-------------------------------------------------------------------------------
712 !
713 END SUBROUTINE writesurf_pgd_isba_par_n
yomhook::dr_hook
Definition: yomhook.F90:20
modn_write_surf_atm
Definition: modn_write_surf_atm.F90:7
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
modd_data_isba_n::data_isba_t
Definition: modd_data_isban.F90:42
writesurf_pgd_isba_par_n
subroutine writesurf_pgd_isba_par_n(HSELECT, DTV, HPROGRAM)
Definition: writesurf_pgd_isba_parn.F90:7
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
modd_data_isba_n
Definition: modd_data_isban.F90:6
modi_write_surf::write_surf
Definition: write_surf.F90:16
modi_write_surf
Definition: write_surf.F90:6
Generated on Tue Jan 16 2018 16:23:31 for SURFEX v8.1 by   doxygen 1.8.13