SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
averaged_tsrad_teb.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 averaged_tsrad_teb(PEMIS_ROOF, PTS_ROOF, &
7  pemis_road, pts_road, &
8  pemis_wall, pts_wall_a, &
9  pts_wall_b, &
10  pemis_garden, pts_garden, &
11  pemis_greenroof, pts_greenroof, &
12  tsnow_roof, tsnow_road, &
13  proad, pfrac_gr, pgarden, pbld, &
14  pwall_o_hor, psvf_road, &
15  psvf_wall, psvf_garden, &
16  pemis, ptsrad, pt_win1, &
17  pgr )
18 ! ###################################################
19 !
20 !!**** *AVERAGED_TSRAD_TEB* computes averaged emissivity and radiative surface
21 !! temperature for TEB scheme
22 !!
23 !! PURPOSE
24 !! -------
25 !!
26 !! METHOD
27 !! ------
28 !!
29 !! EXTERNAL
30 !! --------
31 !!
32 !! IMPLICIT ARGUMENTS
33 !! ------------------
34 !!
35 !! REFERENCE
36 !! ---------
37 !!
38 !! AUTHOR
39 !! ------
40 !!
41 !! V. Masson Meteo-France
42 !!
43 !! MODIFICATION
44 !! ------------
45 !! 09/2012 C. de Munck, A. Lemonsu : add green roofs
46 !!
47 !! Original 01/2004
48 !----------------------------------------------------------------------------
49 !
50 !* 0. DECLARATION
51 ! -----------
52 !
54 !
55 USE modd_surf_par, ONLY : xundef
56 USE modd_csts, ONLY : xstefan
57 !
58 USE modi_urban_lw_coef
59 !
61 !
62 !
63 USE yomhook ,ONLY : lhook, dr_hook
64 USE parkind1 ,ONLY : jprb
65 !
66 IMPLICIT NONE
67 !
68 !* 0.1 Declaration of arguments
69 ! ------------------------
70 !
71 REAL, DIMENSION(:), INTENT(IN) :: pemis_roof ! roof emissivity
72 REAL, DIMENSION(:), INTENT(IN) :: pts_roof ! roof surface temperature
73 REAL, DIMENSION(:), INTENT(IN) :: pemis_road ! road emissivity
74 REAL, DIMENSION(:), INTENT(IN) :: pts_road ! road surface temperature
75 REAL, DIMENSION(:), INTENT(IN) :: pemis_wall ! wall emissivity
76 REAL, DIMENSION(:), INTENT(IN) :: pts_wall_a ! wall surface temperature
77 REAL, DIMENSION(:), INTENT(IN) :: pts_wall_b ! wall surface temperature
78 REAL, DIMENSION(:), INTENT(IN) :: pemis_garden ! green area emissivity (snowfree)
79 REAL, DIMENSION(:), INTENT(IN) :: pts_greenroof ! green roof surf. temp.
80 REAL, DIMENSION(:), INTENT(IN) :: pemis_greenroof! green roof emissivity (snowfree)
81 REAL, DIMENSION(:), INTENT(IN) :: pts_garden ! green area surf. temp.
82 TYPE(surf_snow), INTENT(IN) :: tsnow_roof ! snow on roofs
83 TYPE(surf_snow), INTENT(IN) :: tsnow_road ! snow on roads
84 REAL, DIMENSION(:), INTENT(IN) :: proad ! road fraction
85 REAL, DIMENSION(:), INTENT(IN) :: pfrac_gr ! green roof fraction
86 REAL, DIMENSION(:), INTENT(IN) :: pgarden ! green area fraction
87 REAL, DIMENSION(:), INTENT(IN) :: pbld ! building fraction
88 REAL, DIMENSION(:), INTENT(IN) :: pwall_o_hor ! vertical surf. / horizontal surf.
89 REAL, DIMENSION(:), INTENT(IN) :: psvf_road ! sky-view-factor from roads
90 REAL, DIMENSION(:), INTENT(IN) :: psvf_wall ! sky-view-factor from walls
91 REAL, DIMENSION(:), INTENT(IN) :: psvf_garden ! sky-view-factor from green areas
92 REAL, DIMENSION(:), INTENT(OUT):: pemis ! averaged emissivity (all tiles)
93 REAL, DIMENSION(:), INTENT(OUT):: ptsrad ! averaged radiaitve temp. (all tiles)
94 REAL, DIMENSION(:), INTENT(IN) :: pt_win1 !
95 REAL, DIMENSION(:), INTENT(IN) :: pgr !
96 !
97 !
98 !* 0.2 Declaration of local variables
99 ! ------------------------------
100 !
101 REAL, DIMENSION(SIZE(PEMIS_ROOF)) :: zdn_roof ! snow fraction
102 REAL, DIMENSION(SIZE(PEMIS_ROOF)) :: zdn_road ! on the surface
103 REAL, DIMENSION(SIZE(PBLD)) :: zdf_roof ! free-snow fraction
104 REAL, DIMENSION(SIZE(PBLD)) :: zdf_road ! on the surface
105 LOGICAL, DIMENSION(SIZE(PBLD)) :: gmask ! .false. (= no snow precip.)
106 !
107 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wa_to_wb ! longwave exchange coefficients
108 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wa_to_r
109 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wb_to_r
110 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wa_to_nr
111 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wb_to_nr
112 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wa_to_g
113 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wb_to_g
114 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wa_to_win
115 REAL, DIMENSION(SIZE(PBLD)) :: zlw_wb_to_win
116 REAL, DIMENSION(SIZE(PBLD)) :: zlw_r_to_wa
117 REAL, DIMENSION(SIZE(PBLD)) :: zlw_r_to_wb
118 REAL, DIMENSION(SIZE(PBLD)) :: zlw_r_to_win
119 REAL, DIMENSION(SIZE(PBLD)) :: zlw_g_to_wa
120 REAL, DIMENSION(SIZE(PBLD)) :: zlw_g_to_wb
121 REAL, DIMENSION(SIZE(PBLD)) :: zlw_g_to_win
122 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_wa
123 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_wb
124 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_r
125 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_nr
126 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_g
127 REAL, DIMENSION(SIZE(PBLD)) :: zlw_s_to_win
128 REAL, DIMENSION(SIZE(PBLD)) :: zlw_win_to_wa
129 REAL, DIMENSION(SIZE(PBLD)) :: zlw_win_to_wb
130 REAL, DIMENSION(SIZE(PBLD)) :: zlw_win_to_r
131 REAL, DIMENSION(SIZE(PBLD)) :: zlw_win_to_nr
132 REAL, DIMENSION(SIZE(PBLD)) :: zlw_win_to_g
133 REAL, DIMENSION(SIZE(PBLD)) :: zlw_nr_to_wa
134 REAL, DIMENSION(SIZE(PBLD)) :: zlw_nr_to_wb
135 REAL, DIMENSION(SIZE(PBLD)) :: zlw_nr_to_win
136 !
137 REAL, DIMENSION(SIZE(PBLD)) :: zlw_rad ! incoming LW to mimic
138 ! ! radiation behaviour of town
139 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_wall ! longwave absorbed by walls
140 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_road ! longwave absorbed by roads
141 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_roof ! longwave absorbed by roofs
142 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_snow_road! longwave absorbed by snow
143 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_snow_roof! on roads and roofs
144 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_garden ! longwave absorbed by gardens
145 REAL, DIMENSION(SIZE(PBLD)) :: zabs_lw_greenroof! longwave absorbed by green roofs
146 REAL, DIMENSION(SIZE(PBLD)) :: zlw_up ! outgoing longwave
147 !
148 REAL, DIMENSION(SIZE(PBLD)) :: zt_sky
149 REAL(KIND=JPRB) :: zhook_handle
150 !
151 !-------------------------------------------------------------------------------
152 !
153 !* snow fractions
154 ! --------------
155 !
156 IF (lhook) CALL dr_hook('AVERAGED_TSRAD_TEB',0,zhook_handle)
157 gmask(:) = .false.
158  CALL snow_frac_road(tsnow_road%WSNOW(:,1,1),gmask,zdn_road,zdf_road)
159  CALL snow_frac_roof(tsnow_roof%WSNOW(:,1,1),gmask,zdn_roof,zdf_roof)
160 !
161 ! fixed incoming LW (W/m2)
162 zlw_rad(:)= xstefan * (pts_road(:) ** 4)
163 !
164 ! LW absorbed by roofs
165 zabs_lw_roof(:) = pemis_roof(:) * (zlw_rad(:) - xstefan * pts_roof(:)**4)
166 !
167 !* LW absorbed by snow on roof
168 zabs_lw_snow_roof(:) = tsnow_roof%EMIS(:,1) * (zlw_rad(:) - xstefan * tsnow_roof%TS(:,1)**4)
169 !
170 !* town averaged emissivity
171 pemis(:) = pbld(:) * (1.-pfrac_gr(:)) * (zdf_roof(:)*pemis_roof(:) &
172  + zdn_roof(:)*tsnow_roof%EMIS(:,1)) &
173  + pbld(:) * pfrac_gr(:) * pemis_greenroof(:)
174 
175 !
176 !* long-wave trapping coefficients
177 ! -------------------------------
178 !
179  zt_sky(:) = (zlw_rad(:)/xstefan)**0.25
180  !
181  CALL urban_lw_coef(pgr, pbld, zlw_rad, &
182  pemis_road, psvf_road, pemis_wall, psvf_wall, &
183  pemis_garden, proad, pgarden, &
184  tsnow_road%EMIS(:,1), &
185  pts_road, pts_wall_a, pts_wall_b, &
186  pts_road, pts_garden, pt_win1, &
187  zlw_wa_to_wb, zlw_wa_to_r, zlw_wb_to_r, &
188  zlw_wa_to_nr,zlw_wb_to_nr, &
189  zlw_wa_to_g, zlw_wb_to_g, &
190  zlw_wa_to_win, zlw_wb_to_win, &
191  zlw_r_to_wa, zlw_r_to_wb, zlw_r_to_win, &
192  zlw_g_to_wa, zlw_g_to_wb, zlw_g_to_win, &
193  zlw_s_to_wa, zlw_s_to_wb, zlw_s_to_r, &
194  zlw_s_to_nr, zlw_s_to_g, zlw_s_to_win, &
195  zlw_win_to_wa, zlw_win_to_wb, zlw_win_to_r, &
196  zlw_win_to_nr, zlw_win_to_g, &
197  zlw_nr_to_wa, zlw_nr_to_wb, zlw_nr_to_win )
198  !
199  !
200  !* town averaged emissivity
201  ! ------------------------
202  !
203  pemis(:) = pemis(:) &
204  + proad(:)*psvf_road(:)* (zdf_road(:)* pemis_road(:) &
205  + zdn_road(:)* tsnow_road%EMIS(:,1)) &
206  + pwall_o_hor(:) * psvf_wall(:) * pemis_wall(:) &
207  + pgarden(:) * psvf_garden(:) * pemis_garden(:)
208 
209  !
210  ! LW absorbed by roads
211  zabs_lw_road(:) = zlw_s_to_r(:) * (zt_sky(:) - pts_road(:)) &
212  + zlw_wa_to_r(:) * (pts_wall_a(:) - pts_road(:)) &
213  + zlw_wb_to_r(:) * (pts_wall_b(:) - pts_road(:)) &
214  + zlw_win_to_r(:) * (pt_win1(:) - pts_road(:))
215 
216  !
217  ! LW absorbed by walls
218  zabs_lw_wall(:) =( zlw_s_to_wa(:) * (zt_sky(:) - pts_wall_a(:)) &
219  + zlw_r_to_wa(:) * (pts_road(:) - pts_wall_a(:)) &
220  + zlw_g_to_wa(:) * (pts_garden(:)- pts_wall_a(:)) &
221  + zlw_win_to_wa(:)* (pt_win1(:) - pts_wall_a(:)) &
222  + zlw_s_to_wb(:) * (zt_sky(:) - pts_wall_b(:)) &
223  + zlw_r_to_wb(:) * (pts_road(:) - pts_wall_b(:)) &
224  + zlw_g_to_wb(:) * (pts_garden(:)- pts_wall_b(:)) &
225  + zlw_win_to_wb(:)* (pt_win1(:) - pts_wall_b(:)))&
226  * 0.5
227 
228  !
229  !* LW absorbed by snow on road
230  zabs_lw_snow_road(:) = zlw_s_to_r(:) * (zt_sky(:) - tsnow_road%TS(:,1)) &
231  + zlw_wa_to_nr(:) * (pts_wall_a(:) - tsnow_road%TS(:,1)) &
232  + zlw_wb_to_nr(:) * (pts_wall_b(:) - tsnow_road%TS(:,1)) &
233  + zlw_win_to_nr(:) * (pt_win1(:) - tsnow_road%TS(:,1))
234  !
235  !* LW absorbed by gardens
236  zabs_lw_garden(:) = zlw_s_to_g(:)*(zt_sky(:)-pts_garden(:)) &
237  + zlw_wa_to_g(:)*(pts_wall_a(:)-pts_garden(:)) &
238  + zlw_wb_to_g(:)*(pts_wall_b(:)-pts_garden(:)) &
239  + zlw_win_to_g(:)*(pt_win1(:)-pts_garden(:))
240  !
241  !* LW absorbed by green roofs
242 zabs_lw_greenroof(:) = pemis_greenroof(:) * (zlw_rad(:) - xstefan * pts_greenroof(:)** 4)
243 
244 !
245 !* outgoing longwave radiation
246 zlw_up(:) = zlw_rad(:) &
247  - ( pbld(:) *(1.-pfrac_gr(:))*zdf_roof(:)*zabs_lw_roof(:) &
248  +pbld(:) *(1.-pfrac_gr(:))*zdn_roof(:)*zabs_lw_snow_roof(:) &
249  +pbld(:) * pfrac_gr(:) *zabs_lw_greenroof(:) &
250  +proad(:) *zdf_road(:)*zabs_lw_road(:) &
251  +proad(:) *zdn_road(:)*zabs_lw_snow_road(:) &
252  +pwall_o_hor(:) *zabs_lw_wall(:) &
253  +pgarden(:) *zabs_lw_garden(:))
254 !
255 !* town radiative surface temperature
256 ptsrad(:) = ((zlw_up(:) - zlw_rad(:)*(1.-pemis(:))) /pemis(:)/xstefan)**0.25
257 !
258 IF (lhook) CALL dr_hook('AVERAGED_TSRAD_TEB',1,zhook_handle)
259 !-------------------------------------------------------------------------------
260 !
261 END SUBROUTINE averaged_tsrad_teb
subroutine averaged_tsrad_teb(PEMIS_ROOF, PTS_ROOF, PEMIS_ROAD, PTS_ROAD, PEMIS_WALL, PTS_WALL_A, PTS_WALL_B, PEMIS_GARDEN, PTS_GARDEN, PEMIS_GREENROOF, PTS_GREENROOF, TSNOW_ROOF, TSNOW_ROAD, PROAD, PFRAC_GR, PGARDEN, PBLD, PWALL_O_HOR, PSVF_ROAD, PSVF_WALL, PSVF_GARDEN, PEMIS, PTSRAD, PT_WIN1, PGR)
subroutine snow_frac_roof(PWSNOW_ROOF, OSNOW, PDN_ROOF, PDF_ROOF)
subroutine urban_lw_coef(PGR, PBLD, PLW_RAD, PEMIS_R, PSVF_R, PEMIS_W, PSVF_W, PEMIS_G, PROAD, PGARDEN, PESNOW_R, PTS_SR, PTS_W_A, PTS_W_B, PTS_R, PTS_G, PTS_WIN, PLW_WA_TO_WB, PLW_WA_TO_R, PLW_WB_TO_R, PLW_WA_TO_NR, PLW_WB_TO_NR, PLW_WA_TO_G, PLW_WB_TO_G, PLW_WA_TO_WIN, PLW_WB_TO_WIN, PLW_R_TO_WA, PLW_R_TO_WB, PLW_R_TO_WIN, PLW_G_TO_WA, PLW_G_TO_WB, PLW_G_TO_WIN, PLW_S_TO_WA, PLW_S_TO_WB, PLW_S_TO_R, PLW_S_TO_NR, PLW_S_TO_G, PLW_S_TO_WIN, PLW_WIN_TO_WA, PLW_WIN_TO_WB, PLW_WIN_TO_R, PLW_WIN_TO_NR, PLW_WIN_TO_G, PLW_NR_TO_WA, PLW_NR_TO_WB, PLW_NR_TO_WIN)
subroutine snow_frac_road(PWSNOW_ROAD, OSNOW, PDN_ROAD, PDF_ROAD)