54 USE modi_writesurf_gr_snow
59 USE yomhook
,ONLY : lhook, dr_hook
60 USE parkind1
,ONLY : jprb
74 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
75 CHARACTER(LEN=3),
INTENT(IN) :: hpatch
81 CHARACTER(LEN=30) :: yrecfm
82 CHARACTER(LEN=100) :: ycomment
83 CHARACTER(LEN=14) :: yform
84 CHARACTER(LEN=4 ) :: ylvl
88 REAL,
DIMENSION(:),
ALLOCATABLE :: zwork
92 INTEGER :: jsv, jnbiomass
94 REAL(KIND=JPRB) :: zhook_handle
101 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_GREENROOF_N',0,zhook_handle)
102 ALLOCATE(zwork(
SIZE(grm%TGR%CUR%XTG,1)))
107 iwork=grm%TGRO%NLAYER_GR
110 WRITE(ylvl,
'(I2)') jlayer
111 yrecfm=hpatch//
'GR_TG'//adjustl(ylvl(:len_trim(ylvl)))
112 yrecfm=adjustl(yrecfm)
113 yform=
'(A13,I1.1,A4)'
114 IF (jlayer >= 10) yform=
'(A13,I2.2,A4)'
115 WRITE(ycomment,fmt=yform)
'X_Y_TWN_TG_GR',jlayer,
' (K)'
116 zwork=grm%TGR%CUR%XTG(:,jlayer)
118 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
123 DO jlayer=1,grm%TGRO%NLAYER_GR
124 WRITE(ylvl,
'(I2)') jlayer
125 yrecfm=hpatch//
'GR_WG'//adjustl(ylvl(:len_trim(ylvl)))
126 yrecfm=adjustl(yrecfm)
127 yform=
'(A13,I1.1,A8)'
128 IF (jlayer >= 10) yform=
'(A13,I2.2,A8)'
129 WRITE(ycomment,fmt=yform)
'X_Y_TWN_WG_GR',jlayer,
' (m3/m3)'
130 zwork=grm%TGR%CUR%XWG(:,jlayer)
132 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
138 DO jlayer=1,grm%TGRO%NLAYER_GR
139 WRITE(ylvl,
'(I2)') jlayer
140 yrecfm=hpatch//
'GR_WGI'//adjustl(ylvl(:len_trim(ylvl)))
141 yrecfm=adjustl(yrecfm)
142 yform=
'(A14,I1.1,A8)'
143 IF (jlayer >= 10) yform=
'(A14,I2.2,A8)'
144 WRITE(ycomment,yform)
'X_Y_GR_WGI',jlayer,
' (m3/m3)'
145 zwork=grm%TGR%CUR%XWGI(:,jlayer)
147 hprogram,yrecfm,zwork,iresp,hcomment=ycomment)
154 yrecfm=hpatch//
'GR_WR'
155 yrecfm=adjustl(yrecfm)
156 ycomment=
'X_Y_TWN_WR_GR (kg/m2)'
158 hprogram,yrecfm,grm%TGR%CUR%XWR(:),iresp,hcomment=ycomment)
162 IF (tvg%CPHOTO/=
'NON' .AND. tvg%CPHOTO/=
'AGS' .AND. tvg%CPHOTO/=
'AST')
THEN
163 yrecfm=hpatch//
'GR_LAI'
164 yrecfm=adjustl(yrecfm)
165 ycomment=
'X_Y_GR_LAI (m2/m2)'
167 hprogram,yrecfm,grm%TGRPE%CUR%XLAI(:),iresp,hcomment=ycomment)
173 IF (tvg%CPHOTO==
'NIT')
THEN
174 DO jnbiomass=1,tvg%NNBIOMASS
175 WRITE(ylvl,
'(I1)') jnbiomass
176 yrecfm=hpatch//
'GR_BIOMA'//adjustl(ylvl(:len_trim(ylvl)))
177 yrecfm=adjustl(yrecfm)
178 yform=
'(A11,I1.1,A8)'
179 WRITE(ycomment,fmt=yform)
'X_Y_BIOMASS',jnbiomass,
' (kg/m2)'
181 hprogram,yrecfm,grm%TGR%CUR%XBIOMASS(:,jnbiomass),iresp,hcomment=ycomment)
185 DO jnbiomass=2,tvg%NNBIOMASS
186 WRITE(ylvl,
'(I1)') jnbiomass
187 yrecfm=hpatch//
'GR_RESPI'//adjustl(ylvl(:len_trim(ylvl)))
188 yrecfm=adjustl(yrecfm)
189 yform=
'(A16,I1.1,A10)'
190 WRITE(ycomment,fmt=yform)
'X_Y_RESP_BIOMASS',jnbiomass,
' (kg/m2/s)'
192 hprogram,yrecfm,grm%TGR%CUR%XRESP_BIOMASS(:,jnbiomass),iresp,hcomment=ycomment)
199 yrecfm=hpatch//
'GR_RESA'
200 yrecfm=adjustl(yrecfm)
201 ycomment=
'X_Y_GR_RESA (s/m)'
203 hprogram,yrecfm,grm%TGR%CUR%XRESA(:),iresp,hcomment=ycomment)
209 hprogram,yrecfm,hpatch,grm%TGR%CUR%TSNOW)
211 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_GREENROOF_N',1,zhook_handle)
subroutine writesurf_teb_greenroof_n(DGU, U, TVG, GRM, HPROGRAM, HPATCH)
subroutine writesurf_gr_snow(DGU, U, HPROGRAM, HSURFTYPE, HPREFIX, TPSNOW)