SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
write_diag_pgd_isban.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 write_diag_pgd_isba_n (DTCO, DGU, U, CHI, DGMI, I, &
7  hprogram)
8 ! #########################################
9 !
10 !!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields
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/2004
36 !! Modified 10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
37 !! Modified 11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
38 !! Modified 11/2013 by B. Decharme : XPATCH now in writesurf_isban.F90
39 !! Modified 10/2014 by P. Samuelsson: MEB variables
40 !! Modified 06/2014 by B. Decharme : add XVEGTYPE
41 !-------------------------------------------------------------------------------
42 !
43 !* 0. DECLARATIONS
44 ! ------------
45 !
46 !
49 USE modd_surf_atm_n, ONLY : surf_atm_t
50 USE modd_ch_isba_n, ONLY : ch_isba_t
52 USE modd_isba_n, ONLY : isba_t
53 !
54 USE modd_surf_par, ONLY : xundef, nundef
55 USE modd_agri, ONLY : lagrip
56 !
57 !
58 USE modd_io_surf_fa, ONLY : lfanocompact, lprep
59 !
60 USE modi_init_io_surf_n
62 USE modi_end_io_surf_n
63 !
64 !
65 USE yomhook ,ONLY : lhook, dr_hook
66 USE parkind1 ,ONLY : jprb
67 !
68 IMPLICIT NONE
69 !
70 !* 0.1 Declarations of arguments
71 ! -------------------------
72 !
73 !
74 TYPE(data_cover_t), INTENT(INOUT) :: dtco
75 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
76 TYPE(surf_atm_t), INTENT(INOUT) :: u
77 TYPE(ch_isba_t), INTENT(INOUT) :: chi
78 TYPE(diag_misc_isba_t), INTENT(INOUT) :: dgmi
79 TYPE(isba_t), INTENT(INOUT) :: i
80 !
81  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling
82 !
83 !* 0.2 Declarations of local variables
84 ! -------------------------------
85 !
86 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,3)) :: zwork ! Work array
87 REAL, DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: zdg ! Work array
88 REAL, DIMENSION(SIZE(I%XDG,1) ) :: zdg2
89 REAL, DIMENSION(SIZE(I%XDG,1) ) :: zdtot
90 !
91 INTEGER :: iresp ! IRESP : return-code if a problem appears
92  CHARACTER(LEN=12) :: yrecfm ! Name of the article to be read
93  CHARACTER(LEN=100):: ycomment ! Comment string
94  CHARACTER(LEN=2) :: ylvlv, ypas
95  CHARACTER(LEN=4) :: ylvl
96 !
97 INTEGER :: jj, jl, jp, ilayer
98 INTEGER :: isize_lmeb_patch ! Number of patches where multi-energy balance should be applied
99 REAL(KIND=JPRB) :: zhook_handle
100 !-------------------------------------------------------------------------------
101 !
102 ! Initialisation for IO
103 !
104 IF (lhook) CALL dr_hook('WRITE_DIAG_PGD_ISBA_N',0,zhook_handle)
105 !
106 isize_lmeb_patch=count(i%LMEB_PATCH(:))
107 !
108  CALL init_io_surf_n(dtco, dgu, u, &
109  hprogram,'NATURE','ISBA ','WRITE')
110 !
111 !-------------------------------------------------------------------------------
112 !
113 !* Leaf Area Index
114 !
115 IF (i%CPHOTO=='NON' .OR. i%CPHOTO=='AGS' .OR. i%CPHOTO=='AST') THEN
116  !
117  yrecfm='LAI'
118  ycomment='leaf area index (-)'
119  !
120  CALL write_surf(dgu, u, &
121  hprogram,yrecfm,i%XLAI(:,:),iresp,hcomment=ycomment)
122  !
123  IF (isize_lmeb_patch>0) THEN
124  !
125  yrecfm='LAIGV'
126  ycomment='MEB: understory leaf area index (-)'
127  !
128  CALL write_surf(dgu, u, &
129  hprogram,yrecfm,i%XLAIGV(:,:),iresp,hcomment=ycomment)
130  !
131  ENDIF
132  !
133 ENDIF
134 !
135 !-------------------------------------------------------------------------------
136 !
137 !* Vegetation fraction
138 !
139 yrecfm='VEG'
140 ycomment='vegetation fraction (-)'
141 !
142  CALL write_surf(dgu, u, &
143  hprogram,yrecfm,i%XVEG(:,:),iresp,hcomment=ycomment)
144 !
145 !* Surface roughness length (without snow)
146 !
147 yrecfm='Z0VEG'
148 ycomment='surface roughness length (without snow) (m)'
149 !
150  CALL write_surf(dgu, u, &
151  hprogram,yrecfm,i%XZ0(:,:),iresp,hcomment=ycomment)
152 !
153 IF (isize_lmeb_patch>0) THEN
154  !
155  yrecfm='GNDLITTER'
156  ycomment='MEB: ground litter fraction (-)'
157  !
158  CALL write_surf(dgu, u, &
159  hprogram,yrecfm,i%XGNDLITTER(:,:),iresp,hcomment=ycomment)
160  !
161  yrecfm='Z0LITTER'
162  ycomment='MEB: ground litter roughness length (without snow) (m)'
163  !
164  CALL write_surf(dgu, u, &
165  hprogram,yrecfm,i%XZ0LITTER(:,:),iresp,hcomment=ycomment)
166  !
167 ENDIF
168 !
169 !-------------------------------------------------------------------------------
170 !
171 !* Soil depth for each patch
172 !
173 DO jl=1,SIZE(i%XDG,2)
174  IF (jl<10) THEN
175  WRITE(yrecfm,fmt='(A2,I1)') 'DG',jl
176  ELSE
177  WRITE(yrecfm,fmt='(A2,I2)') 'DG',jl
178  ENDIF
179  ycomment='soil depth'//' (M)'
180  CALL write_surf(dgu, u, &
181  hprogram,yrecfm,i%XDG(:,jl,:),iresp,hcomment=ycomment)
182 END DO
183 !
184 !* Averaged Soil depth
185 !
186 IF(i%NPATCH>1)THEN
187 !
188  zdg(:,:)=0.0
189  DO jp=1,i%NPATCH
190  DO jl=1,SIZE(i%XDG,2)
191  DO jj=1,SIZE(i%XDG,1)
192  zdg(jj,jl)=zdg(jj,jl)+i%XPATCH(jj,jp)*i%XDG(jj,jl,jp)
193  ENDDO
194  ENDDO
195  ENDDO
196 !
197  DO jl=1,SIZE(i%XDG,2)
198  WRITE(ylvl,'(I4)')jl
199  yrecfm='DG'//adjustl(ylvl(:len_trim(ylvl)))
200  yrecfm=yrecfm(:len_trim(yrecfm))//'_ISBA'
201  ycomment='averaged soil depth layer '//adjustl(ylvl(:len_trim(ylvl)))//' (m)'
202  CALL write_surf(dgu, u, &
203  hprogram,yrecfm,zdg(:,jl),iresp,hcomment=ycomment)
204  END DO
205 !
206 ENDIF
207 !
208 !-------------------------------------------------------------------------------
209 !
210 IF(i%CISBA=='DIF')THEN
211 !
212  zdg2(:)=0.0
213  zdtot(:)=0.0
214  zwork(:,:)=xundef
215  DO jp=1,SIZE(i%XDG,3)
216  DO jj=1,SIZE(i%XDG,1)
217  zdg2(jj)=zdg2(jj)+i%XPATCH(jj,jp)*i%XDG2(jj,jp)
218  jl=i%NWG_LAYER(jj,jp)
219  IF(jl/=nundef)THEN
220  zwork(jj,jp)=i%XDG(jj,jl,jp)
221  zdtot(jj)=zdtot(jj)+i%XPATCH(jj,jp)*i%XDG(jj,jl,jp)
222  ENDIF
223  ENDDO
224  ENDDO
225 !
226 !* Root depth
227 !
228  yrecfm='DROOT_DIF'
229  ycomment='Root depth in ISBA-DIF'
230  CALL write_surf(dgu, u, &
231  hprogram,yrecfm,i%XDROOT(:,:),iresp,hcomment=ycomment)
232 !
233  yrecfm='DG2_DIF'
234  ycomment='DG2 depth in ISBA-DIF'
235  CALL write_surf(dgu, u, &
236  hprogram,yrecfm,i%XDG2(:,:),iresp,hcomment=ycomment)
237 !
238  IF(i%NPATCH>1)THEN
239  yrecfm='DG2_DIF_ISBA'
240  ycomment='Averaged DG2 depth in ISBA-DIF'
241  CALL write_surf(dgu, u, &
242  hprogram,yrecfm,zdg2(:),iresp,hcomment=ycomment)
243  ENDIF
244 !
245 !* Runoff depth
246 !
247  yrecfm='RUNOFFD'
248  ycomment='Runoff deph in ISBA-DIF'
249  CALL write_surf(dgu, u, &
250  hprogram,yrecfm,i%XRUNOFFD(:,:),iresp,hcomment=ycomment)
251 !
252 !* Total soil depth for mositure
253 !
254  yrecfm='DTOT_DIF'
255  ycomment='Total soil depth for moisture in ISBA-DIF'
256  CALL write_surf(dgu, u, &
257  hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
258 !
259  IF(i%NPATCH>1)THEN
260  yrecfm='DTOTDF_ISBA'
261  ycomment='Averaged Total soil depth for moisture in ISBA-DIF'
262  CALL write_surf(dgu, u, &
263  hprogram,yrecfm,zdtot(:),iresp,hcomment=ycomment)
264  ENDIF
265 !
266 !* Root fraction for each patch
267 !
268  DO jl=1,SIZE(i%XROOTFRAC,2)
269  IF (jl<10) THEN
270  WRITE(yrecfm,fmt='(A8,I1)') 'ROOTFRAC',jl
271  ELSE
272  WRITE(yrecfm,fmt='(A8,I2)') 'ROOTFRAC',jl
273  ENDIF
274  ycomment='root fraction by layer (-)'
275  zwork(:,:)=xundef
276  DO jj=1,SIZE(i%XDG,1)
277  WHERE(jl<=i%NWG_LAYER(jj,:).AND.i%NWG_LAYER(jj,:)/=nundef)
278  zwork(jj,:)=i%XROOTFRAC(jj,jl,:)
279  ENDWHERE
280  ENDDO
281  CALL write_surf(dgu, u, &
282  hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
283  END DO
284  !
285  IF (isize_lmeb_patch>0) THEN
286  DO jl=1,SIZE(i%XROOTFRACGV,2)
287  IF (jl<10) THEN
288  WRITE(yrecfm,fmt='(A10,I1)') 'ROOTFRACGV',jl
289  ELSE
290  WRITE(yrecfm,fmt='(A10,I2)') 'ROOTFRACGV',jl
291  ENDIF
292  ycomment='MEB: understory root fraction by layer (-)'
293  zwork(:,:)=xundef
294  DO jj=1,SIZE(i%XDG,1)
295  WHERE(jl<=i%NWG_LAYER(jj,:).AND.i%NWG_LAYER(jj,:)/=nundef)
296  zwork(jj,:)=i%XROOTFRACGV(jj,jl,:)
297  ENDWHERE
298  ENDDO
299  CALL write_surf(dgu, u, &
300  hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
301  END DO
302  ENDIF
303 !
304 !* SOC fraction for each layer
305 !
306  IF(i%LSOC)THEN
307  DO jl=1,SIZE(i%XDG,2)
308  IF (jl<10) THEN
309  WRITE(yrecfm,fmt='(A7,I1)') 'FRACSOC',jl
310  ELSE
311  WRITE(yrecfm,fmt='(A7,I2)') 'FRACSOC',jl
312  ENDIF
313  ycomment='SOC fraction by layer (-)'
314  CALL write_surf(dgu, u, &
315  hprogram,yrecfm,i%XFRACSOC(:,jl),iresp,hcomment=ycomment)
316  END DO
317  ENDIF
318 !
319 ENDIF
320 !
321 !-------------------------------------------------------------------------------
322 !
323 DO jl=1,SIZE(i%XDG,2)
324  IF (jl<10) THEN
325  WRITE(yrecfm,fmt='(A4,I1)') 'WSAT',jl
326  ELSE
327  WRITE(yrecfm,fmt='(A4,I2)') 'WSAT',jl
328  ENDIF
329  ycomment='soil porosity by layer (m3/m3)'
330  CALL write_surf(dgu, u, &
331  hprogram,yrecfm,i%XWSAT(:,jl),iresp,hcomment=ycomment)
332 ENDDO
333 !
334 DO jl=1,SIZE(i%XDG,2)
335  IF (jl<10) THEN
336  WRITE(yrecfm,fmt='(A3,I1)') 'WFC',jl
337  ELSE
338  WRITE(yrecfm,fmt='(A3,I2)') 'WFC',jl
339  ENDIF
340  ycomment='field capacity by layer (m3/m3)'
341  CALL write_surf(dgu, u, &
342  hprogram,yrecfm,i%XWFC(:,jl),iresp,hcomment=ycomment)
343 ENDDO
344 !
345 DO jl=1,SIZE(i%XDG,2)
346  IF (jl<10) THEN
347  WRITE(yrecfm,fmt='(A5,I1)') 'WWILT',jl
348  ELSE
349  WRITE(yrecfm,fmt='(A5,I2)') 'WWILT',jl
350  ENDIF
351  ycomment='wilting point by layer (m3/m3)'
352  CALL write_surf(dgu, u, &
353  hprogram,yrecfm,i%XWWILT(:,jl),iresp,hcomment=ycomment)
354 ENDDO
355 !
356 !-------------------------------------------------------------------------------
357 ! For Earth System Model
358 IF(lfanocompact.AND..NOT.lprep)THEN
359  CALL end_io_surf_n(hprogram)
360  IF (lhook) CALL dr_hook('WRITE_DIAG_PGD_ISBA_N',1,zhook_handle)
361  RETURN
362 ENDIF
363 !
364 !-------------------------------------------------------------------------------
365 !
366 yrecfm='Z0REL'
367 ycomment='orography roughness length (M)'
368 !
369  CALL write_surf(dgu, u, &
370  hprogram,yrecfm,i%XZ0REL(:),iresp,hcomment=ycomment)
371 !
372 !-------------------------------------------------------------------------------
373 !
374 !* Runoff soil ice depth for each patch
375 !
376 IF(i%CHORT=='SGH'.AND.i%CISBA/='DIF')THEN
377  yrecfm='DICE'
378  ycomment='soil ice depth for runoff (m)'
379  CALL write_surf(dgu, u, &
380  hprogram,yrecfm,i%XD_ICE(:,:),iresp,hcomment=ycomment)
381 ENDIF
382 !
383 !-------------------------------------------------------------------------------
384 !
385 !* Fraction of each vegetation type in the grid cell
386 !
387 DO jl=1,SIZE(i%XVEGTYPE_PATCH,2)
388  WRITE(ypas,'(I2)') jl
389  ylvlv=adjustl(ypas(:len_trim(ypas)))
390  WRITE(yrecfm,fmt='(A9)') 'VEGTYPE'//ylvlv
391  ycomment='fraction of each vegetation type in the grid cell'//' (-)'
392  CALL write_surf(dgu, u, &
393  hprogram,yrecfm,i%XVEGTYPE(:,jl),iresp,hcomment=ycomment)
394 END DO
395 !-------------------------------------------------------------------------------
396 !
397 !* Fraction of each vegetation type for each patch
398 !
399 IF(i%NPATCH>1.AND.SIZE(i%XVEGTYPE_PATCH,2)/=SIZE(i%XVEGTYPE_PATCH,3))THEN
400 !
401  DO jl=1,SIZE(i%XVEGTYPE_PATCH,2)
402  WRITE(ypas,'(I2)') jl
403  ylvlv=adjustl(ypas(:len_trim(ypas)))
404  WRITE(yrecfm,fmt='(A9)') 'VEGTY_P'//ylvlv
405  ycomment='fraction of each vegetation type in each patch'//' (-)'
406  CALL write_surf(dgu, u, &
407  hprogram,yrecfm,i%XVEGTYPE_PATCH(:,jl,:),iresp,hcomment=ycomment)
408  END DO
409 !
410 ENDIF
411 !
412 !-------------------------------------------------------------------------------
413 !
414 !* other surface parameters
415 !
416 yrecfm='RSMIN'
417 ycomment='minimum stomatal resistance (sm-1)'
418  CALL write_surf(dgu, u, &
419  hprogram,yrecfm,i%XRSMIN(:,:),iresp,hcomment=ycomment)
420 !
421 yrecfm='GAMMA'
422 ycomment='coefficient for RSMIN calculation (-)'
423  CALL write_surf(dgu, u, &
424  hprogram,yrecfm,i%XGAMMA(:,:),iresp,hcomment=ycomment)
425 !
426 yrecfm='CV'
427 ycomment='vegetation thermal inertia coefficient (-)'
428  CALL write_surf(dgu, u, &
429  hprogram,yrecfm,i%XCV(:,:),iresp,hcomment=ycomment)
430 !
431 yrecfm='RGL'
432 ycomment='maximum solar radiation usable in photosynthesis (-)'
433  CALL write_surf(dgu, u, &
434  hprogram,yrecfm,i%XRGL(:,:),iresp,hcomment=ycomment)
435 !
436 yrecfm='EMIS_ISBA'
437 ycomment='surface emissivity (-)'
438  CALL write_surf(dgu, u, &
439  hprogram,yrecfm,i%XEMIS(:,:),iresp,hcomment=ycomment)
440 !
441 yrecfm='WRMAX_CF'
442 ycomment='coefficient for maximum water interception (-)'
443  CALL write_surf(dgu, u, &
444  hprogram,yrecfm,i%XWRMAX_CF(:,:),iresp,hcomment=ycomment)
445 !
446 IF (isize_lmeb_patch>0) THEN
447  !
448  yrecfm='RSMINGV'
449  ycomment='MEB: understory minimum stomatal resistance (sm-1)'
450  CALL write_surf(dgu, u, &
451  hprogram,yrecfm,i%XRSMINGV(:,:),iresp,hcomment=ycomment)
452  !
453  yrecfm='GAMMAGV'
454  ycomment='MEB: understory coefficient for RSMIN calculation (-)'
455  CALL write_surf(dgu, u, &
456  hprogram,yrecfm,i%XGAMMAGV(:,:),iresp,hcomment=ycomment)
457  !
458  yrecfm='RGLGV'
459  ycomment='MEB: understory maximum solar radiation usable in photosynthesis (-)'
460  CALL write_surf(dgu, u, &
461  hprogram,yrecfm,i%XRGLGV(:,:),iresp,hcomment=ycomment)
462  !
463  yrecfm='WRMAX_CFGV'
464  ycomment='MEB: understory coefficient for maximum water interception (-)'
465  CALL write_surf(dgu, u, &
466  hprogram,yrecfm,i%XWRMAX_CFGV(:,:),iresp,hcomment=ycomment)
467  !
468  yrecfm='H_VEG'
469  ycomment='MEB: height of vegetation (m)'
470  CALL write_surf(dgu, u, &
471  hprogram,yrecfm,i%XH_VEG(:,:),iresp,hcomment=ycomment)
472  !
473 ENDIF
474 !
475 !-------------------------------------------------------------------------------
476 !
477 IF (dgmi%LSURF_DIAG_ALBEDO) THEN
478 !
479 !* Soil albedos
480 !
481 !
482  yrecfm='ALBNIR_S'
483  ycomment='soil near-infra-red albedo (-)'
484  CALL write_surf(dgu, u, &
485  hprogram,yrecfm,i%XALBNIR_SOIL(:,:),iresp,hcomment=ycomment)
486 !
487 !-------------------------------------------------------------------------------
488 !
489  yrecfm='ALBVIS_S'
490  ycomment='soil visible albedo (-)'
491  CALL write_surf(dgu, u, &
492  hprogram,yrecfm,i%XALBVIS_SOIL(:,:),iresp,hcomment=ycomment)
493 !
494 !-------------------------------------------------------------------------------
495 !
496  yrecfm='ALBUV_S'
497  ycomment='soil UV albedo (-)'
498  CALL write_surf(dgu, u, &
499  hprogram,yrecfm,i%XALBUV_SOIL(:,:),iresp,hcomment=ycomment)
500 !
501 !-------------------------------------------------------------------------------
502 !
503 !* albedos
504 !
505  yrecfm='ALBNIR_ISBA'
506  ycomment='total near-infra-red albedo (-)'
507  CALL write_surf(dgu, u, &
508  hprogram,yrecfm,i%XALBNIR(:,:),iresp,hcomment=ycomment)
509 !
510 !-------------------------------------------------------------------------------
511 !
512  yrecfm='ALBVIS_ISBA'
513  ycomment='total visible albedo (-)'
514  CALL write_surf(dgu, u, &
515  hprogram,yrecfm,i%XALBVIS(:,:),iresp,hcomment=ycomment)
516 !
517 !-------------------------------------------------------------------------------
518 !
519  yrecfm='ALBUV_ISBA'
520  ycomment='total UV albedo (-)'
521  CALL write_surf(dgu, u, &
522  hprogram,yrecfm,i%XALBUV(:,:),iresp,hcomment=ycomment)
523 !
524 END IF
525 !
526 !-------------------------------------------------------------------------------
527 !
528 !* chemical soil resistances
529 !
530 IF (chi%CCH_DRY_DEP=='WES89' .AND. chi%SVI%NBEQ>0) THEN
531  yrecfm='SOILRC_SO2'
532  ycomment='bare soil resistance for SO2 (?)'
533  CALL write_surf(dgu, u, &
534  hprogram,yrecfm,chi%XSOILRC_SO2(:,:),iresp,hcomment=ycomment)
535  !
536  yrecfm='SOILRC_O3'
537  ycomment='bare soil resistance for O3 (?)'
538  CALL write_surf(dgu, u, &
539  hprogram,yrecfm,chi%XSOILRC_O3(:,:),iresp,hcomment=ycomment)
540 END IF
541 !
542 !-------------------------------------------------------------------------------
543 !
544 IF (lagrip .AND. (i%CPHOTO=='LAI' .OR. i%CPHOTO=='LST' .OR. i%CPHOTO=='NIT' .OR. i%CPHOTO=='NCB') ) THEN
545 !
546 !* seeding and reaping
547 !
548 !
549  yrecfm='TSEED'
550  ycomment='date of seeding (-)'
551 !
552  CALL write_surf(dgu, u, &
553  hprogram,yrecfm,i%TSEED(:,:),iresp,hcomment=ycomment)
554 !
555  yrecfm='TREAP'
556  ycomment='date of reaping (-)'
557 !
558  CALL write_surf(dgu, u, &
559  hprogram,yrecfm,i%TREAP(:,:),iresp,hcomment=ycomment)
560 !
561 !-------------------------------------------------------------------------------
562 !
563 !* irrigated fraction
564 !
565  yrecfm='IRRIG'
566  ycomment='flag for irrigation (irrigation if >0.) (-)'
567 !
568  CALL write_surf(dgu, u, &
569  hprogram,yrecfm,i%XIRRIG(:,:),iresp,hcomment=ycomment)
570 !
571 !-------------------------------------------------------------------------------
572 !
573 !* water supply for irrigation
574 !
575  yrecfm='WATSUP'
576  ycomment='water supply during irrigation process (mm)'
577 !
578  CALL write_surf(dgu, u, &
579  hprogram,yrecfm,i%XWATSUP(:,:),iresp,hcomment=ycomment)
580 !
581 ENDIF
582 !-------------------------------------------------------------------------------
583 ! End of IO
584 !
585  CALL end_io_surf_n(hprogram)
586 IF (lhook) CALL dr_hook('WRITE_DIAG_PGD_ISBA_N',1,zhook_handle)
587 !
588 !
589 END SUBROUTINE write_diag_pgd_isba_n
subroutine init_io_surf_n(DTCO, DGU, U, HPROGRAM, HMASK, HSCHEME, HACTION)
subroutine end_io_surf_n(HPROGRAM)
Definition: end_io_surfn.F90:6
subroutine write_diag_pgd_isba_n(DTCO, DGU, U, CHI, DGMI, I, HPROGRAM)