60 USE modi_init_io_surf_n
62 USE modi_end_io_surf_n
65 USE yomhook
,ONLY : lhook, dr_hook
66 USE parkind1
,ONLY : jprb
79 TYPE(isba_t
),
INTENT(INOUT) :: i
81 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
86 REAL,
DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,3)) :: zwork
87 REAL,
DIMENSION(SIZE(I%XDG,1),SIZE(I%XDG,2)) :: zdg
88 REAL,
DIMENSION(SIZE(I%XDG,1) ) :: zdg2
89 REAL,
DIMENSION(SIZE(I%XDG,1) ) :: zdtot
92 CHARACTER(LEN=12) :: yrecfm
93 CHARACTER(LEN=100):: ycomment
94 CHARACTER(LEN=2) :: ylvlv, ypas
95 CHARACTER(LEN=4) :: ylvl
97 INTEGER :: jj, jl, jp, ilayer
98 INTEGER :: isize_lmeb_patch
99 REAL(KIND=JPRB) :: zhook_handle
104 IF (lhook) CALL dr_hook(
'WRITE_DIAG_PGD_ISBA_N',0,zhook_handle)
106 isize_lmeb_patch=count(i%LMEB_PATCH(:))
109 hprogram,
'NATURE',
'ISBA ',
'WRITE')
115 IF (i%CPHOTO==
'NON' .OR. i%CPHOTO==
'AGS' .OR. i%CPHOTO==
'AST')
THEN
118 ycomment=
'leaf area index (-)'
121 hprogram,yrecfm,i%XLAI(:,:),iresp,hcomment=ycomment)
123 IF (isize_lmeb_patch>0)
THEN
126 ycomment=
'MEB: understory leaf area index (-)'
129 hprogram,yrecfm,i%XLAIGV(:,:),iresp,hcomment=ycomment)
140 ycomment=
'vegetation fraction (-)'
143 hprogram,yrecfm,i%XVEG(:,:),iresp,hcomment=ycomment)
148 ycomment=
'surface roughness length (without snow) (m)'
151 hprogram,yrecfm,i%XZ0(:,:),iresp,hcomment=ycomment)
153 IF (isize_lmeb_patch>0)
THEN
156 ycomment=
'MEB: ground litter fraction (-)'
159 hprogram,yrecfm,i%XGNDLITTER(:,:),iresp,hcomment=ycomment)
162 ycomment=
'MEB: ground litter roughness length (without snow) (m)'
165 hprogram,yrecfm,i%XZ0LITTER(:,:),iresp,hcomment=ycomment)
173 DO jl=1,
SIZE(i%XDG,2)
175 WRITE(yrecfm,fmt=
'(A2,I1)')
'DG',jl
177 WRITE(yrecfm,fmt=
'(A2,I2)')
'DG',jl
179 ycomment=
'soil depth'//
' (M)'
181 hprogram,yrecfm,i%XDG(:,jl,:),iresp,hcomment=ycomment)
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)
197 DO jl=1,
SIZE(i%XDG,2)
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)'
203 hprogram,yrecfm,zdg(:,jl),iresp,hcomment=ycomment)
210 IF(i%CISBA==
'DIF')
THEN
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)
220 zwork(jj,jp)=i%XDG(jj,jl,jp)
221 zdtot(jj)=zdtot(jj)+i%XPATCH(jj,jp)*i%XDG(jj,jl,jp)
229 ycomment=
'Root depth in ISBA-DIF'
231 hprogram,yrecfm,i%XDROOT(:,:),iresp,hcomment=ycomment)
234 ycomment=
'DG2 depth in ISBA-DIF'
236 hprogram,yrecfm,i%XDG2(:,:),iresp,hcomment=ycomment)
239 yrecfm=
'DG2_DIF_ISBA'
240 ycomment=
'Averaged DG2 depth in ISBA-DIF'
242 hprogram,yrecfm,zdg2(:),iresp,hcomment=ycomment)
248 ycomment=
'Runoff deph in ISBA-DIF'
250 hprogram,yrecfm,i%XRUNOFFD(:,:),iresp,hcomment=ycomment)
255 ycomment=
'Total soil depth for moisture in ISBA-DIF'
257 hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
261 ycomment=
'Averaged Total soil depth for moisture in ISBA-DIF'
263 hprogram,yrecfm,zdtot(:),iresp,hcomment=ycomment)
268 DO jl=1,
SIZE(i%XROOTFRAC,2)
270 WRITE(yrecfm,fmt=
'(A8,I1)')
'ROOTFRAC',jl
272 WRITE(yrecfm,fmt=
'(A8,I2)')
'ROOTFRAC',jl
274 ycomment=
'root fraction by layer (-)'
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,:)
282 hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
285 IF (isize_lmeb_patch>0)
THEN
286 DO jl=1,
SIZE(i%XROOTFRACGV,2)
288 WRITE(yrecfm,fmt=
'(A10,I1)')
'ROOTFRACGV',jl
290 WRITE(yrecfm,fmt=
'(A10,I2)')
'ROOTFRACGV',jl
292 ycomment=
'MEB: understory root fraction by layer (-)'
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,:)
300 hprogram,yrecfm,zwork(:,:),iresp,hcomment=ycomment)
307 DO jl=1,
SIZE(i%XDG,2)
309 WRITE(yrecfm,fmt=
'(A7,I1)')
'FRACSOC',jl
311 WRITE(yrecfm,fmt=
'(A7,I2)')
'FRACSOC',jl
313 ycomment=
'SOC fraction by layer (-)'
315 hprogram,yrecfm,i%XFRACSOC(:,jl),iresp,hcomment=ycomment)
323 DO jl=1,
SIZE(i%XDG,2)
325 WRITE(yrecfm,fmt=
'(A4,I1)')
'WSAT',jl
327 WRITE(yrecfm,fmt=
'(A4,I2)')
'WSAT',jl
329 ycomment=
'soil porosity by layer (m3/m3)'
331 hprogram,yrecfm,i%XWSAT(:,jl),iresp,hcomment=ycomment)
334 DO jl=1,
SIZE(i%XDG,2)
336 WRITE(yrecfm,fmt=
'(A3,I1)')
'WFC',jl
338 WRITE(yrecfm,fmt=
'(A3,I2)')
'WFC',jl
340 ycomment=
'field capacity by layer (m3/m3)'
342 hprogram,yrecfm,i%XWFC(:,jl),iresp,hcomment=ycomment)
345 DO jl=1,
SIZE(i%XDG,2)
347 WRITE(yrecfm,fmt=
'(A5,I1)')
'WWILT',jl
349 WRITE(yrecfm,fmt=
'(A5,I2)')
'WWILT',jl
351 ycomment=
'wilting point by layer (m3/m3)'
353 hprogram,yrecfm,i%XWWILT(:,jl),iresp,hcomment=ycomment)
358 IF(lfanocompact.AND..NOT.lprep)
THEN
360 IF (lhook) CALL dr_hook(
'WRITE_DIAG_PGD_ISBA_N',1,zhook_handle)
367 ycomment=
'orography roughness length (M)'
370 hprogram,yrecfm,i%XZ0REL(:),iresp,hcomment=ycomment)
376 IF(i%CHORT==
'SGH'.AND.i%CISBA/=
'DIF')
THEN
378 ycomment=
'soil ice depth for runoff (m)'
380 hprogram,yrecfm,i%XD_ICE(:,:),iresp,hcomment=ycomment)
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'//
' (-)'
393 hprogram,yrecfm,i%XVEGTYPE(:,jl),iresp,hcomment=ycomment)
399 IF(i%NPATCH>1.AND.
SIZE(i%XVEGTYPE_PATCH,2)/=
SIZE(i%XVEGTYPE_PATCH,3))
THEN
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'//
' (-)'
407 hprogram,yrecfm,i%XVEGTYPE_PATCH(:,jl,:),iresp,hcomment=ycomment)
417 ycomment=
'minimum stomatal resistance (sm-1)'
419 hprogram,yrecfm,i%XRSMIN(:,:),iresp,hcomment=ycomment)
422 ycomment=
'coefficient for RSMIN calculation (-)'
424 hprogram,yrecfm,i%XGAMMA(:,:),iresp,hcomment=ycomment)
427 ycomment=
'vegetation thermal inertia coefficient (-)'
429 hprogram,yrecfm,i%XCV(:,:),iresp,hcomment=ycomment)
432 ycomment=
'maximum solar radiation usable in photosynthesis (-)'
434 hprogram,yrecfm,i%XRGL(:,:),iresp,hcomment=ycomment)
437 ycomment=
'surface emissivity (-)'
439 hprogram,yrecfm,i%XEMIS(:,:),iresp,hcomment=ycomment)
442 ycomment=
'coefficient for maximum water interception (-)'
444 hprogram,yrecfm,i%XWRMAX_CF(:,:),iresp,hcomment=ycomment)
446 IF (isize_lmeb_patch>0)
THEN
449 ycomment=
'MEB: understory minimum stomatal resistance (sm-1)'
451 hprogram,yrecfm,i%XRSMINGV(:,:),iresp,hcomment=ycomment)
454 ycomment=
'MEB: understory coefficient for RSMIN calculation (-)'
456 hprogram,yrecfm,i%XGAMMAGV(:,:),iresp,hcomment=ycomment)
459 ycomment=
'MEB: understory maximum solar radiation usable in photosynthesis (-)'
461 hprogram,yrecfm,i%XRGLGV(:,:),iresp,hcomment=ycomment)
464 ycomment=
'MEB: understory coefficient for maximum water interception (-)'
466 hprogram,yrecfm,i%XWRMAX_CFGV(:,:),iresp,hcomment=ycomment)
469 ycomment=
'MEB: height of vegetation (m)'
471 hprogram,yrecfm,i%XH_VEG(:,:),iresp,hcomment=ycomment)
477 IF (dgmi%LSURF_DIAG_ALBEDO)
THEN
483 ycomment=
'soil near-infra-red albedo (-)'
485 hprogram,yrecfm,i%XALBNIR_SOIL(:,:),iresp,hcomment=ycomment)
490 ycomment=
'soil visible albedo (-)'
492 hprogram,yrecfm,i%XALBVIS_SOIL(:,:),iresp,hcomment=ycomment)
497 ycomment=
'soil UV albedo (-)'
499 hprogram,yrecfm,i%XALBUV_SOIL(:,:),iresp,hcomment=ycomment)
506 ycomment=
'total near-infra-red albedo (-)'
508 hprogram,yrecfm,i%XALBNIR(:,:),iresp,hcomment=ycomment)
513 ycomment=
'total visible albedo (-)'
515 hprogram,yrecfm,i%XALBVIS(:,:),iresp,hcomment=ycomment)
520 ycomment=
'total UV albedo (-)'
522 hprogram,yrecfm,i%XALBUV(:,:),iresp,hcomment=ycomment)
530 IF (chi%CCH_DRY_DEP==
'WES89' .AND. chi%SVI%NBEQ>0)
THEN
532 ycomment=
'bare soil resistance for SO2 (?)'
534 hprogram,yrecfm,chi%XSOILRC_SO2(:,:),iresp,hcomment=ycomment)
537 ycomment=
'bare soil resistance for O3 (?)'
539 hprogram,yrecfm,chi%XSOILRC_O3(:,:),iresp,hcomment=ycomment)
544 IF (lagrip .AND. (i%CPHOTO==
'LAI' .OR. i%CPHOTO==
'LST' .OR. i%CPHOTO==
'NIT' .OR. i%CPHOTO==
'NCB') )
THEN
550 ycomment=
'date of seeding (-)'
553 hprogram,yrecfm,i%TSEED(:,:),iresp,hcomment=ycomment)
556 ycomment=
'date of reaping (-)'
559 hprogram,yrecfm,i%TREAP(:,:),iresp,hcomment=ycomment)
566 ycomment=
'flag for irrigation (irrigation if >0.) (-)'
569 hprogram,yrecfm,i%XIRRIG(:,:),iresp,hcomment=ycomment)
576 ycomment=
'water supply during irrigation process (mm)'
579 hprogram,yrecfm,i%XWATSUP(:,:),iresp,hcomment=ycomment)
586 IF (lhook) CALL dr_hook(
'WRITE_DIAG_PGD_ISBA_N',1,zhook_handle)
subroutine init_io_surf_n(DTCO, DGU, U, HPROGRAM, HMASK, HSCHEME, HACTION)
subroutine end_io_surf_n(HPROGRAM)
subroutine write_diag_pgd_isba_n(DTCO, DGU, U, CHI, DGMI, I, HPROGRAM)