7 hprogram,kpatch,hwrite)
56 USE modi_writesurf_gr_snow
57 USE modi_writesurf_teb_garden_n
58 USE modi_writesurf_teb_greenroof_n
61 USE yomhook
,ONLY : lhook, dr_hook
62 USE parkind1
,ONLY : jprb
81 CHARACTER(LEN=6),
INTENT(IN) :: hprogram
82 INTEGER,
INTENT(IN) :: kpatch
83 CHARACTER(LEN=3),
INTENT(IN) :: hwrite
90 CHARACTER(LEN=12) :: yrecfm
91 CHARACTER(LEN=100):: ycomment
92 CHARACTER(LEN=3) :: ypatch
93 CHARACTER(LEN=7) :: ydir
94 CHARACTER(LEN=100):: ystring
97 REAL(KIND=JPRB) :: zhook_handle
101 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_N',0,zhook_handle)
104 IF (tm%TOP%NTEB_PATCH>1)
WRITE(ypatch,fmt=
'(A,I1,A)')
'T',kpatch,
'_'
110 ycomment=
'Option for Road orientation in TEB scheme'
112 hprogram,
'ROAD_DIR',tm%TOP%CROAD_DIR,iresp,ycomment)
113 ycomment=
'Option for Wall representation in TEB scheme'
115 hprogram,
'WALL_OPT',tm%TOP%CWALL_OPT,iresp,ycomment)
123 DO jlayer=1,tm%TOP%NROOF_LAYER
124 WRITE(yrecfm,
'(A3,A5,I1.1,A1)') ypatch,
'TROOF',jlayer,
' '
125 WRITE(ycomment,
'(A9,I1.1,A4)')
'X_Y_TROOF',jlayer,
' (K)'
126 yrecfm=adjustl(yrecfm)
128 hprogram,yrecfm,tm%T%CUR%XT_ROOF(:,jlayer),iresp,hcomment=ycomment)
135 yrecfm=ypatch//
'WS_ROOF'
136 yrecfm=adjustl(yrecfm)
137 ycomment=
'WS_ROOF (kg/m2)'
139 hprogram,yrecfm,tm%T%CUR%XWS_ROOF(:),iresp,hcomment=ycomment)
144 DO jlayer=1,tm%TOP%NROAD_LAYER
145 WRITE(yrecfm,
'(A3,A5,I1.1,A1)') ypatch,
'TROAD',jlayer,
' '
146 yrecfm=adjustl(yrecfm)
147 IF (tm%TOP%CROAD_DIR==
'UNIF' .OR. tm%DTT%LDATA_ROAD_DIR)
THEN
148 ystring =
'X_Y_TROAD'
149 ELSEIF (
SIZE(tm%T%CUR%XROAD_DIR)>0)
THEN
151 CALL
road_dir(tm%T%CUR%XROAD_DIR(1),ydir)
152 ystring=trim(ydir)//
' ROAD TEMP. LAYER '
154 ystring=
'? ROAD TEMP. LAYER '
156 WRITE(ycomment,
'(A,I1.1,A4)') trim(ystring), jlayer,
' (K)'
158 hprogram,yrecfm,tm%T%CUR%XT_ROAD(:,jlayer),iresp,hcomment=ycomment)
164 yrecfm=ypatch//
'WS_ROAD'
165 yrecfm=adjustl(yrecfm)
166 ycomment=
'WS_ROAD (kg/m2)'
168 hprogram,yrecfm,tm%T%CUR%XWS_ROAD(:),iresp,hcomment=ycomment)
173 DO jlayer=1,tm%TOP%NWALL_LAYER
174 IF (tm%TOP%CWALL_OPT==
'UNIF')
THEN
175 WRITE(yrecfm,
'(A3,A5,I1.1,A1)') ypatch,
'TWALL',jlayer,
' '
176 yrecfm=adjustl(yrecfm)
177 WRITE(ycomment,
'(A9,I1.1,A4)')
'X_Y_TWALL',jlayer,
' (K)'
179 hprogram,yrecfm,tm%T%CUR%XT_WALL_A(:,jlayer),iresp,hcomment=ycomment)
182 WRITE(yrecfm,
'(A3,A6,I1.1)') ypatch,
'TWALLA',jlayer
183 yrecfm=adjustl(yrecfm)
184 IF (tm%DTT%LDATA_ROAD_DIR)
THEN
185 ystring =
'X_Y_TWALL_A'
186 ELSEIF (
SIZE(tm%T%CUR%XROAD_DIR)>0)
THEN
188 CALL
walla_dir(tm%T%CUR%XROAD_DIR(1),ydir)
189 ystring=trim(ydir)//
'-FACING WALL TEMP. LAYER '
191 ystring=
'?-FACING WALL TEMP. LAYER '
193 WRITE(ycomment,
'(A,I1.1,A4)') trim(ystring), jlayer,
' (K)'
195 hprogram,yrecfm,tm%T%CUR%XT_WALL_A(:,jlayer),iresp,hcomment=ycomment)
198 WRITE(yrecfm,
'(A3,A6,I1.1)') ypatch,
'TWALLB',jlayer
199 yrecfm=adjustl(yrecfm)
200 IF (tm%DTT%LDATA_ROAD_DIR)
THEN
201 ystring =
'X_Y_TWALL_B'
202 ELSEIF (
SIZE(tm%T%CUR%XROAD_DIR)>0)
THEN
204 CALL
wallb_dir(tm%T%CUR%XROAD_DIR(1),ydir)
205 ystring=trim(ydir)//
'-FACING WALL TEMP. LAYER '
207 ystring=
'?-FACING WALL TEMP. LAYER '
209 WRITE(ycomment,
'(A,I1.1,A4)') trim(ystring), jlayer,
' (K)'
211 hprogram,yrecfm,tm%T%CUR%XT_WALL_B(:,jlayer),iresp,hcomment=ycomment)
217 yrecfm=ypatch//
'TI_BLD'
218 yrecfm=adjustl(yrecfm)
219 ycomment=
'TI_BLD (K)'
221 hprogram,yrecfm,tm%B%CUR%XTI_BLD(:),iresp,hcomment=ycomment)
226 yrecfm=ypatch//
'T_WIN1'
227 yrecfm=adjustl(yrecfm)
228 ycomment=
'T_WIN1 (K)'
230 hprogram,yrecfm,tm%B%CUR%XT_WIN1(:),iresp,hcomment=ycomment)
232 IF (tm%TOP%CBEM==
'BEM')
THEN
235 yrecfm=ypatch//
'QI_BLD'
236 yrecfm=adjustl(yrecfm)
237 ycomment=
'QI_BLD (kg/kg)'
239 hprogram,yrecfm,tm%B%CUR%XQI_BLD(:),iresp,hcomment=ycomment)
244 yrecfm=ypatch//
'T_WIN2'
245 yrecfm=adjustl(yrecfm)
246 ycomment=
'T_WIN2 (K)'
248 hprogram,yrecfm,tm%B%CUR%XT_WIN2(:),iresp,hcomment=ycomment)
252 DO jlayer=1,tm%BOP%NFLOOR_LAYER
253 WRITE(yrecfm,
'(A3,A5,I1.1,A1)') ypatch,
'TFLOO',jlayer,
' '
254 WRITE(ycomment,
'(A9,I1.1,A4)')
'X_Y_TFLOO',jlayer,
' (K)'
255 yrecfm=adjustl(yrecfm)
257 hprogram,yrecfm,tm%B%CUR%XT_FLOOR(:,jlayer),iresp,hcomment=ycomment)
262 DO jlayer=1,tm%BOP%NFLOOR_LAYER
263 WRITE(yrecfm,
'(A3,A5,I1.1,A1)') ypatch,
'TMASS',jlayer,
' '
264 WRITE(ycomment,
'(A9,I1.1,A4)')
'X_Y_TMASS',jlayer,
' (K)'
265 yrecfm=adjustl(yrecfm)
267 hprogram,yrecfm,tm%B%CUR%XT_MASS(:,jlayer),iresp,hcomment=ycomment)
274 yrecfm=ypatch//
'TI_ROAD'
275 yrecfm=adjustl(yrecfm)
276 ycomment=
'TI_ROAD (K)'
278 hprogram,yrecfm,tm%T%CUR%XTI_ROAD(:),iresp,hcomment=ycomment)
284 hprogram,yrecfm,ypatch,tm%T%CUR%TSNOW_ROOF )
288 hprogram,yrecfm,ypatch,tm%T%CUR%TSNOW_ROAD )
297 yrecfm=ypatch//
'TCANYON'
298 yrecfm=adjustl(yrecfm)
299 ycomment=
'T_CANYON (K)'
301 hprogram,yrecfm,tm%T%CUR%XT_CANYON(:),iresp,hcomment=ycomment)
305 yrecfm=ypatch//
'QCANYON'
306 yrecfm=adjustl(yrecfm)
307 ycomment=
'Q_CANYON (kg/kg)'
309 hprogram,yrecfm,tm%T%CUR%XQ_CANYON(:),iresp,hcomment=ycomment)
314 IF (tm%TOP%LSOLAR_PANEL)
THEN
315 yrecfm=ypatch//
'THER_PDAY'
316 yrecfm=adjustl(yrecfm)
317 ycomment=
'Thermal Solar Panels present day production (J/m2)'
318 IF (.NOT.
ASSOCIATED(tm%TPN%XTHER_PRODC_DAY))
THEN
320 ALLOCATE(tm%TPN%XTHER_PRODC_DAY(
SIZE(tm%B%CUR%XTI_BLD)))
321 tm%TPN%XTHER_PRODC_DAY=0.
324 hprogram,yrecfm,tm%TPN%XTHER_PRODC_DAY(:),iresp,hcomment=ycomment)
335 hprogram,yrecfm,tm%TOP%TTIME,iresp,hcomment=ycomment)
352 IF (lhook) CALL dr_hook(
'WRITESURF_TEB_N',1,zhook_handle)
358 REAL,
INTENT(IN) :: pdir
359 CHARACTER(LEN=7),
INTENT(OUT) :: hdir
362 IF (pdir<0) zdir = pdir +360.
363 IF (zdir>= 0. .AND. zdir< 11.25) hdir=
'N-S '
364 IF (zdir>= 11.25 .AND. zdir< 33.75) hdir=
'NNE-SSW'
365 IF (zdir>= 33.75 .AND. zdir< 56.25) hdir=
'NE-SW'
366 IF (zdir>= 56.25 .AND. zdir< 78.75) hdir=
'ENE-WSW'
367 IF (zdir>= 78.75 .AND. zdir<101.25) hdir=
'E-W '
368 IF (zdir>=101.25 .AND. zdir<123.75) hdir=
'ESE-WNW'
369 IF (zdir>=123.75 .AND. zdir<146.25) hdir=
'SE-NW '
370 IF (zdir>=146.25 .AND. zdir<168.75) hdir=
'SSE-NNW'
371 IF (zdir>=168.75 .AND. zdir<180.00) hdir=
'N-S '
374 REAL,
INTENT(IN) :: pdir
375 CHARACTER(LEN=7),
INTENT(OUT) :: hdir
378 IF (pdir<0) zdir = pdir +360.
379 IF (zdir>= 0. .AND. zdir< 11.25) hdir=
'E '
380 IF (zdir>= 11.25 .AND. zdir< 33.75) hdir=
'ESE '
381 IF (zdir>= 33.75 .AND. zdir< 56.25) hdir=
'SE '
382 IF (zdir>= 56.25 .AND. zdir< 78.75) hdir=
'SSE '
383 IF (zdir>= 78.75 .AND. zdir<101.25) hdir=
'S '
384 IF (zdir>=101.25 .AND. zdir<123.75) hdir=
'SSW '
385 IF (zdir>=123.75 .AND. zdir<146.25) hdir=
'SW '
386 IF (zdir>=146.25 .AND. zdir<168.75) hdir=
'WSW '
387 IF (zdir>=168.75 .AND. zdir<180.00) hdir=
'W '
390 REAL,
INTENT(IN) :: pdir
391 CHARACTER(LEN=7),
INTENT(OUT) :: hdir
394 IF (pdir<0) zdir = pdir +360.
395 IF (zdir>= 0. .AND. zdir< 11.25) hdir=
'W '
396 IF (zdir>= 11.25 .AND. zdir< 33.75) hdir=
'WNW '
397 IF (zdir>= 33.75 .AND. zdir< 56.25) hdir=
'NW '
398 IF (zdir>= 56.25 .AND. zdir< 78.75) hdir=
'NNW '
399 IF (zdir>= 78.75 .AND. zdir<101.25) hdir=
'N '
400 IF (zdir>=101.25 .AND. zdir<123.75) hdir=
'NNE '
401 IF (zdir>=123.75 .AND. zdir<146.25) hdir=
'NE '
402 IF (zdir>=146.25 .AND. zdir<168.75) hdir=
'ENE '
403 IF (zdir>=168.75 .AND. zdir<180.00) hdir=
'E '
subroutine writesurf_teb_greenroof_n(DGU, U, TVG, GRM, HPROGRAM, HPATCH)
subroutine writesurf_gr_snow(DGU, U, HPROGRAM, HSURFTYPE, HPREFIX, TPSNOW)
subroutine wallb_dir(PDIR, HDIR)
subroutine road_dir(PDIR, HDIR)
subroutine writesurf_teb_garden_n(DGU, U, GDM, HPROGRAM, HPATCH)
subroutine walla_dir(PDIR, HDIR)
subroutine writesurf_teb_n(DGU, U, TM, GDM, GRM, HPROGRAM, KPATCH, HWRITE)