SURFEX v8.1
General documentation of Surfex
urban_solar_abs.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 urban_solar_abs(TOP, T, B, DMT, PDIR_SW, PSCA_SW, PZENITH, PAZIM, &
7  PFRAC_PANEL, PALB_PANEL, PALB_GD, PSVF_GD, PALB_GRF, &
8  PDN_RF, PDF_RF, PDN_RD, PDF_RD, PREC_SW_RD, &
9  PREC_SW_SN_RD, PREC_SW_WL_A, PREC_SW_WL_B, &
10  PREC_SW_GD, PREC_SW_RF, PDIR_ALB_TWN, PSCA_ALB_TWN, &
11  PSW_RAD_GD, PREC_SW_WIN, PREF_SW_GRND, PREF_SW_FAC, &
12  PE_SHADING, OSHAD_DAY, OSHADE, OALB_ONLY )
13 ! ##########################################################################
14 !
15 !!**** *URBAN_SOLAR_ABS*
16 !!
17 !! PURPOSE
18 !! -------
19 !
20 ! Computes the solar radiation flux absorbed by roofs, roads and walls.
21 ! The absorption by roofs is trivial.
22 !
23 !
24 !!** METHOD
25 ! ------
26 !
27 !
28 ! computation of input solar radiation on each surface
29 ! ****************************************************
30 !
31 ! direct fluxes:
32 ! -------------
33 !
34 ! dir_Rg_road (Wm-2) = S * 2*theta0/pi
35 ! - S *2/tan(zen) * h/W /pi * (1-cos(theta0))
36 !
37 ! dir_Rg_wall (Wm-2) = S / tan(zen) /pi * (1-cos(theta0))
38 ! + S * W/h * (1/2 -theta0/pi)
39 !
40 ! where zen is the zenithal angle, from horizon
41 ! h/W is the aspect ratio of the canyon
42 ! S is the direct solar radiation flux on a horizontal surface
43 !
44 ! theta0 = arcsin(min(W/h * tan(zen),1))
45 !
46 ! The surfaces will keep (1-a) times these fluxes, and reflect the
47 ! remaining
48 !
49 ! scattered fluxes:
50 ! ----------------
51 !
52 ! sca_Rg_road = sca_Rg * SVF_road
53 !
54 ! sca_Rg_wall = sca_Rg * SVF_wall
55 !
56 !
57 ! solar flux and isotropic reflections :
58 ! ------------------------------------
59 !
60 ! after 0 reflection, the absorbed part of the flux is:
61 !
62 ! ARg_r(0) = (1-a_r) (sca_Rg_road + dir_Rg_road)
63 !
64 ! ARg_w(0) = (1-a_w) (sca_Rg_wall + dir_Rg_wall)
65 !
66 ! and the reflected parts are
67 !
68 ! RRg_r(0) = a_r (sca_Rg_road + dir_Rg_road)
69 !
70 ! RRg_w(0) = a_w (sca_Rg_wall + dir_Rg_wall)
71 !
72 ! after n reflection:
73 !
74 ! ARg_r(n) = ARg_r(n-1) + RRg_w(n-1) * (1- SVF_r)(1-a_r)
75 !
76 ! ARg_w(n) = ARg_w(n-1) + RRg_r(n-1) * SVF_w (1-a_w)
77 ! + RRg_w(n-1) * (1-2*SVF_w)(1-a_w)
78 !
79 ! RRg_r(n) = (1- SVF_r) a_r RRg_w(n-1)
80 !
81 ! RRg_w(n) = SVF_w a_w RRg_r(n-1)
82 ! +(1-2SVF_w) a_w RRg_w(n-1)
83 !
84 !
85 ! i.e.
86 ! n-1
87 ! ARg_r(n) = ARg_r(0) + (1- SVF_r)(1-a_r) SUM RRg_w(k)
88 ! k=0
89 !
90 ! n-1
91 ! ARg_w(n) = ARg_w(0) + SVF_w (1-a_w) SUM RRg_r(k)
92 ! k=0
93 ! n-1
94 ! + (1-2*SVF_w)(1-a_w) SUM RRg_w(k)
95 ! k=0
96 !
97 ! with
98 !
99 ! n n-1
100 ! SUM RRg_r(k) = (1- SVF_r) a_r SUM RRg_w(k) + RRg_r(0)
101 ! k=0 k=0
102 !
103 ! n n-1
104 ! SUM RRg_w(k) = SVF_w a_w SUM RRg_r(k)
105 ! k=0 k=0
106 ! n-1
107 ! +(1-2*SVF_w) a_w SUM RRg_w(k) + RRg_w(0)
108 ! k=0
109 !
110 !
111 ! Then
112 !
113 ! n n-1
114 ! SUM RRg_w(k) = (1-2*SVF_w) a_w SUM RRg_w(k)
115 ! k=0 k=0
116 ! n-2
117 ! + (1- SVF_r) SVF_w a_w a_r SUM RRg_w(k)
118 ! k=0
119 !
120 ! + RRg_w(0) + SVF_w a_w RRg_r(0)
121 !
122 !
123 !
124 !
125 ! solving this system, lead after an infinity of reflections/absorptions:
126 !
127 ! inf RRg_w(0) + SVF_w a_w RRg_r(0)
128 ! SUM RRg_w(k) = ----------------------------------------------------
129 ! k=0 1 - (1-2*SVF_w) a_w - (1- SVF_r) SVF_w a_w a_r
130 !
131 !
132 ! inf (1- SVF_r) a_r ( a_w SVF_w RRg_r(0) + RRg_w(0) )
133 ! SUM RRg_r(k) = ------------------------------------------------------------ + RRg_r(0)
134 ! k=0 1 - (1-2*SVF_w) a_w - (1- SVF_r) SVF_w a_w a_r
135 !
136 !
137 ! ARg_r(n) and ARg_w(n) follow
138 !
139 !
140 ! If snow is present, the albedos in all these formulae (and only these,
141 ! not the final net radiation budget) are modified by the albedo of the
142 ! snow-covered surface.
143 !
144 !
145 !
146 !! EXTERNAL
147 !! --------
148 !!
149 !!
150 !! IMPLICIT ARGUMENTS
151 !! ------------------
152 !!
153 !! MODD_CST
154 !!
155 !!
156 !! REFERENCE
157 !! ---------
158 !!
159 !!
160 !! AUTHOR
161 !! ------
162 !!
163 !! V. Masson * Meteo-France *
164 !!
165 !! MODIFICATIONS
166 !! -------------
167 !! Original 23/01/98
168 !! 21/11/00 (V. Masson) bug in reflections for roads
169 !! 12/02 (A. Lemonsu) bug in diagnostic of albedo
170 !! 12/11 (V. Masson ) adds road direction option
171 !! 01/12 (V. Masson ) adds 2 different wall direct insulations
172 !! 04/12 (G. Pigeon) add B%XTRAN_WIN
173 !! 09/12 (C. de Munck-A. Lemonsu) add green roofs
174 !-------------------------------------------------------------------------------
175 !
176 !* 0. DECLARATIONS
177 ! ------------
178 !
180 USE modd_teb_n, ONLY : teb_t
181 USE modd_bem_n, ONLY : bem_t
183 !
184 USE modd_csts, ONLY : xpi
185 USE modd_bem_cst, ONLY : xwin_sw_max
186 USE modd_surf_par, ONLY : xundef
187 !
188 USE modi_window_shading
189 !
190 !
191 USE yomhook ,ONLY : lhook, dr_hook
192 USE parkind1 ,ONLY : jprb
193 !
194 IMPLICIT NONE
195 !
196 !* 0.1 declarations of arguments
197 !
198 TYPE(teb_options_t), INTENT(INOUT) :: TOP
199  ! 'UNIF' : classical TEB version, all walls are identical
200  ! 'TWO ' : the two opposite walls are different & receive different solar energy
201 TYPE(teb_t), INTENT(INOUT) :: T
202 TYPE(bem_t), INTENT(INOUT) :: B
203 TYPE(diag_misc_teb_t), INTENT(INOUT) :: DMT
204 !
205 REAL, DIMENSION(:), INTENT(IN) :: PDIR_SW ! incoming direct solar radiation
206 REAL, DIMENSION(:), INTENT(IN) :: PSCA_SW ! scattered incoming solar rad.
207 REAL, DIMENSION(:), INTENT(IN) :: PZENITH ! solar zenithal angle
208 REAL, DIMENSION(:), INTENT(IN) :: PAZIM ! solar azimuthal angle
209 ! ! (radian from N, clockwise)
210 REAL, DIMENSION(:), INTENT(IN) :: PFRAC_PANEL ! Fraction of solar panel on roofs (-)
211 REAL, DIMENSION(:), INTENT(IN) :: PALB_PANEL ! Albedo of solar panels (-)
212 REAL, DIMENSION(:), INTENT(IN) :: PALB_GD ! GD areas albedo
213 REAL, DIMENSION(:), INTENT(IN) :: PSVF_GD ! GD areas sky view factor
214 REAL, DIMENSION(:), INTENT(IN) :: PALB_GRF ! green roof albedo
215 REAL, DIMENSION(:), INTENT(IN) :: PDN_RF ! snow-covered roof fraction
216 REAL, DIMENSION(:), INTENT(IN) :: PDF_RF ! snow-free roof fraction
217 REAL, DIMENSION(:), INTENT(IN) :: PDN_RD ! snow-covered road fraction
218 REAL, DIMENSION(:), INTENT(IN) :: PDF_RD ! snow-free road fraction
219 !
220 !new arguments for shading
221 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_RD ! solar radiation received
222 ! ! by snow-free roads
223 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WL_A ! solar radiation received
224 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WL_B ! solar radiation received
225 ! ! by snow-free walls
226 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_GD ! solar radiation received
227 ! ! by GD areas
228 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_RF ! solar radiation received
229 ! ! by RF areas (below solar panels if any)
230 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_SN_RD ! solar radiation received
231 ! ! by snow-covered roads
232 REAL, DIMENSION(:), INTENT(OUT) :: PDIR_ALB_TWN ! town direct albedo
233 REAL, DIMENSION(:), INTENT(OUT) :: PSCA_ALB_TWN ! town diffuse albedo
234 !
235 REAL, DIMENSION(:), INTENT(OUT) :: PSW_RAD_GD ! solar radiation reaching GD areas
236 REAL, DIMENSION(:), INTENT(OUT) :: PREC_SW_WIN ! solar radiation received by windows
237 
238 REAL, DIMENSION(:), INTENT(OUT) :: PREF_SW_GRND ! total solar radiation reflected by ground
239 REAL, DIMENSION(:), INTENT(OUT) :: PREF_SW_FAC ! total solar radiation reflected by wall
240 !new arguments for shading
241 REAL, DIMENSION(:), INTENT(OUT) :: PE_SHADING ! Energy that is not reflected
242  ! by the shading, nor transmitted through
243  ! the bld, nor absorbed by the
244  ! [W/m2(win)]
245 LOGICAL, DIMENSION(:),INTENT(INOUT):: OSHAD_DAY ! has shading been necessary this day ?
246 LOGICAL, DIMENSION(:),INTENT(IN) :: OSHADE ! are building conditions favorable for
247 ! ! shading (independantly of solar irradiance) ?
248 !
249 LOGICAL, INTENT(IN), OPTIONAL :: OALB_ONLY
250 !
251 !* 0.2 declarations of local variables
252 !
253 !
254 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW ! direct and diffuse incoming radiation
255 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW ! with a minimum to compute albedo
256 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZTANZEN ! tangente of solar zenithal angle
257 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZTHETA0 ! canyon angle for
258 ! ! which solar
259 ! ! radiation
260 ! ! reaches the road
261 !
262 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_RD ! averaged albedo
263 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_RD ! direct radiation reaching
264 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL_A ! road, wall A,
265 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL_B ! wall B,
266 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_GD ! GD areas,
267 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDIR_SW_WL ! and on average on 2 walls
268 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_RD ! diffuse radiation reaching
269 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_WL ! road, wall,
270 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZSCA_SW_GD ! and GD areas
271 !
272 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_RF ! solar radiation
273 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_RD ! absorbed by roofs,
274 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL_A ! road, wall A,
275 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL_B ! wall B,
276 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WL ! both walls on average,
277 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GD ! GD areas,
278 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_GRF ! green roof areas,
279 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_PANEL ! solar panels,
280 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_WIN ! window (abs+trans), and snow
281 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SN_RF ! over roof, wall,
282 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_DIR_SW_SN_RD ! and GD areas
283 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_RF ! solar radiation
284 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_RD ! absorbed by roofs,
285 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_WL ! road, wall,
286 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GD ! GD areas,
287 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_GRF ! green roof areas,
288 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_PANEL ! solar panels,
289 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_WIN ! window (abs+trans), and snow
290 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SN_RF ! over roof and wall,
291 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_SCA_SW_SN_RD ! coming from diffuse rad.
292 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZDW ! difference of radiation
293 ! ! absorbed by the 2 walls
294 !
295 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZRD !
296 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZRD_DIR ! Road direction
297 ! ! (radian from N, clockwise)
298 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZGD !
299 !
300 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZREC_DIR_SW_WIN
301 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZREC_SCA_SW_WIN
302 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZAALB_WL
303 !
304 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZTRAN_WIN ! solar transmittivity of windows
305 REAL, DIMENSION(SIZE(PDIR_SW)) :: ZABS_WIN ! solar transmittivity of windows
306 LOGICAL, DIMENSION(SIZE(PDIR_SW)) :: G_EFF_SHAD !TRUE if shading should be active considering actual rad
307 !
308 LOGICAL :: GALB_ONLY
309 INTEGER :: JJ ! loop index
310 REAL(KIND=JPRB) :: ZHOOK_HANDLE
311 !-------------------------------------------------------------------------------
312 !
313 IF (lhook) CALL dr_hook('URBAN_SOLAR_ABS',0,zhook_handle)
314 !
315 galb_only = .false.
316 IF (PRESENT(oalb_only)) galb_only = oalb_only
317 !
318 zdir_sw = max(pdir_sw,0.)
319 zsca_sw = max(psca_sw,0.000001)
320 !
321 zrd_dir = t%XROAD_DIR(:) * xpi/180.
322 !
323 DO jj=1,SIZE(t%XROAD)
324 !
325  IF (t%XROAD(jj)+t%XGARDEN(jj).NE.0.) THEN
326  zrd(jj) = t%XROAD(jj) / (t%XROAD(jj)+t%XGARDEN(jj))
327  zgd(jj) = t%XGARDEN(jj) / (t%XROAD(jj)+t%XGARDEN(jj))
328  ELSE
329  zrd(jj)=0.
330  zgd(jj)=0.
331  ENDIF
332 !
333 !-------------------------------------------------------------------------------
334 !
335 !* 1. SOLAR RADIATIONS FOR ROOFS
336 ! --------------------------
337 !
338 !* One supposes that solar panels, if present, intercept all solar radiation
339 !
340  zabs_dir_sw_panel(jj) = zdir_sw(jj) * (1. - palb_panel(jj))
341  zabs_sca_sw_panel(jj) = zsca_sw(jj) * (1. - palb_panel(jj))
342 !
343 !* solar energy received by the surfaces below solar panels
344  zabs_dir_sw_rf(jj) = zdir_sw(jj) * (1. - t%XALB_ROOF (jj)) * (1.-pfrac_panel(jj))
345  zabs_dir_sw_sn_rf(jj) = zdir_sw(jj) * (1. - t%TSNOW_ROOF%ALB(jj)) * (1.-pfrac_panel(jj))
346  zabs_dir_sw_grf(jj) = zdir_sw(jj) * (1. - palb_grf(jj)) * (1.-pfrac_panel(jj))
347  zabs_sca_sw_rf(jj) = zsca_sw(jj) * (1. - t%XALB_ROOF (jj)) * (1.-pfrac_panel(jj))
348  zabs_sca_sw_sn_rf(jj) = zsca_sw(jj) * (1. - t%TSNOW_ROOF%ALB(jj)) * (1.-pfrac_panel(jj))
349  zabs_sca_sw_grf(jj) = zsca_sw(jj) * (1. - palb_grf(jj)) * (1.-pfrac_panel(jj))
350 !
351 !-------------------------------------------------------------------------------
352 !
353 !* 2. SOLAR RADIATIONS FOR ROADS AND WALLS
354 ! ------------------------------------
355 !
356  IF (abs(0.5*xpi-pzenith(jj)) < 1.e-6) THEN
357  IF(0.5*xpi-pzenith(jj) > 0.) ztanzen(jj)=tan(0.5*xpi-1.e-6)
358  IF(0.5*xpi-pzenith(jj) <= 0.) ztanzen(jj)=tan(0.5*xpi+1.e-6)
359  ELSEIF (abs(pzenith(jj)) < 1.e-6) THEN
360  ztanzen(jj)=sign(1.,pzenith(jj))*tan(1.e-6)
361  ELSE
362  ztanzen(jj) = tan(pzenith(jj))
363  ENDIF
364 !
365 !
366  IF (t%XBLD(jj) .GT. 0.) THEN
367 !
368 !* 2.1 radiation coefficients
369 ! ----------------------
370 !
371 IF (top%CROAD_DIR=='UNIF') THEN
372  ztheta0(jj) = asin( min(abs( 1./ztanzen(jj))/t%XCAN_HW_RATIO(jj), 1. ) )
373 !
374 !* 2.2 direct solar radiation received by roads and GARDEN areas
375 ! -------------------------------------------------------
376 !
377  zdir_sw_rd(jj) = ( zdir_sw(jj) * 2. * ztheta0(jj) / xpi &
378  - zdir_sw(jj) * 2. * ztanzen(jj) / xpi &
379  * t%XCAN_HW_RATIO(jj) * (1.-cos(ztheta0(jj))) )
380 !
381  zdir_sw_gd(jj) = ( zdir_sw(jj) * 2. * ztheta0(jj) / xpi &
382  - zdir_sw(jj) * 2. * ztanzen(jj) / xpi &
383  * t%XCAN_HW_RATIO(jj) * (1.-cos(ztheta0(jj))) )
384 ELSE
385  zdir_sw_rd(jj) = zdir_sw(jj) * &
386  max(0.,1.-t%XCAN_HW_RATIO(jj)*ztanzen(jj)*abs(sin(pazim(jj)-zrd_dir(jj))))
387  zdir_sw_gd(jj) = zdir_sw_rd(jj)
388 
389 END IF
390 !
391 !* 2.3 direct solar radiation received by walls
392 ! ----------------------------------------
393 !
394  zdir_sw_wl(jj) = (zdir_sw(jj) - (zdir_sw_rd(jj)*zrd(jj)+zdir_sw_gd(jj)*zgd(jj))) &
395  * 0.5 / t%XCAN_HW_RATIO(jj)
396 !
397 
398  ELSE
399 !
400  zdir_sw_rd(jj) = zdir_sw(jj)
401  zdir_sw_gd(jj) = zdir_sw(jj)
402  zdir_sw_wl(jj) = 0.
403 !
404  ENDIF
405 !
406 IF (top%CROAD_DIR=='UNIF' .OR. top%CWALL_OPT=='UNIF') THEN
407 !* if walls are averaged, then
408  zdir_sw_wl_a(jj) = zdir_sw_wl(jj)
409  zdir_sw_wl_b(jj) = zdir_sw_wl(jj)
410 ELSE
411 !* if walls are separated, then radiation reaches the wall facing sun
412 ! Note that wall A is the one facing mostly to the South (depending to
413 ! road orientation), and wall B in the one facing mostly to the North
414 !
415 ! In case of N-S road, wall A is the West wall (= East-facing wall),
416 ! and wall B is the East wall (= West-facing wall)
417 ! In case of E-W road, wall A is the North wall (= South-facing wall),
418 ! and wall B is the South wall (= North-facing wall)
419  IF (sin(pazim(jj)-zrd_dir(jj))>0.) THEN
420  zdir_sw_wl_a(jj) = 2.* zdir_sw_wl(jj)
421  zdir_sw_wl_b(jj) = 0.
422  ELSE
423  zdir_sw_wl_a(jj) = 0.
424  zdir_sw_wl_b(jj) = 2.* zdir_sw_wl(jj)
425  END IF
426 END IF
427 !
428 !
429 !
430 !* 2.4 diffuse solar radiation received by roads and GARDEN areas
431 ! ---------------------------------------------------------
432 !
433  zsca_sw_rd(jj) = zsca_sw(jj) * t%XSVF_ROAD(jj)
434 !
435  zsca_sw_gd(jj) = zsca_sw(jj) * psvf_gd(jj)
436 !
437 !* 2.5 diffuse solar radiation received by walls
438 ! -----------------------------------------
439 !
440  zsca_sw_wl(jj) = zsca_sw(jj) * t%XSVF_WALL(jj)
441 !
442 !* 2.6 total solar radiation received by GARDEN areas
443 ! ---------------------------------------------
444 !
445  psw_rad_gd(jj) = zdir_sw_gd(jj) + zsca_sw_gd(jj)
446 !
447 !* 2.7 averaged albedos when snow is present
448 ! -------------------------------------
449 !
450  zaalb_rd(jj) = pdf_rd(jj) * t%XALB_ROAD (jj) + pdn_rd(jj) * t%TSNOW_ROAD%ALB (jj)
451 !
452 !
453 ENDDO
454 !
455 !* 2.7b averaged facade albedo
456 ! -------------------------------------
457 !
458 IF (top%CBEM=='BEM') THEN
459  !
460  ztran_win(:) = b%XTRAN_WIN(:)
461  !
462  g_eff_shad(:) = oshade(:).AND.(zdir_sw_wl(:) + zsca_sw_wl(:) > xwin_sw_max)
463  !
464  oshad_day(:) = g_eff_shad(:) .OR. oshad_day(:)
465  !
466  CALL window_shading(b%XSHGC, b%XSHGC_SH, oshad_day, t%XALB_WALL, &
467  b%XABS_WIN, zabs_win, b%XALB_WIN, ztran_win )
468  !
469 ELSE
470  !
471  zabs_win(:) = 0.
472  b%XALB_WIN (:) = 0.
473  ztran_win(:) = 0.
474  !
475 ENDIF
476 !
477 zaalb_wl(:) = b%XGR(:) * b%XALB_WIN(:) + (1.-b%XGR(:)) * t%XALB_WALL(:)
478 !
479 !* 2.8 absorption of direct incoming solar radiation
480 ! ---------------------------------------------
481 !
482 !
483  CALL solar_reflections(zdir_sw_rd, zdir_sw_wl, zdir_sw_gd, zabs_dir_sw_rd, &
484  zabs_dir_sw_sn_rd, zabs_dir_sw_wl, zabs_dir_sw_gd, &
485  zabs_dir_sw_win )
486 !
487 IF (top%CROAD_DIR=='UNIF' .OR. top%CWALL_OPT=='UNIF') THEN
488 !* if walls are averaged, then
489  zabs_dir_sw_wl_a = zabs_dir_sw_wl
490  zabs_dir_sw_wl_b = zabs_dir_sw_wl
491 ELSE
492 !* if walls are separated, then radiation reaches the wall facing sun
493 ! Note that wall A is the one facing mostly to the North (depending to
494 ! road orientation), and wall B in the one facing mostly to the South.
495  zdw = (1.-t%XALB_WALL(:)) * zaalb_wl(:) * (1.-2.*t%XSVF_WALL(:)) &
496  / (1.+zaalb_wl(:)*(1.-2.*t%XSVF_WALL(:))) &
497  * 0.5 * (zdir_sw_wl_a(:)-zdir_sw_wl_b(:)) &
498  + 0.5 * (1.-t%XALB_WALL(:)) * (zdir_sw_wl_a-zdir_sw_wl_b)
499  zabs_dir_sw_wl_a = zabs_dir_sw_wl + zdw
500  zabs_dir_sw_wl_b = zabs_dir_sw_wl - zdw
501 END IF
502 !
503 !* 2.9 absorption of diffuse incoming solar radiation
504 ! ----------------------------------------------
505 !
506  CALL solar_reflections(zsca_sw_rd,zsca_sw_wl, zsca_sw_gd, &
507  zabs_sca_sw_rd, zabs_sca_sw_sn_rd, &
508  zabs_sca_sw_wl, zabs_sca_sw_gd, zabs_sca_sw_win )
509 !
510 ! solar flux reflected for wall and road
511 !
512 pref_sw_grnd = zrd * t%XALB_ROAD / (1.-t%XALB_ROAD ) * (zabs_dir_sw_rd + zabs_sca_sw_rd) &
513  + zgd * palb_gd / (1.-palb_gd ) * (zabs_dir_sw_gd + zabs_sca_sw_gd)
514 !
515 pref_sw_fac = (1 - b%XGR) * t%XALB_WALL / (1.-t%XALB_WALL) * (zabs_dir_sw_wl + zabs_sca_sw_wl) &
516  + b%XGR * b%XALB_WIN / (1 - b%XALB_WIN) * (zabs_dir_sw_win + zabs_sca_sw_win)
517 !
518 !-------------------------------------------------------------------------------
519 !
520 !* 3. Town albedo
521 ! -----------
522 !
523 !* 3.1 direct albedo
524 ! -------------
525 !
526  CALL town_albedo(zdir_sw,zabs_dir_sw_rf,zabs_dir_sw_sn_rf, &
527  zabs_dir_sw_rd, zabs_dir_sw_sn_rd,zabs_dir_sw_wl, &
528  zabs_dir_sw_gd, zabs_dir_sw_grf, zabs_dir_sw_win, &
529  zabs_dir_sw_panel, pdir_alb_twn )
530 !
531 !* 3.2 direct albedo
532 ! -------------
533 !
534  CALL town_albedo(zsca_sw,zabs_sca_sw_rf,zabs_sca_sw_sn_rf, &
535  zabs_sca_sw_rd, zabs_sca_sw_sn_rd,zabs_sca_sw_wl, &
536  zabs_sca_sw_gd, zabs_sca_sw_grf, zabs_sca_sw_win, &
537  zabs_sca_sw_panel, psca_alb_twn )
538 !
539 WHERE (pdir_alb_twn==xundef) pdir_alb_twn = psca_alb_twn
540 !
541 IF (galb_only) THEN
542  IF (lhook) CALL dr_hook('URBAN_SOLAR_ABS',1,zhook_handle)
543  RETURN
544 ENDIF
545 !-------------------------------------------------------------------------------
546 !
547 !* 4. Trivial cases
548 ! -------------
549 !
550 WHERE(pdir_sw(:)==0.)
551  zabs_dir_sw_rf(:) = 0.
552  zabs_dir_sw_rd(:) = 0.
553  zabs_dir_sw_wl_a(:) = 0.
554  zabs_dir_sw_wl_b(:) = 0.
555  zabs_dir_sw_gd(:) = 0.
556  zabs_dir_sw_grf(:) = 0.
557  zabs_dir_sw_panel(:) = 0.
558  zabs_dir_sw_win(:) = 0.
559  zabs_dir_sw_sn_rf(:) = 0.
560  zabs_dir_sw_sn_rd(:) = 0.
561 END WHERE
562 !
563 WHERE(psca_sw(:)==0.)
564  zabs_sca_sw_rf(:) = 0.
565  zabs_sca_sw_rd(:) = 0.
566  zabs_sca_sw_wl(:) = 0.
567  zabs_sca_sw_gd(:) = 0.
568  zabs_sca_sw_grf(:) = 0.
569  zabs_sca_sw_panel(:) = 0.
570  zabs_sca_sw_win(:) = 0.
571  zabs_sca_sw_sn_rf(:) = 0.
572  zabs_sca_sw_sn_rd(:) = 0.
573 END WHERE
574 !
575 dmt%XABS_SW_ROOF (:) = 0.
576 dmt%XABS_SW_ROAD (:) = 0.
577 dmt%XABS_SW_WALL_A (:) = 0.
578 dmt%XABS_SW_WALL_B (:) = 0.
579 dmt%XABS_SW_GARDEN (:) = 0.
580 dmt%XABS_SW_GREENROOF (:) = 0.
581 dmt%XABS_SW_SNOW_ROOF (:) = 0.
582 dmt%XABS_SW_SNOW_ROAD (:) = 0.
583 IF (top%CBEM=="BEM") THEN
584  dmt%XABS_SW_WIN (:) = 0.
585 ENDIF
586 !
587 prec_sw_win(:) = 0.
588 prec_sw_rd(:) = 0.
589 prec_sw_wl_a(:) = 0.
590 prec_sw_wl_b(:) = 0.
591 prec_sw_gd(:) = 0.
592 prec_sw_sn_rd(:) = 0.
593 prec_sw_rf(:) = 0.
594 !
595 !-------------------------------------------------------------------------------
596 !
597 !
598 IF (top%CBEM=='BEM') THEN
599  !
600  DO jj=1,SIZE(t%XROAD)
601  !
602  ! solar radiation absorbed (but not transmitted) by windows
603  !
604  zrec_dir_sw_win(jj) = zabs_dir_sw_win(jj) / (1.-b%XALB_WIN(jj))
605  zrec_sca_sw_win(jj) = zabs_sca_sw_win(jj) / (1.-b%XALB_WIN(jj))
606  !
607  prec_sw_win(jj) = zrec_dir_sw_win(jj) + zrec_sca_sw_win(jj)
608  !
609  dmt%XABS_SW_WIN(jj) = (zrec_dir_sw_win(jj) + zrec_sca_sw_win(jj)) * zabs_win(jj)
610  !
611  dmt%XTR_SW_WIN (jj) = prec_sw_win(jj) * ztran_win(jj)
612  !
613  ENDDO
614  !
615 ENDIF
616 !
617 DO jj=1,SIZE(t%XROAD)
618 !
619 !* 5. Total solar radiation absorbed by each surface
620 ! ----------------------------------------------
621 !
622 ! solar radiation absorbed by roofs
623 !
624  dmt%XABS_SW_ROOF (jj) = zabs_dir_sw_rf(jj) + zabs_sca_sw_rf(jj)
625 !
626 ! solar radiation absorbed by roads
627 !
628  dmt%XABS_SW_ROAD (jj) = zabs_dir_sw_rd(jj) + zabs_sca_sw_rd(jj)
629 !
630 ! solar radiation absorbed by GARDEN areas
631 !
632  dmt%XABS_SW_GARDEN (jj) = zabs_dir_sw_gd(jj) + zabs_sca_sw_gd(jj)
633 !
634 ! solar radiation absorbed by GRF areas
635 !
636  dmt%XABS_SW_GREENROOF(jj) = zabs_dir_sw_grf(jj) + zabs_sca_sw_grf(jj)
637 !
638 ! solar radiation absorbed by walls
639 !
640  dmt%XABS_SW_WALL_A (jj) = zabs_dir_sw_wl_a(jj) + zabs_sca_sw_wl(jj)
641  dmt%XABS_SW_WALL_B (jj) = zabs_dir_sw_wl_b(jj) + zabs_sca_sw_wl(jj)
642 !
643 !
644 ! solar radiation absorbed by snow on roofs
645 !
646  dmt%XABS_SW_SNOW_ROOF (jj) = zabs_dir_sw_sn_rf(jj) + zabs_sca_sw_sn_rf(jj)
647 !
648 ! solar radiation absorbed by snow on roads
649 !
650  dmt%XABS_SW_SNOW_ROAD (jj) = zabs_dir_sw_sn_rd(jj) + zabs_sca_sw_sn_rd(jj)
651 !
652 !-------------------------------------------------------------------------------
653 !
654 !* 6. total solar radiation received by roads and GARDEN areas
655 ! -------------------------------------------------------
656 !
657  prec_sw_rd(jj) = dmt%XABS_SW_ROAD (jj)/(1.-t%XALB_ROAD (jj))
658 !
659  prec_sw_sn_rd(jj) = dmt%XABS_SW_SNOW_ROAD (jj)/(1.-t%TSNOW_ROAD%ALB(jj))
660 !
661  prec_sw_wl_a(jj) = dmt%XABS_SW_WALL_A (jj)/(1.-t%XALB_WALL (jj))
662  prec_sw_wl_b(jj) = dmt%XABS_SW_WALL_B (jj)/(1.-t%XALB_WALL (jj))
663 !
664  prec_sw_gd(jj) = dmt%XABS_SW_GARDEN (jj)/(1.-palb_gd(jj))
665 !
666 !* 6.2 total solar radiation received by roof surfaces below solar panels
667 !
668  prec_sw_rf(jj) = (pdir_sw(jj) + psca_sw(jj)) * (1.-pfrac_panel(jj))
669 !
670 !-------------------------------------------------------------------------------
671 !
672 !* 7. total solar radiation transmitted inside building
673 !* and energy not ref., nor absorbed, nor transmitted
674 ! --------------------------------------------------
675 !
676 ! [W/m2(bld)]
677  pe_shading(jj) = prec_sw_win(jj) * (1. - b%XALB_WIN(jj) - zabs_win(jj) - ztran_win(jj))
678 ! [W/m2(win)]
679 
680 ENDDO
681 !
682 IF (top%LSOLAR_PANEL) THEN
683  !
684  DO jj=1,SIZE(t%XROAD)
685  !
686  ! solar radiation absorbed by solar panels
687  !
688  dmt%XABS_SW_PANEL(jj) = zabs_dir_sw_panel(jj) + zabs_sca_sw_panel(jj)
689  !
690  ENDDO
691  !
692 ENDIF
693 !
694 !-------------------------------------------------------------------------------
695 !
696 IF (lhook) CALL dr_hook('URBAN_SOLAR_ABS',1,zhook_handle)
697 CONTAINS
698 !
699 !-------------------------------------------------------------------------------
700 SUBROUTINE solar_reflections(ZSW_RD,ZSW_WL, ZSW_GD, ZABS_SW_RD,ZABS_SW_SN_RD, &
701  ZABS_SW_WL, ZABS_SW_GD, ZABS_SW_WIN )
702 !
703 REAL, DIMENSION(:), INTENT(IN) :: ZSW_RD ! solar radiation received by road,
704 REAL, DIMENSION(:), INTENT(IN) :: ZSW_WL ! wall, and GD areas
705 REAL, DIMENSION(:), INTENT(IN) :: ZSW_GD ! before reflection
706 REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_RD ! solar radiation absorbed by
707 REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_SN_RD ! solar radiation absorbed by
708 REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_WL ! road, snow over road, and wall
709 REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_GD ! solar radiation absorbed by garden
710 REAL, DIMENSION(:), INTENT(OUT):: ZABS_SW_WIN ! solar radiation absorbed by window
711 !
712 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_RD ! first solar reflection
713 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_WL ! against road, wall
714 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZREF0_SW_GD ! and GD areas
715 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_RD ! sum of all reflections
716 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_WL ! against road, wall,
717 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZSREF_SW_GD ! and GD areas
718 !
719 REAL, DIMENSION(SIZE(ZSW_RD)) :: ZWORK1, ZWORK2, ZDENOM
720 INTEGER :: JJ
721 REAL(KIND=JPRB) :: ZHOOK_HANDLE
722 !
723 IF (lhook) CALL dr_hook('SOLAR_REFLECTIONS',0,zhook_handle)
724 !
725 DO jj=1,SIZE(zsw_rd)
726 !* A. first solar radiation reflection
727 ! --------------------------------
728 !
729  zref0_sw_rd(jj) = zaalb_rd(jj) * zsw_rd(jj)
730 !
731  zref0_sw_gd(jj) = palb_gd(jj) * zsw_gd(jj)
732 !
733  zref0_sw_wl(jj) = zaalb_wl(jj) * zsw_wl(jj)
734 !
735 !* B. sum of solar radiation reflected
736 ! --------------------------------
737 !
738 
739  zdenom(jj) = 1. - (1.-2.*t%XSVF_WALL(jj)) * t%XALB_WALL(jj) - (1. - t%XSVF_ROAD(jj))* &
740  t%XSVF_WALL(jj)*t%XALB_WALL(jj)*zaalb_rd(jj)*zrd(jj) &
741  - (1. - psvf_gd(jj))* &
742  t%XSVF_WALL(jj)*t%XALB_WALL(jj)*palb_gd(jj)*zgd(jj)
743 
744  zwork1(jj) = t%XSVF_WALL(jj) * t%XALB_WALL(jj) * zrd(jj)
745  zwork2(jj) = t%XSVF_WALL(jj) * t%XALB_WALL(jj) * zgd(jj)
746 !
747 !
748  zsref_sw_wl(jj) = ( zref0_sw_wl(jj) + zwork1(jj) *zref0_sw_rd(jj) &
749  + zwork2(jj) *zref0_sw_gd(jj)) / zdenom(jj)
750 
751  zsref_sw_rd(jj) = ((1.- t%XSVF_ROAD(jj)) * zaalb_rd(jj) * zref0_sw_wl(jj) &
752  +(1.- t%XSVF_ROAD(jj)) * zaalb_rd(jj) * zwork1(jj) * zref0_sw_rd(jj) &
753  +(1.- t%XSVF_ROAD(jj)) * zaalb_rd(jj) * zwork2(jj) * zref0_sw_gd(jj)) &
754  / zdenom(jj) + zref0_sw_rd(jj)
755 
756  zsref_sw_gd(jj) = ((1.- psvf_gd(jj)) * palb_gd(jj) * zref0_sw_wl(jj) &
757  +(1.- psvf_gd(jj)) * palb_gd(jj) * zwork1(jj) * zref0_sw_rd(jj) &
758  +(1.- psvf_gd(jj)) * palb_gd(jj) * zwork2(jj) * zref0_sw_gd(jj) )&
759  / zdenom(jj) + zref0_sw_gd(jj)
760 !
761 !* C. total solar radiation received by roads and GD areas
762 ! -------------------------------------------------------
763 !
764  zabs_sw_rd(jj) = (1.-t%XALB_ROAD(jj)) * (zsw_rd(jj) + zsref_sw_wl(jj) * (1.- t%XSVF_ROAD(jj)))
765 !
766  zabs_sw_sn_rd(jj) = (1.-t%TSNOW_ROAD%ALB(jj)) * &
767  (zsw_rd(jj) + zsref_sw_wl(jj) * (1.- t%XSVF_ROAD(jj)))
768 !
769  zabs_sw_gd(jj) = (1.-palb_gd(jj)) * (zsw_gd(jj) + zsref_sw_wl(jj) * (1.- psvf_gd(jj)))
770 !
771 !
772 !* D. total solar radiation received by walls
773 ! ---------------------------------------
774 !
775  zabs_sw_wl(jj) = (1.-t%XALB_WALL(jj)) &
776  * (zsw_wl(jj) &
777  + zsref_sw_rd(jj) * t%XSVF_WALL(jj)*zrd(jj) &
778  + zsref_sw_gd(jj) * t%XSVF_WALL(jj)*zgd(jj) &
779  + zsref_sw_wl(jj) * (1.-2.*t%XSVF_WALL(jj)) )
780 !
781  zabs_sw_win(jj) = (1.-b%XALB_WIN (jj)) &
782  * (zsw_wl(jj) &
783  + zsref_sw_rd(jj) * t%XSVF_WALL(jj)*zrd(jj) &
784  + zsref_sw_gd(jj) * t%XSVF_WALL(jj)*zgd(jj) &
785  + zsref_sw_wl(jj) * (1.-2.*t%XSVF_WALL(jj)) )
786 !
787 ENDDO
788 !
789 IF (lhook) CALL dr_hook('SOLAR_REFLECTIONS',1,zhook_handle)
790 !
791 END SUBROUTINE solar_reflections
792 !
793 !-------------------------------------------------------------------------------
794 !
795 SUBROUTINE town_albedo(ZSW,ZABS_SW_RF,ZABS_SW_SN_RF,ZABS_SW_RD,ZABS_SW_SN_RD,&
796  ZABS_SW_WL,ZABS_SW_GD, ZABS_SW_GRF, ZABS_SW_WIN, &
797  ZABS_SW_PANEL, ZALBEDO )
798 !
799 REAL, DIMENSION(:), INTENT(IN) :: ZSW ! incoming solar radiation
800 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_RF ! solar radiation absorbed by roofs
801 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_RD ! solar radiation absorbed by roads
802 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_WL ! solar radiation absorbed by walls
803 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_WIN ! solar radiation absorbed & transmitted by windows
804 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GD ! solar radiation absorbed by GARDEN areas
805 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_GRF ! solar radiation absorbed by green roof areas
806 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SN_RF ! solar radiation absorbed by roof snow
807 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_SN_RD ! solar radiation absorbed by road snow
808 REAL, DIMENSION(:), INTENT(IN) :: ZABS_SW_PANEL ! solar radiation absorbed by solar panels
809 REAL, DIMENSION(:), INTENT(OUT):: ZALBEDO ! town averaged albedo
810 
811 REAL, DIMENSION(SIZE(ZSW)) :: ZSW_UP ! outgoing solar radiation
812 INTEGER :: JJ
813 REAL(KIND=JPRB) :: ZHOOK_HANDLE
814 
815 IF (lhook) CALL dr_hook('TOWN_ALBEDO',0,zhook_handle)
816 DO jj=1,SIZE(zsw)
817 
818  zsw_up(jj) = zsw(jj) &
819  - ( t%XBLD(jj) *(1.-t%XGREENROOF(jj))*pdf_rf(jj) *zabs_sw_rf(jj)&
820  +t%XBLD(jj) *(1.-t%XGREENROOF(jj))*pdn_rf(jj) *zabs_sw_sn_rf(jj)&
821  +t%XBLD(jj) * t%XGREENROOF(jj) *zabs_sw_grf(jj)&
822  +t%XBLD(jj) * pfrac_panel(jj) *zabs_sw_panel(jj)&
823  +t%XROAD(jj) *pdf_rd(jj) *zabs_sw_rd(jj) &
824  +t%XROAD(jj) *pdn_rd(jj) *zabs_sw_sn_rd(jj)&
825  +t%XGARDEN(jj) *zabs_sw_gd(jj) &
826  +t%XWALL_O_HOR(jj) *(1.-b%XGR(jj)) *zabs_sw_wl(jj) &
827  +t%XWALL_O_HOR(jj) * b%XGR(jj) *zabs_sw_win(jj) )
828 !
829  IF (zsw(jj)>0.) THEN
830  zalbedo(jj) = zsw_up(jj) / zsw(jj)
831  ELSE
832  zalbedo(jj) = xundef
833  END IF
834 !
835 ENDDO
836 IF (lhook) CALL dr_hook('TOWN_ALBEDO',1,zhook_handle)
837 !
838 END SUBROUTINE town_albedo
839 !
840 !-------------------------------------------------------------------------------
841 !
842 END SUBROUTINE urban_solar_abs
subroutine window_shading(PSHGC, PSHGC_SH, O_SHADE, PALB_WALL, PABS_WIN, PABS_WINSH, PALB_WIN, PTRAN_WIN)
subroutine urban_solar_abs(TOP, T, B, DMT, PDIR_SW, PSCA_SW, PZENITH, PAZIM, PFRAC_PANEL, PALB_PANEL, PALB_GD, PSVF_GD, PALB_GRF, PDN_RF, PDF_RF, PDN_RD, PDF_RD, PREC_SW_RD, PREC_SW_SN_RD, PREC_SW_WL_A, PREC_SW_WL_B, PREC_SW_GD, PREC_SW_RF, PDIR_ALB_TWN, PSCA_ALB_TWN, PSW_RAD_GD, PREC_SW_WIN, PREF_SW_GRND, PREF_SW_FAC, PE_SHADING, OSHAD_DAY, OSHADE, OALB_ONLY)
real, save xpi
Definition: modd_csts.F90:43
subroutine town_albedo(ZSW, ZABS_SW_RF, ZABS_SW_SN_RF, ZABS_SW_RD, ZABS_SW_SN_RD, ZABS_SW_WL, ZABS_SW_GD, ZABS_SW_GRF, ZABS_SW_WIN, ZABS_SW_PANEL, ZALBEDO)
real, parameter xundef
integer, parameter jprb
Definition: parkind1.F90:32
logical lhook
Definition: yomhook.F90:15
subroutine solar_reflections(ZSW_RD, ZSW_WL, ZSW_GD, ZABS_SW_RD, ZABS_SW_SN_RD, ZABS_SW_WL, ZABS_SW_GD, ZABS_SW_WIN)
real, parameter xwin_sw_max