SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
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 (DGU, U, &
7  dti, &
8  hprogram)
9 ! ################################################
10 !
11 !!**** *WRITESURF_PGD_ISBA_PAR_n* - writes ISBA physiographic fields
12 !!
13 !!
14 !! PURPOSE
15 !! -------
16 !!
17 !!** METHOD
18 !! ------
19 !!
20 !! EXTERNAL
21 !! --------
22 !!
23 !!
24 !! IMPLICIT ARGUMENTS
25 !! ------------------
26 !!
27 !! REFERENCE
28 !! ---------
29 !!
30 !!
31 !! AUTHOR
32 !! ------
33 !! V. Masson *Meteo France*
34 !!
35 !! MODIFICATIONS
36 !! -------------
37 !! Original 01/2003
38 !! P. Le Moigne 12/2004 : add type of photosynthesis
39 !! P. Samuelsson 10/2014: MEB
40 !-------------------------------------------------------------------------------
41 !
42 !* 0. DECLARATIONS
43 ! ------------
44 !
45 
46 !
47 !
48 !
49 !
50 USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
51 USE modd_surf_atm_n, ONLY : surf_atm_t
52 !
53 USE modd_data_isba_n, ONLY : data_isba_t
54 !
55 USE modi_write_surf
56 !
57 !
58 USE yomhook ,ONLY : lhook, dr_hook
59 USE parkind1 ,ONLY : jprb
60 !
61 IMPLICIT NONE
62 !
63 !* 0.1 Declarations of arguments
64 ! -------------------------
65 !
66 !
67 !
68 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
69 TYPE(surf_atm_t), INTENT(INOUT) :: u
70 !
71 TYPE(data_isba_t), INTENT(INOUT) :: dti
72 !
73  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling
74 !
75 !* 0.2 Declarations of local variables
76 ! -------------------------------
77 !
78 INTEGER :: iresp ! IRESP : return-code if a problem appears
79  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
80  CHARACTER(LEN=100):: ycomment ! Comment string
81 INTEGER :: jtime ! loop index
82 INTEGER :: jlayer ! loop index
83 INTEGER :: jpatch ! loop index
84 REAL, DIMENSION(:,:), ALLOCATABLE :: zwork
85 REAL(KIND=JPRB) :: zhook_handle
86 !
87 !-------------------------------------------------------------------------------
88 !
89 IF (lhook) CALL dr_hook('WRITESURF_PGD_ISBA_PAR_N',0,zhook_handle)
90 yrecfm='L_VEGTYPE'
91 ycomment=yrecfm
92  CALL write_surf(dgu, u, &
93  hprogram,yrecfm,dti%LDATA_VEGTYPE,iresp,hcomment=ycomment)
94 IF (dti%LDATA_VEGTYPE) THEN
95  yrecfm='D_VEGTYPE'
96  ycomment='X_Y_DATA_VEGTYPE'
97  CALL write_surf(dgu, u, &
98  hprogram,yrecfm,dti%XPAR_VEGTYPE(:,:),iresp,hcomment=ycomment)
99 ENDIF
100 !
101 IF (dti%LDATA_LAI .OR. dti%LDATA_VEG .OR. dti%LDATA_Z0 .OR. dti%LDATA_EMIS) THEN
102  yrecfm='NDATA_TIME'
103  ycomment='(-)'
104  CALL write_surf(dgu, u, &
105  hprogram,yrecfm,dti%NTIME,iresp,hcomment=ycomment)
106 ENDIF
107 !
108 yrecfm='L_VEG'
109 ycomment=yrecfm
110  CALL write_surf(dgu, u, &
111  hprogram,yrecfm,dti%LDATA_VEG,iresp,hcomment=ycomment)
112 IF (dti%LDATA_VEG) THEN
113  DO jtime=1,dti%NTIME
114  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_VEG_T',jtime
115  ycomment='X_Y_D_VEG'
116  CALL write_surf(dgu, u, &
117  hprogram,yrecfm,dti%XPAR_VEG(:,jtime,:),iresp,hcomment=ycomment)
118  END DO
119 ENDIF
120 !
121 yrecfm='L_LAI'
122 ycomment=yrecfm
123  CALL write_surf(dgu, u, &
124  hprogram,yrecfm,dti%LDATA_LAI,iresp,hcomment=ycomment)
125 IF (dti%LDATA_LAI) THEN
126  DO jtime=1,dti%NTIME
127  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_LAI_T',jtime
128  ycomment='X_Y_D_LAI'
129  CALL write_surf(dgu, u, &
130  hprogram,yrecfm,dti%XPAR_LAI(:,jtime,:),iresp,hcomment=ycomment)
131  END DO
132 ENDIF
133 !
134 yrecfm='L_LAIGV'
135 ycomment=yrecfm
136  CALL write_surf(dgu, u, &
137  hprogram,yrecfm,dti%LDATA_LAIGV,iresp,hcomment=ycomment)
138 IF (dti%LDATA_LAIGV) THEN
139  DO jtime=1,36
140  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_LAIGV_T',jtime
141  ycomment='X_Y_D_LAIGV'
142  CALL write_surf(dgu, u, &
143  hprogram,yrecfm,dti%XPAR_LAIGV(:,jtime,:),iresp,hcomment=ycomment)
144  END DO
145 ENDIF
146 !
147 yrecfm='L_H_VEG'
148 ycomment=yrecfm
149  CALL write_surf(dgu, u, &
150  hprogram,yrecfm,dti%LDATA_H_VEG,iresp,hcomment=ycomment)
151 IF (dti%LDATA_H_VEG) THEN
152  DO jtime=1,36
153  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_H_VEG_T',jtime
154  ycomment='X_Y_D_H_VEG'
155  CALL write_surf(dgu, u, &
156  hprogram,yrecfm,dti%XPAR_H_VEG(:,jtime,:),iresp,hcomment=ycomment)
157  END DO
158 ENDIF
159 !
160 yrecfm='L_GNDLITTER'
161 ycomment=yrecfm
162  CALL write_surf(dgu, u, &
163  hprogram,yrecfm,dti%LDATA_GNDLITTER,iresp,hcomment=ycomment)
164 IF (dti%LDATA_GNDLITTER) THEN
165  DO jtime=1,36
166  WRITE(yrecfm,fmt='(A7,I2.2)') 'D_GNDLITTER',jtime
167  ycomment='X_Y_D_GNDLITTER'
168  CALL write_surf(dgu, u, &
169  hprogram,yrecfm,dti%XPAR_GNDLITTER(:,jtime,:),iresp,hcomment=ycomment)
170  END DO
171 ENDIF
172 !
173 yrecfm='L_Z0'
174 ycomment=yrecfm
175  CALL write_surf(dgu, u, &
176  hprogram,yrecfm,dti%LDATA_Z0,iresp,hcomment=ycomment)
177 IF (dti%LDATA_Z0) THEN
178  DO jtime=1,dti%NTIME
179  WRITE(yrecfm,fmt='(A6,I2.2)') 'D_Z0_T',jtime
180  ycomment='X_Y_D_Z0'
181  CALL write_surf(dgu, u, &
182  hprogram,yrecfm,dti%XPAR_Z0(:,jtime,:),iresp,hcomment=ycomment)
183  END DO
184 ENDIF
185 !
186 yrecfm='L_Z0LITTER'
187 ycomment=yrecfm
188  CALL write_surf(dgu, u, &
189  hprogram,yrecfm,dti%LDATA_Z0LITTER,iresp,hcomment=ycomment)
190 IF (dti%LDATA_Z0LITTER) THEN
191  DO jtime=1,36
192  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_Z0LITTER_T',jtime
193  ycomment='X_Y_D_Z0LITTER'
194  CALL write_surf(dgu, u, &
195  hprogram,yrecfm,dti%XPAR_Z0LITTER(:,jtime,:),iresp,hcomment=ycomment)
196  END DO
197 ENDIF
198 !
199 yrecfm='L_EMIS'
200 ycomment=yrecfm
201  CALL write_surf(dgu, u, &
202  hprogram,yrecfm,dti%LDATA_EMIS,iresp,hcomment=ycomment)
203 IF (dti%LDATA_EMIS) THEN
204  DO jtime=1,dti%NTIME
205  WRITE(yrecfm,fmt='(A8,I2.2)') 'D_EMIS_T',jtime
206  ycomment='X_Y_D_EMIS'
207  CALL write_surf(dgu, u, &
208  hprogram,yrecfm,dti%XPAR_EMIS(:,jtime,:),iresp,hcomment=ycomment)
209  END DO
210 ENDIF
211 !
212 yrecfm='L_RSMIN'
213 ycomment=yrecfm
214  CALL write_surf(dgu, u, &
215  hprogram,yrecfm,dti%LDATA_RSMIN,iresp,hcomment=ycomment)
216 IF (dti%LDATA_RSMIN) THEN
217  yrecfm='D_RSMIN'
218  ycomment='X_Y_D_RSMIN'
219  CALL write_surf(dgu, u, &
220  hprogram,yrecfm,dti%XPAR_RSMIN(:,:),iresp,hcomment=ycomment)
221 ENDIF
222 !
223 yrecfm='L_RSMINGV'
224 ycomment=yrecfm
225  CALL write_surf(dgu, u, &
226  hprogram,yrecfm,dti%LDATA_RSMINGV,iresp,hcomment=ycomment)
227 IF (dti%LDATA_RSMINGV) THEN
228  yrecfm='D_RSMINGV'
229  ycomment='X_Y_D_RSMINGV'
230  CALL write_surf(dgu, u, &
231  hprogram,yrecfm,dti%XPAR_RSMINGV(:,:),iresp,hcomment=ycomment)
232 ENDIF
233 !
234 yrecfm='L_GAMMA'
235 ycomment=yrecfm
236  CALL write_surf(dgu, u, &
237  hprogram,yrecfm,dti%LDATA_GAMMA,iresp,hcomment=ycomment)
238 IF (dti%LDATA_GAMMA) THEN
239  yrecfm='D_GAMMA'
240  ycomment='X_Y_D_GAMMA'
241  CALL write_surf(dgu, u, &
242  hprogram,yrecfm,dti%XPAR_GAMMA(:,:),iresp,hcomment=ycomment)
243 ENDIF
244 !
245 yrecfm='L_GAMMAGV'
246 ycomment=yrecfm
247  CALL write_surf(dgu, u, &
248  hprogram,yrecfm,dti%LDATA_GAMMAGV,iresp,hcomment=ycomment)
249 IF (dti%LDATA_GAMMAGV) THEN
250  yrecfm='D_GAMMAGV'
251  ycomment='X_Y_D_GAMMAGV'
252  CALL write_surf(dgu, u, &
253  hprogram,yrecfm,dti%XPAR_GAMMAGV(:,:),iresp,hcomment=ycomment)
254 ENDIF
255 !
256 yrecfm='L_WRMAX_CF'
257 ycomment=yrecfm
258  CALL write_surf(dgu, u, &
259  hprogram,yrecfm,dti%LDATA_WRMAX_CF,iresp,hcomment=ycomment)
260 IF (dti%LDATA_WRMAX_CF) THEN
261  yrecfm='D_WRMAX_CF'
262  ycomment='X_Y_D_WRMAX_CF'
263  CALL write_surf(dgu, u, &
264  hprogram,yrecfm,dti%XPAR_WRMAX_CF(:,:),iresp,hcomment=ycomment)
265 ENDIF
266 !
267 yrecfm='L_WRMAX_CFGV'
268 ycomment=yrecfm
269  CALL write_surf(dgu, u, &
270  hprogram,yrecfm,dti%LDATA_WRMAX_CFGV,iresp,hcomment=ycomment)
271 IF (dti%LDATA_WRMAX_CFGV) THEN
272  yrecfm='D_WRMAX_CFGV'
273  ycomment='X_Y_D_WRMAX_CFGV'
274  CALL write_surf(dgu, u, &
275  hprogram,yrecfm,dti%XPAR_WRMAX_CFGV(:,:),iresp,hcomment=ycomment)
276 ENDIF
277 !
278 yrecfm='L_RGL'
279 ycomment=yrecfm
280  CALL write_surf(dgu, u, &
281  hprogram,yrecfm,dti%LDATA_RGL,iresp,hcomment=ycomment)
282 IF (dti%LDATA_RGL) THEN
283  yrecfm='D_RGL'
284  ycomment='X_Y_D_RGL'
285  CALL write_surf(dgu, u, &
286  hprogram,yrecfm,dti%XPAR_RGL(:,:),iresp,hcomment=ycomment)
287 ENDIF
288 !
289 yrecfm='L_RGLGV'
290 ycomment=yrecfm
291  CALL write_surf(dgu, u, &
292  hprogram,yrecfm,dti%LDATA_RGLGV,iresp,hcomment=ycomment)
293 IF (dti%LDATA_RGLGV) THEN
294  yrecfm='D_RGLGV'
295  ycomment='X_Y_D_RGLGV'
296  CALL write_surf(dgu, u, &
297  hprogram,yrecfm,dti%XPAR_RGLGV(:,:),iresp,hcomment=ycomment)
298 ENDIF
299 !
300 yrecfm='L_CV'
301 ycomment=yrecfm
302  CALL write_surf(dgu, u, &
303  hprogram,yrecfm,dti%LDATA_CV,iresp,hcomment=ycomment)
304 IF (dti%LDATA_CV) THEN
305  yrecfm='D_CV'
306  ycomment='X_Y_D_CV'
307  CALL write_surf(dgu, u, &
308  hprogram,yrecfm,dti%XPAR_CV(:,:),iresp,hcomment=ycomment)
309 ENDIF
310 !
311 yrecfm='L_Z0_O_Z0H'
312 ycomment=yrecfm
313  CALL write_surf(dgu, u, &
314  hprogram,yrecfm,dti%LDATA_Z0_O_Z0H,iresp,hcomment=ycomment)
315 IF (dti%LDATA_Z0_O_Z0H) THEN
316  yrecfm='D_Z0_O_Z0H'
317  ycomment='X_Y_D_Z0_O_Z0H'
318  CALL write_surf(dgu, u, &
319  hprogram,yrecfm,dti%XPAR_Z0_O_Z0H(:,:),iresp,hcomment=ycomment)
320 ENDIF
321 !
322 yrecfm='L_DG'
323 ycomment=yrecfm
324  CALL write_surf(dgu, u, &
325  hprogram,yrecfm,dti%LDATA_DG,iresp,hcomment=ycomment)
326 IF (dti%LDATA_DG) THEN
327  ALLOCATE(zwork(SIZE(dti%XPAR_DG,1),SIZE(dti%XPAR_DG,3)))
328  DO jlayer=1,SIZE(dti%XPAR_DG,2)
329  IF (jlayer<10) WRITE(yrecfm,fmt='(A4,I1.1)') 'D_DG',jlayer
330  IF (jlayer>=10) WRITE(yrecfm,fmt='(A4,I2.2)') 'D_DG',jlayer
331  ycomment='X_Y_'//yrecfm
332  DO jpatch=1,SIZE(dti%XPAR_DG,3)
333  zwork(:,jpatch) = dti%XPAR_DG(:,jlayer,jpatch)
334  END DO
335  CALL write_surf(dgu, u, &
336  hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
337  END DO
338  DEALLOCATE(zwork)
339 ENDIF
340 !
341 yrecfm='L_ROOTFRAC'
342 ycomment=yrecfm
343  CALL write_surf(dgu, u, &
344  hprogram,yrecfm,dti%LDATA_ROOTFRAC,iresp,hcomment=ycomment)
345 IF (dti%LDATA_ROOTFRAC) THEN
346  ALLOCATE(zwork(SIZE(dti%XPAR_ROOTFRAC,1),SIZE(dti%XPAR_ROOTFRAC,3)))
347  DO jlayer=1,SIZE(dti%XPAR_ROOTFRAC,2)
348  IF (jlayer<10) WRITE(yrecfm,fmt='(A10,I1.1)') 'D_ROOTFRAC',jlayer
349  IF (jlayer>=10) WRITE(yrecfm,fmt='(A10,I2.2)') 'D_ROOTFRAC',jlayer
350  ycomment='X_Y_'//yrecfm
351  DO jpatch=1,SIZE(dti%XPAR_ROOTFRAC,3)
352  zwork(:,jpatch) = dti%XPAR_ROOTFRAC(:,jlayer,jpatch)
353  END DO
354  CALL write_surf(dgu, u, &
355  hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
356  END DO
357  DEALLOCATE(zwork)
358 ENDIF
359 !
360 yrecfm='L_RTFRACGV'
361  CALL write_surf(dgu, u, &
362  hprogram,yrecfm,dti%LDATA_ROOTFRACGV,iresp,hcomment=ycomment)
363 IF (dti%LDATA_ROOTFRACGV) THEN
364  ALLOCATE(zwork(SIZE(dti%XPAR_ROOTFRACGV,1),SIZE(dti%XPAR_ROOTFRACGV,3)))
365  DO jlayer=1,SIZE(dti%XPAR_ROOTFRACGV,2)
366  IF (jlayer<10) WRITE(yrecfm,fmt='(A10,I1.1)') 'D_RTFRACGV',jlayer
367  IF (jlayer>=10) WRITE(yrecfm,fmt='(A10,I2.2)') 'D_RTFRACGV',jlayer
368  ycomment='X_Y_'//yrecfm
369  DO jpatch=1,SIZE(dti%XPAR_ROOTFRACGV,3)
370  zwork(:,jpatch) = dti%XPAR_ROOTFRACGV(:,jlayer,jpatch)
371  END DO
372  CALL write_surf(dgu, u, &
373  hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
374  END DO
375  DEALLOCATE(zwork)
376 ENDIF
377 !
378 yrecfm='L_GROUND_DPT'
379 ycomment=yrecfm
380  CALL write_surf(dgu, u, &
381  hprogram,yrecfm,dti%LDATA_GROUND_DEPTH,iresp,hcomment=ycomment)
382 IF (dti%LDATA_GROUND_DEPTH) THEN
383  yrecfm='D_GROUND_DPT'
384  ycomment='X_Y_'//yrecfm
385  CALL write_surf(dgu, u, &
386  hprogram,yrecfm,dti%XPAR_GROUND_DEPTH(:,:),iresp,hcomment=ycomment)
387 ENDIF
388 !
389 yrecfm='L_ROOT_DEPTH'
390 ycomment=yrecfm
391  CALL write_surf(dgu, u, &
392  hprogram,yrecfm,dti%LDATA_ROOT_DEPTH,iresp,hcomment=ycomment)
393 IF (dti%LDATA_ROOT_DEPTH) THEN
394  yrecfm='D_ROOT_DEPTH'
395  ycomment='X_Y_'//yrecfm
396  CALL write_surf(dgu, u, &
397  hprogram,yrecfm,dti%XPAR_ROOT_DEPTH(:,:),iresp,hcomment=ycomment)
398 ENDIF
399 !
400 yrecfm='L_RT_DEPTHGV'
401 ycomment=yrecfm
402  CALL write_surf(dgu, u, &
403  hprogram,yrecfm,dti%LDATA_ROOT_DEPTHGV,iresp,hcomment=ycomment)
404 IF (dti%LDATA_ROOT_DEPTHGV) THEN
405  yrecfm='D_RT_DEPTHGV'
406  ycomment='X_Y_'//yrecfm
407  CALL write_surf(dgu, u, &
408  hprogram,yrecfm,dti%XPAR_ROOT_DEPTHGV(:,:),iresp,hcomment=ycomment)
409 ENDIF
410 !
411 yrecfm='L_ROOT_EXT'
412 ycomment=yrecfm
413  CALL write_surf(dgu, u, &
414  hprogram,yrecfm,dti%LDATA_ROOT_EXTINCTION,iresp,hcomment=ycomment)
415 IF (dti%LDATA_ROOT_EXTINCTION) THEN
416  yrecfm='D_ROOT_EXT'
417  ycomment='X_Y_'//yrecfm
418  CALL write_surf(dgu, u, &
419  hprogram,yrecfm,dti%XPAR_ROOT_EXTINCTION(:,:),iresp,hcomment=ycomment)
420 ENDIF
421 !
422 yrecfm='L_RT_EXTGV'
423 ycomment=yrecfm
424  CALL write_surf(dgu, u, &
425  hprogram,yrecfm,dti%LDATA_ROOT_EXTINCTIONGV,iresp,hcomment=ycomment)
426 IF (dti%LDATA_ROOT_EXTINCTIONGV) THEN
427  yrecfm='D_RT_EXTGV'
428  ycomment='X_Y_'//yrecfm
429  CALL write_surf(dgu, u, &
430  hprogram,yrecfm,dti%XPAR_ROOT_EXTINCTIONGV(:,:),iresp,hcomment=ycomment)
431 ENDIF
432 !
433 yrecfm='L_ROOT_LIN'
434 ycomment=yrecfm
435  CALL write_surf(dgu, u, &
436  hprogram,yrecfm,dti%LDATA_ROOT_LIN,iresp,hcomment=ycomment)
437 IF (dti%LDATA_ROOT_LIN) THEN
438  yrecfm='D_ROOT_LIN'
439  ycomment='X_Y_'//yrecfm
440  CALL write_surf(dgu, u, &
441  hprogram,yrecfm,dti%XPAR_ROOT_LIN(:,:),iresp,hcomment=ycomment)
442 ENDIF
443 !
444 yrecfm='L_DICE'
445 ycomment=yrecfm
446  CALL write_surf(dgu, u, &
447  hprogram,yrecfm,dti%LDATA_DICE,iresp,hcomment=ycomment)
448 IF (dti%LDATA_DICE) THEN
449  yrecfm='D_DICE'
450  ycomment='X_Y_'//yrecfm
451  CALL write_surf(dgu, u, &
452  hprogram,yrecfm,dti%XPAR_DICE(:,:),iresp,hcomment=ycomment)
453 ENDIF
454 !
455 yrecfm='L_ALBNIR_VEG'
456 ycomment=yrecfm
457  CALL write_surf(dgu, u, &
458  hprogram,yrecfm,dti%LDATA_ALBNIR_VEG,iresp,hcomment=ycomment)
459 IF (dti%LDATA_ALBNIR_VEG) THEN
460  yrecfm='D_ALBNIR_VEG'
461  ycomment='X_Y_'//yrecfm
462  CALL write_surf(dgu, u, &
463  hprogram,yrecfm,dti%XPAR_ALBNIR_VEG(:,:),iresp,hcomment=ycomment)
464 ENDIF
465 !
466 yrecfm='L_ALBVIS_VEG'
467 ycomment=yrecfm
468  CALL write_surf(dgu, u, &
469  hprogram,yrecfm,dti%LDATA_ALBVIS_VEG,iresp,hcomment=ycomment)
470 IF (dti%LDATA_ALBVIS_VEG) THEN
471  yrecfm='D_ALBVIS_VEG'
472  ycomment='X_Y_'//yrecfm
473  CALL write_surf(dgu, u, &
474  hprogram,yrecfm,dti%XPAR_ALBVIS_VEG(:,:),iresp,hcomment=ycomment)
475 ENDIF
476 !
477 yrecfm='L_ALBUV_VEG'
478 ycomment=yrecfm
479  CALL write_surf(dgu, u, &
480  hprogram,yrecfm,dti%LDATA_ALBUV_VEG,iresp,hcomment=ycomment)
481 IF (dti%LDATA_ALBUV_VEG) THEN
482  yrecfm='D_ALBUV_VEG'
483  ycomment='X_Y_'//yrecfm
484  CALL write_surf(dgu, u, &
485  hprogram,yrecfm,dti%XPAR_ALBUV_VEG(:,:),iresp,hcomment=ycomment)
486 ENDIF
487 !
488 yrecfm='L_ALBNIR_SOI'
489 ycomment=yrecfm
490  CALL write_surf(dgu, u, &
491  hprogram,yrecfm,dti%LDATA_ALBNIR_SOIL,iresp,hcomment=ycomment)
492 IF (dti%LDATA_ALBNIR_SOIL) THEN
493  yrecfm='D_ALBNIR_SOI'
494  ycomment='X_Y_'//yrecfm
495  CALL write_surf(dgu, u, &
496  hprogram,yrecfm,dti%XPAR_ALBNIR_SOIL(:,:),iresp,hcomment=ycomment)
497 ENDIF
498 !
499 yrecfm='L_ALBVIS_SOI'
500 ycomment=yrecfm
501  CALL write_surf(dgu, u, &
502  hprogram,yrecfm,dti%LDATA_ALBVIS_SOIL,iresp,hcomment=ycomment)
503 IF (dti%LDATA_ALBVIS_SOIL) THEN
504  yrecfm='D_ALBVIS_SOI'
505  ycomment='X_Y_'//yrecfm
506  CALL write_surf(dgu, u, &
507  hprogram,yrecfm,dti%XPAR_ALBVIS_SOIL(:,:),iresp,hcomment=ycomment)
508 ENDIF
509 !
510 yrecfm='L_ALBUV_SOI'
511 ycomment=yrecfm
512  CALL write_surf(dgu, u, &
513  hprogram,yrecfm,dti%LDATA_ALBUV_SOIL,iresp,hcomment=ycomment)
514 IF (dti%LDATA_ALBUV_SOIL) THEN
515  yrecfm='D_ALBUV_SOI'
516  ycomment='X_Y_'//yrecfm
517  CALL write_surf(dgu, u, &
518  hprogram,yrecfm,dti%XPAR_ALBUV_SOIL(:,:),iresp,hcomment=ycomment)
519 ENDIF
520 !
521 yrecfm='L_GMES'
522 ycomment=yrecfm
523  CALL write_surf(dgu, u, &
524  hprogram,yrecfm,dti%LDATA_GMES,iresp,hcomment=ycomment)
525 IF (dti%LDATA_GMES) THEN
526  yrecfm='D_GMES'
527  ycomment='X_Y_'//yrecfm
528  CALL write_surf(dgu, u, &
529  hprogram,yrecfm,dti%XPAR_GMES(:,:),iresp,hcomment=ycomment)
530 ENDIF
531 !
532 yrecfm='L_BSLAI'
533 ycomment=yrecfm
534  CALL write_surf(dgu, u, &
535  hprogram,yrecfm,dti%LDATA_BSLAI,iresp,hcomment=ycomment)
536 IF (dti%LDATA_BSLAI) THEN
537  yrecfm='D_BSLAI'
538  ycomment='X_Y_'//yrecfm
539  CALL write_surf(dgu, u, &
540  hprogram,yrecfm,dti%XPAR_BSLAI(:,:),iresp,hcomment=ycomment)
541 ENDIF
542 !
543 yrecfm='L_LAIMIN'
544 ycomment=yrecfm
545  CALL write_surf(dgu, u, &
546  hprogram,yrecfm,dti%LDATA_LAIMIN,iresp,hcomment=ycomment)
547 IF (dti%LDATA_LAIMIN) THEN
548  yrecfm='D_LAIMIN'
549  ycomment='X_Y_'//yrecfm
550  CALL write_surf(dgu, u, &
551  hprogram,yrecfm,dti%XPAR_LAIMIN(:,:),iresp,hcomment=ycomment)
552 ENDIF
553 !
554 yrecfm='L_SEFOLD'
555 ycomment=yrecfm
556  CALL write_surf(dgu, u, &
557  hprogram,yrecfm,dti%LDATA_SEFOLD,iresp,hcomment=ycomment)
558 IF (dti%LDATA_SEFOLD) THEN
559  yrecfm='D_SEFOLD'
560  ycomment='X_Y_'//yrecfm
561  CALL write_surf(dgu, u, &
562  hprogram,yrecfm,dti%XPAR_SEFOLD(:,:),iresp,hcomment=ycomment)
563 ENDIF
564 !
565 yrecfm='L_GC'
566 ycomment=yrecfm
567  CALL write_surf(dgu, u, &
568  hprogram,yrecfm,dti%LDATA_GC,iresp,hcomment=ycomment)
569 IF (dti%LDATA_GC) THEN
570  yrecfm='D_GC'
571  ycomment='X_Y_'//yrecfm
572  CALL write_surf(dgu, u, &
573  hprogram,yrecfm,dti%XPAR_GC(:,:),iresp,hcomment=ycomment)
574 ENDIF
575 !
576 yrecfm='L_DMAX'
577 ycomment=yrecfm
578  CALL write_surf(dgu, u, &
579  hprogram,yrecfm,dti%LDATA_DMAX,iresp,hcomment=ycomment)
580 IF (dti%LDATA_DMAX) THEN
581  yrecfm='D_DMAX'
582  ycomment='X_Y_'//yrecfm
583  CALL write_surf(dgu, u, &
584  hprogram,yrecfm,dti%XPAR_DMAX(:,:),iresp,hcomment=ycomment)
585 ENDIF
586 !
587 yrecfm='L_F2I'
588 ycomment=yrecfm
589  CALL write_surf(dgu, u, &
590  hprogram,yrecfm,dti%LDATA_F2I,iresp,hcomment=ycomment)
591 IF (dti%LDATA_F2I) THEN
592  yrecfm='D_F2I'
593  ycomment='X_Y_'//yrecfm
594  CALL write_surf(dgu, u, &
595  hprogram,yrecfm,dti%XPAR_F2I(:,:),iresp,hcomment=ycomment)
596 ENDIF
597 !
598 yrecfm='L_STRESS'
599 ycomment=yrecfm
600  CALL write_surf(dgu, u, &
601  hprogram,yrecfm,dti%LDATA_STRESS,iresp,hcomment=ycomment)
602 IF (dti%LDATA_STRESS) THEN
603  ALLOCATE(zwork(SIZE(dti%LPAR_STRESS,1),SIZE(dti%LPAR_STRESS,2)))
604  zwork=0.
605  WHERE(dti%LPAR_STRESS) zwork=1.
606  yrecfm='D_STRESS'
607  ycomment='X_Y_'//yrecfm
608  CALL write_surf(dgu, u, &
609  hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
610  DEALLOCATE(zwork)
611 ENDIF
612 !
613 yrecfm='L_H_TREE'
614 ycomment=yrecfm
615  CALL write_surf(dgu, u, &
616  hprogram,yrecfm,dti%LDATA_H_TREE,iresp,hcomment=ycomment)
617 IF (dti%LDATA_H_TREE) THEN
618  yrecfm='D_H_TREE'
619  ycomment='X_Y_'//yrecfm
620  CALL write_surf(dgu, u, &
621  hprogram,yrecfm,dti%XPAR_H_TREE(:,:),iresp,hcomment=ycomment)
622 ENDIF
623 !
624 yrecfm='L_RE25'
625 ycomment=yrecfm
626  CALL write_surf(dgu, u, &
627  hprogram,yrecfm,dti%LDATA_RE25,iresp,hcomment=ycomment)
628 IF (dti%LDATA_RE25) THEN
629  yrecfm='D_RE25'
630  ycomment='X_Y_'//yrecfm
631  CALL write_surf(dgu, u, &
632  hprogram,yrecfm,dti%XPAR_RE25(:,:),iresp,hcomment=ycomment)
633 ENDIF
634 !
635 yrecfm='L_CE_NITRO'
636 ycomment=yrecfm
637  CALL write_surf(dgu, u, &
638  hprogram,yrecfm,dti%LDATA_CE_NITRO,iresp,hcomment=ycomment)
639 IF (dti%LDATA_CE_NITRO) THEN
640  yrecfm='D_CE_NITRO'
641  ycomment='X_Y_'//yrecfm
642  CALL write_surf(dgu, u, &
643  hprogram,yrecfm,dti%XPAR_CE_NITRO(:,:),iresp,hcomment=ycomment)
644 ENDIF
645 !
646 yrecfm='L_CF_NITRO'
647 ycomment=yrecfm
648  CALL write_surf(dgu, u, &
649  hprogram,yrecfm,dti%LDATA_CF_NITRO,iresp,hcomment=ycomment)
650 IF (dti%LDATA_CF_NITRO) THEN
651  yrecfm='D_CF_NITRO'
652  ycomment='X_Y_'//yrecfm
653  CALL write_surf(dgu, u, &
654  hprogram,yrecfm,dti%XPAR_CF_NITRO(:,:),iresp,hcomment=ycomment)
655 ENDIF
656 !
657 yrecfm='L_CNA_NITRO'
658 ycomment=yrecfm
659  CALL write_surf(dgu, u, &
660  hprogram,yrecfm,dti%LDATA_CNA_NITRO,iresp,hcomment=ycomment)
661 IF (dti%LDATA_CNA_NITRO) THEN
662  yrecfm='D_CNA_NITRO'
663  ycomment='X_Y_'//yrecfm
664  CALL write_surf(dgu, u, &
665  hprogram,yrecfm,dti%XPAR_CNA_NITRO(:,:),iresp,hcomment=ycomment)
666 ENDIF
667 !
668 yrecfm='L_IRRIG'
669 ycomment=yrecfm
670  CALL write_surf(dgu, u, &
671  hprogram,yrecfm,dti%LDATA_IRRIG,iresp,hcomment=ycomment)
672 IF (dti%LDATA_IRRIG) THEN
673  DO jtime=1,dti%NTIME
674  WRITE(yrecfm,fmt='(A9,I2.2)') 'D_IRRIG_T',jtime
675  ycomment='X_Y_IRRIG'
676  CALL write_surf(dgu, u, &
677  hprogram,yrecfm,dti%XPAR_IRRIG(:,jtime,:),iresp,hcomment=ycomment)
678  ENDDO
679 ENDIF
680 !
681 yrecfm='L_WATSUP'
682 ycomment=yrecfm
683  CALL write_surf(dgu, u, &
684  hprogram,yrecfm,dti%LDATA_WATSUP,iresp,hcomment=ycomment)
685 IF (dti%LDATA_WATSUP) THEN
686  DO jtime=1,dti%NTIME
687  WRITE(yrecfm,fmt='(A10,I2.2)') 'D_WATSUP_T',jtime
688  ycomment='X_Y_WATSUP'
689  CALL write_surf(dgu, u, &
690  hprogram,yrecfm,dti%XPAR_WATSUP(:,jtime,:),iresp,hcomment=ycomment)
691  ENDDO
692 ENDIF
693 !
694 IF (lhook) CALL dr_hook('WRITESURF_PGD_ISBA_PAR_N',1,zhook_handle)
695 !
696 !-------------------------------------------------------------------------------
697 !
698 END SUBROUTINE writesurf_pgd_isba_par_n
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_diag_surf_atm_n
Definition: modd_diag_surf_atmn.F90:6
writesurf_pgd_isba_par_n
subroutine writesurf_pgd_isba_par_n(DGU, U, DTI, HPROGRAM)
Definition: writesurf_pgd_isba_parn.F90:6
modd_data_isba_n
Definition: modd_data_isban.F90:6
modd_data_isba_n::data_isba_t
Definition: modd_data_isban.F90:42
modi_write_surf::write_surf
Definition: write_surf.F90:16
modd_diag_surf_atm_n::diag_surf_atm_t
Definition: modd_diag_surf_atmn.F90:44
modi_write_surf
Definition: write_surf.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:06 for SURFEX by   doxygen 1.8.5