119
120 IMPLICIT NONE
121 INTEGER, INTENT(in) :: tstep
122 INTEGER, INTENT(in) :: nlayer
123
124 REAL(KIND(1D0)), DIMENSION(nsurf), INTENT(in) :: QG_surf
125
126
127
128
129
130
131
132
133
134
135
136
137 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: qg_roof
138 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: tsfc_roof
139 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: tin_roof
140 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: sfr_roof
141 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: temp_in_roof
142 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: k_roof
143 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: cp_roof
144 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: dz_roof
145
146 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: qg_wall
147 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: tsfc_wall
148 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: tin_wall
149 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(in) :: sfr_wall
150 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: temp_in_wall
151 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: k_wall
152 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: cp_wall
153 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(in) :: dz_wall
154
155 REAL(KIND(1D0)), DIMENSION(nsurf), INTENT(in) :: tsfc_surf
156 REAL(KIND(1D0)), DIMENSION(nsurf), INTENT(in) :: tin_surf
157 REAL(KIND(1D0)), DIMENSION(nsurf), INTENT(in) :: sfr_surf
158 REAL(KIND(1D0)), DIMENSION(nsurf, ndepth), INTENT(in) :: temp_in_surf
159 REAL(KIND(1D0)), DIMENSION(nsurf, ndepth), INTENT(in) :: k_surf
160 REAL(KIND(1D0)), DIMENSION(nsurf, ndepth), INTENT(in) :: cp_surf
161 REAL(KIND(1D0)), DIMENSION(nsurf, ndepth), INTENT(in) :: dz_surf
162
163
164
165 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(out) :: QS_roof
166 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(out) :: temp_out_roof
167
168 REAL(KIND(1D0)), DIMENSION(nlayer), INTENT(out) :: QS_wall
169 REAL(KIND(1D0)), DIMENSION(nlayer, ndepth), INTENT(out) :: temp_out_wall
170
171 REAL(KIND(1D0)), DIMENSION(nsurf), INTENT(out) :: QS_surf
172 REAL(KIND(1D0)), DIMENSION(nsurf, ndepth), INTENT(out) :: temp_out_surf
173
174
175 REAL(KIND(1D0)), INTENT(out) :: QS
176
177
178
179
180 REAL(KIND(1D0)), DIMENSION(:), ALLOCATABLE :: tsfc_cal
181 REAL(KIND(1D0)), DIMENSION(:), ALLOCATABLE :: tin_cal
182 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: temp_cal
183 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: k_cal
184 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: cp_cal
185 REAL(KIND(1D0)), DIMENSION(:, :), ALLOCATABLE :: dz_cal
186 REAL(KIND(1D0)), DIMENSION(:), ALLOCATABLE :: qs_cal
187
188
189
190
191 INTEGER :: i_facet, i_group, nfacet, i_depth
192
193
194 REAL(KIND(1D0)), DIMENSION(2) :: bc
195
196
197 LOGICAL, DIMENSION(2) :: bctype
198 LOGICAL :: debug
199
200
201 LOGICAL :: use_heatcond1d, use_heatcond1d_water
202
203
204 REAL(KIND(1D0)), DIMENSION(nlayer) :: sfr_roof_n
205 REAL(KIND(1D0)), DIMENSION(nlayer) :: sfr_wall_n
206
207
208 use_heatcond1d = .true.
209 use_heatcond1d_water = .false.
210 debug = .false.
211
212
213
216
217 DO i_group = 1, 3
218
219
220 IF (i_group == 1) THEN
221
223 ELSE IF (i_group == 2) THEN
224
226 ELSE IF (i_group == 3) THEN
227
229 END IF
230
231 ALLOCATE (tsfc_cal(nfacet))
232 ALLOCATE (tin_cal(nfacet))
233 ALLOCATE (qs_cal(nfacet))
234 ALLOCATE (temp_cal(nfacet,
ndepth))
235 ALLOCATE (k_cal(nfacet,
ndepth))
236 ALLOCATE (cp_cal(nfacet,
ndepth))
237 ALLOCATE (dz_cal(nfacet,
ndepth))
238
239
240
241 IF (i_group == 1) THEN
242
243
245
246 tin_cal(1:nfacet) =
tin_roof(1:nfacet)
247
248 temp_cal(1:nfacet, 1:
ndepth) = temp_in_roof(1:nfacet, 1:
ndepth
249
251
254
255 ELSE IF (i_group == 2) THEN
256
257
259 tin_cal(1:nfacet) =
tin_wall(1:nfacet)
260 temp_cal(1:nfacet, 1:
ndepth) = temp_in_wall(1:nfacet, 1:
ndepth
261
265
266
267 ELSE IF (i_group == 3) THEN
268
269
271 tin_cal(1:nfacet) =
tin_surf(1:nfacet)
272 temp_cal(1:nfacet, 1:
ndepth) = temp_in_surf(1:nfacet, 1:
ndepth
273
277
278
279
280
281 END IF
282
283
284
285
286
287
288
289 DO i_facet = 1, nfacet
290
291
292
293
294
295
296 IF (i_group == 3) THEN
297 use_heatcond1d = .true.
299
300 use_heatcond1d = .false.
302
303 use_heatcond1d = .false.
304 use_heatcond1d_water = .true.
305 END IF
306 ELSE
307 use_heatcond1d = .true.
308 END IF
309
310
311 IF (dz_cal(i_facet, 1) /= -999.0 .AND. use_heatcond1d) THEN
312
313
314 IF (i_group == 1) THEN
315 bc(1) = qg_roof(i_facet)
316 ELSE IF (i_group == 2) THEN
317 bc(1) = qg_wall(i_facet)
318 ELSE IF (i_group == 3) THEN
319 bc(1) = qg_surf(i_facet)
320 END IF
321
322 bc(1) = tsfc_cal(i_facet)
323 bctype(1) = .false.
324
325
326 bc(2) = tin_cal(i_facet)
327 bctype(2) = .false.
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
347 temp_cal(i_facet, :), &
348 qs_cal(i_facet), &
349 tsfc_cal(i_facet), &
350 dz_cal(i_facet, 1:
ndepth), &
351 tstep*1.d0, &
352 k_cal(i_facet, 1:
ndepth), &
353 cp_cal(i_facet, 1:
ndepth), &
354 bc, &
355 bctype, debug)
356
357
358
359
360
361
362
363
364
365
366
367
368
369 END IF
370
371 IF (dz_cal(i_facet, 1) /= -999.0 .AND. use_heatcond1d_water)THEN
372
373
374
375
376
377 bc(1) = tsfc_cal(i_facet)
378 bctype(1) = .false.
379
380
381 bc(2) = tin_cal(i_facet)
382 bctype(2) = .false.
383
384
385
386
388 temp_cal(i_facet, :), &
389 qs_cal(i_facet), &
390 tsfc_cal(i_facet), &
391 dz_cal(i_facet, 1:
ndepth), &
392 tstep*1.d0, &
393 k_cal(i_facet, 1:
ndepth), &
394 cp_cal(i_facet, 1:
ndepth), &
395 bc, &
396 bctype, debug)
397
398
399
400 END IF
401
402 END DO
403
404
405 IF (i_group == 1) THEN
406 qs_roof = qs_cal(1:nfacet)
407
408 temp_out_roof = temp_cal(:nfacet, :)
409 ELSE IF (i_group == 2) THEN
410 qs_wall = qs_cal(1:nfacet)
411
412 temp_out_wall = temp_cal(:nfacet, :)
413 ELSE IF (i_group == 3) THEN
414 qs_surf = qs_cal(1:nfacet)
415
416 temp_out_surf = temp_cal(:nfacet, :)
417 END IF
418
419
420 DEALLOCATE (tsfc_cal)
421 DEALLOCATE (tin_cal)
422 DEALLOCATE (qs_cal)
423 DEALLOCATE (temp_cal)
424 DEALLOCATE (k_cal)
425 DEALLOCATE (cp_cal)
426 DEALLOCATE (dz_cal)
427
428 END DO
429
430
431
432
433
436 ELSE
438 END IF
439
441 temp_out_surf(
bldgsurf, i_depth) = &
442 (dot_product(temp_out_roof(:, i_depth),
sfr_roof) &
443 + dot_product(temp_out_wall(:, i_depth),
sfr_wall)) &
445 END DO
446
447
449
integer, parameter bldgsurf
real(kind(1d0)), dimension(:, :), allocatable dz_wall
integer, parameter conifsurf
real(kind(1d0)), dimension(:), allocatable tsfc_roof
real(kind(1d0)), dimension(:, :), allocatable dz_surf
real(kind(1d0)), dimension(nsurf) sfr_surf
real(kind(1d0)), dimension(:), allocatable sfr_roof
real(kind(1d0)), dimension(:, :), allocatable cp_wall
real(kind(1d0)), dimension(:), allocatable tsfc_surf
real(kind(1d0)), dimension(:, :), allocatable cp_surf
real(kind(1d0)), dimension(:, :), allocatable k_roof
real(kind(1d0)), dimension(:, :), allocatable k_surf
real(kind(1d0)), dimension(:), allocatable tin_surf
integer, parameter watersurf
real(kind(1d0)), dimension(:), allocatable tin_wall
integer, parameter grasssurf
real(kind(1d0)), dimension(:, :), allocatable dz_roof
integer, parameter bsoilsurf
integer, parameter pavsurf
real(kind(1d0)), dimension(:, :), allocatable cp_roof
integer, parameter ndepth
real(kind(1d0)), dimension(:, :), allocatable k_wall
real(kind(1d0)), dimension(:), allocatable sfr_wall
real(kind(1d0)), dimension(:), allocatable tin_roof
integer, parameter decidsurf
real(kind(1d0)), dimension(:), allocatable tsfc_wall
subroutine heatcond1d_vstep(t, qs, tsfc, dx, dt, k, rhocp, bc, bctype, debug)