SURFEX v8.1
General documentation of Surfex
road_layer_e_budget.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 road_layer_e_budget(T, B, PTSTEP, PDN_ROAD, PRHOA, PAC_ROAD, PAC_ROAD_WAT, &
7  PLW_RAD, PPS, PQSAT_ROAD, PDELT_ROAD, PEXNS, &
8  PABS_SW_ROAD, PGSNOW_ROAD, PQ_LOWCAN, PT_LOWCAN, &
9  PTS_WALL_A, PTS_WALL_B, PTSNOW_ROAD, PTS_GARDEN, &
10  PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, PLW_WIN_TO_R, &
11  PEMIT_LW_ROAD, PDQS_ROAD, PABS_LW_ROAD, PHFREE_ROAD, &
12  PLEFREE_ROAD, PIMB_ROAD, PRR )
13 ! ##########################################################################
14 !
15 !!**** *ROAD_LAYER_E_BUDGET*
16 !!
17 !! PURPOSE
18 !! -------
19 !
20 ! Computes the evoultion of roads surface temperatures
21 !
22 !
23 !!** METHOD
24 ! ------
25 !
26 ! 6 : equations for evolution of Ts_road
27 ! **********************************
28 !
29 !
30 ! dTr_1(t) / dt = 1/(dr_1*Cr_1) * ( Rn_r - H_r - LE_r
31 ! - 2*Kr_1*(Tr_1-Tr_2)/(dr_1 +dr_2) )
32 !
33 ! dTr_k(t) / dt = 1/(dr_k*Cr_k) * (- 2*Kr_k-1*(Tr_k-Tr_k-1)/(dr_k-1 +dr_k)
34 ! - 2*Kr_k *(Tr_k-Tr_k+1)/(dr_k+1 +dr_k) )
35 !
36 ! with
37 !
38 ! K*_k = (d*_k+ d*_k+1)/(d*_k/k*_k+ d*_k+1/k*_k+1)
39 !
40 ! Rn_r = abs_Rg_r
41 ! - sigma * emis_r * Ts_r**4 (t+dt)
42 ! + emis_r * SVF_r * LWR
43 ! + sigma * emis_r * emis_w * (1-SVF_r) * Ts_w**4 (t+dt)
44 ! + emis_r (1-emis_w) * (1-SVF_r) * SVF_w * LWR
45 ! + sigma * emis_r * emis_w * (1-emis_w) * (1-SVF_r) * (1-2*SVF_w) * Ts_w**4 (t+dt)
46 ! + sigma * emis_r * emis_r * (1-emis_w) * (1-SVF_r) * SVF_w * Ts_r**4 (t+dt)
47 !
48 ! H_r = rho Cp CH V ( Ts_r (t+dt) - Ta_canyon )
49 !
50 ! LE_r = rho Lv CH V ( qs_r (t+dt) - qa_canyon )
51 !
52 !
53 ! The system is implicited (or semi-implicited).
54 !
55 ! ZIMPL=1 ---> implicit system
56 ! ZIMPL=0.5 ---> semi-implicit system
57 ! ZIMPL=0 ---> explicit system
58 !
59 !
60 !
61 !
62 !! EXTERNAL
63 !! --------
64 !!
65 !!
66 !! IMPLICIT ARGUMENTS
67 !! ------------------
68 !!
69 !! MODD_CST
70 !!
71 !!
72 !! REFERENCE
73 !! ---------
74 !!
75 !!
76 !! AUTHOR
77 !! ------
78 !!
79 !! V. Masson * Meteo-France *
80 !!
81 !! MODIFICATIONS
82 !! -------------
83 !! Original 23/01/98
84 !! 21/11/01 (V. Masson and A. Lemonsu) bug of latent flux
85 !! for very strong evaporation (all reservoir emptied
86 !! in one time-step)
87 !! 02/11 (V. Masson) split of the routine for roads and walls separately
88 !! G. Pigeon 09/2012: add heating/cooling of rain from air temperature
89 !! to surface road temp. for the road energy budget
90 !-------------------------------------------------------------------------------
91 !
92 !* 0. DECLARATIONS
93 ! ------------
94 !
95 USE modd_teb_n, ONLY : teb_t
96 USE modd_bem_n, ONLY : bem_t
97 !
98 USE modd_csts,ONLY : xcpd, xlvtt, xstefan, xcl
99 !
100 USE mode_thermos
101 !
102 USE modi_layer_e_budget
103 USE modi_layer_e_budget_get_coef
104 !
105 USE yomhook ,ONLY : lhook, dr_hook
106 USE parkind1 ,ONLY : jprb
107 !
108 IMPLICIT NONE
109 !
110 !* 0.1 declarations of arguments
111 !
112 TYPE(teb_t), INTENT(INOUT) :: T
113 TYPE(bem_t), INTENT(INOUT) :: B
114 !
115 REAL, INTENT(IN) :: PTSTEP ! time step
116 REAL, DIMENSION(:), INTENT(IN) :: PDN_ROAD ! road snow fraction
117 REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! rho
118 REAL, DIMENSION(:), INTENT(IN) :: PAC_ROAD ! aerodynamical conductance
119 ! ! between road and canyon
120 REAL, DIMENSION(:), INTENT(IN) :: PAC_ROAD_WAT ! aerodynamical conductance
121 ! ! between road and canyon
122 ! ! (for water)
123 REAL, DIMENSION(:), INTENT(IN) :: PLW_RAD ! atmospheric infrared radiation
124 REAL, DIMENSION(:), INTENT(IN) :: PPS ! pressure at the surface
125 REAL, DIMENSION(:), INTENT(IN) :: PQSAT_ROAD ! q_sat(Ts)
126 REAL, DIMENSION(:), INTENT(IN) :: PDELT_ROAD ! fraction of water
127 REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! surface Exner function
128 REAL, DIMENSION(:), INTENT(IN) :: PABS_SW_ROAD ! absorbed solar radiation
129 REAL, DIMENSION(:), INTENT(IN) :: PGSNOW_ROAD ! road snow conduction
130 ! ! heat fluxes at mantel
131 ! ! base
132 REAL, DIMENSION(:), INTENT(IN) :: PQ_LOWCAN ! and specific humidity
133 REAL, DIMENSION(:), INTENT(IN) :: PT_LOWCAN ! low canyon air temperature
134 REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_A ! wall surface temperature
135 REAL, DIMENSION(:), INTENT(IN) :: PTS_WALL_B ! wall surface temperature
136 REAL, DIMENSION(:), INTENT(IN) :: PTSNOW_ROAD ! road snow temperature
137 REAL, DIMENSION(:), INTENT(IN) :: PTS_GARDEN ! green area surface temperature
138 !
139 REAL, DIMENSION(:), INTENT(IN) :: PLW_WA_TO_R ! LW interactions wall -> road
140 REAL, DIMENSION(:), INTENT(IN) :: PLW_WB_TO_R ! LW interactions wall -> road
141 REAL, DIMENSION(:), INTENT(IN) :: PLW_S_TO_R ! LW interactions sky -> road
142 REAL, DIMENSION(:), INTENT(IN) :: PLW_WIN_TO_R ! LW interactions window -> road
143 !
144 REAL, DIMENSION(:), INTENT(OUT) :: PEMIT_LW_ROAD! LW flux emitted by the road (W/m2 of road)
145 REAL, DIMENSION(:), INTENT(OUT) :: PDQS_ROAD !heat storage inside the road
146 REAL, DIMENSION(:), INTENT(OUT) :: PABS_LW_ROAD ! absorbed infrared rad.
147 REAL, DIMENSION(:), INTENT(OUT) :: PHFREE_ROAD ! sensible heat flux on the
148  ! snow free part of the road [W m-2]
149 REAL, DIMENSION(:), INTENT(OUT) :: PLEFREE_ROAD ! latent heat flux on the
150  ! snow free part of the road [W m-2]
151 REAL, DIMENSION(:), INTENT(OUT) :: PIMB_ROAD ! road residual energy imbalance
152  ! for verification [W m-2]
153 REAL, DIMENSION(:), INTENT(IN) :: PRR ! rain rate [kg m-2 s-1]
154 
155 !
156 !* 0.2 declarations of local variables
157 !
158 REAL :: ZIMPL=1.0 ! implicit coefficient
159 REAL :: ZEXPL=0.0 ! explicit coefficient
160 !
161 REAL, DIMENSION(SIZE(T%XT_ROAD,1),SIZE(T%XT_ROAD,2)) :: ZA,& ! lower diag.
162  ZB,& ! main diag.
163  ZC,& ! upper diag.
164  ZY ! r.h.s.
165 !
166 REAL, DIMENSION(SIZE(PPS)) :: ZDN_ROAD ! snow-covered surface fraction on road
167 REAL, DIMENSION(SIZE(PPS)) :: ZDF_ROAD ! snow-free surface fraction on road
168 !
169 REAL, DIMENSION(SIZE(PPS)) :: ZDQSAT_ROAD ! dq_sat/dTs
170 REAL, DIMENSION(SIZE(PPS)) :: ZRHO_ACF_R ! rho * conductance
171 ! ! * snow-free f.
172 REAL, DIMENSION(SIZE(PPS)) :: ZRHO_ACF_R_WAT ! rho * conductance for water
173 ! ! * snow-free f.
174 ! thermal capacity times layer depth
175 REAL, DIMENSION(SIZE(PPS)) :: ZTS_ROAD ! road surface temperature
176 REAL, DIMENSION(SIZE(PPS)) :: ZHEAT_RR ! heat used too cool/heat the rain from the roof
177 REAL, DIMENSION(SIZE(PPS)) :: ZT_SKY ! road surface temperature
178 !
179 INTEGER :: IROAD_LAYER ! number of road layers
180 INTEGER :: JJ ! loop counter
181 REAL(KIND=JPRB) :: ZHOOK_HANDLE
182 !-------------------------------------------------------------------------------
183 IF (lhook) CALL dr_hook('ROAD_LAYER_E_BUDGET',0,zhook_handle)
184 !
185  CALL layer_e_budget_get_coef( t%XT_ROAD, ptstep, zimpl, t%XHC_ROAD, t%XTC_ROAD, t%XD_ROAD, &
186  za, zb, zc, zy )
187 !
188 !* 1. Layer thermal properties
189 ! ------------------------
190 !
191 iroad_layer = SIZE(t%XT_ROAD,2)
192 !
193 DO jj=1, SIZE(pdn_road)
194  !
195  zdn_road(jj) = pdn_road(jj)
196  zdf_road(jj) = 1. - zdn_road(jj)
197  !
198  !* 2.3 Surface temperatures
199  ! --------------------
200  !
201  zts_road(jj) = t%XT_ROAD(jj,1)
202  !
203  !* 2.2 flux properties
204  ! ---------------
205  !
206  zrho_acf_r(jj) = prhoa(jj) * pac_road(jj) * zdf_road(jj)
207  zrho_acf_r_wat(jj) = prhoa(jj) * pac_road_wat(jj) * zdf_road(jj)
208  !
209  !* 2.4 Sky temperature
210  ! ---------------
211  !
212  zt_sky(jj) = (plw_rad(jj)/xstefan)**0.25
213  !
214 ENDDO
215 !
216 !* 2.4 qsat, dqsat/dTs, and humidity for roads
217 ! ---------------------------------------
218 !
219 zdqsat_road(:) = dqsat(zts_road(:),pps(:),pqsat_road(:))
220 !
221 !-------------------------------------------------------------------------------
222 !
223 !* 3. First road layers coefficients (in contact with outdoor env.)
224 ! -------------------------------------------------------------
225 !
226 DO jj=1,SIZE(t%XT_ROAD,1)
227  !
228  zb(jj,1) = zb(jj,1) + zimpl * xcpd/pexns(jj) * zrho_acf_r(jj) &
229  + zimpl * xlvtt * zrho_acf_r_wat(jj) * pdelt_road(jj) * zdqsat_road(jj)
230  !
231  zy(jj,1) = zy(jj,1) &
232  + xcpd/pexns(jj) * zrho_acf_r(jj) * ( pt_lowcan(jj) - zexpl * zts_road(jj) ) &
233  + zdf_road(jj)*pabs_sw_road(jj) + zdn_road(jj)*pgsnow_road(jj) &
234  + xlvtt * zrho_acf_r_wat(jj) * pdelt_road(jj) &
235  * ( pq_lowcan(jj) - pqsat_road(jj) + zimpl * zdqsat_road(jj) * zts_road(jj) )
236  !
237  zb(jj,1) = zb(jj,1) &
238  + zimpl * zdf_road(jj) * ( plw_s_to_r(jj) + plw_wa_to_r(jj) + &
239  plw_wb_to_r(jj) + plw_win_to_r(jj) + &
240  prr(jj) * xcl ) ! heat/cool rain
241  !
242  zy(jj,1) = zy(jj,1) &
243  + zdf_road(jj) * ( &
244  plw_s_to_r(jj) * (zt_sky(jj) - zexpl * zts_road(jj)) &
245  + plw_win_to_r(jj) * (b%XT_WIN1 (jj) - zexpl * zts_road(jj)) &
246  + plw_wa_to_r(jj) * (pts_wall_a(jj) - zexpl * zts_road(jj)) &
247  + plw_wb_to_r(jj) * (pts_wall_b(jj) - zexpl * zts_road(jj)) &
248  + prr(jj) * xcl * (pt_lowcan(jj) - zexpl * zts_road(jj) )) !heat/cool rain
249  !
250 ENDDO
251 !
252 !
253  CALL layer_e_budget( t%XT_ROAD, ptstep, zimpl, t%XHC_ROAD, t%XTC_ROAD, t%XD_ROAD, &
254  za, zb, zc, zy, pdqs_road )
255 !
256 !-------------------------------------------------------------------------------
257 !
258 !* 12. Road and wall absorbed infra-red radiation on snow-free surfaces
259 ! ----------------------------------------------------------------
260 !
261 !* absorbed LW
262 DO jj=1,SIZE(t%XT_ROAD,1)
263  !
264  ! surface temperature used in energy balance
265  zts_road(jj) = zexpl * zts_road(jj) + zimpl * t%XT_ROAD(jj,1)
266  pabs_lw_road(jj) = plw_s_to_r(jj) * (zt_sky(jj) - zts_road(jj)) + &
267  plw_wa_to_r(jj) * (pts_wall_a(jj) - zts_road(jj)) + &
268  plw_wb_to_r(jj) * (pts_wall_b(jj) - zts_road(jj)) + &
269  plw_win_to_r(jj) * (b%XT_WIN1(jj) - zts_road(jj))
270  !
271  !* 9. Road emitted LW radiation on snow-free surfaces
272  ! -----------------------------------------------
273  pemit_lw_road(jj) = xstefan * t%XT_ROAD(jj,1)**4 + &
274  (1 - t%XEMIS_ROAD(jj))/t%XEMIS_ROAD(jj) * pabs_lw_road(jj)
275  !
276  !* 10. road and wall sensible heat flux
277  ! --------------------------------
278  !
279  phfree_road(jj) = zrho_acf_r(jj) * xcpd/pexns(jj) * &
280  ( zimpl*t%XT_ROAD(jj,1) + zexpl*zts_road(jj) - pt_lowcan(jj) )
281  !
282  !* 11 road latent heat flux
283  ! ---------------------
284  !
285  plefree_road(jj) = zrho_acf_r_wat(jj) * xlvtt * pdelt_road(jj) * &
286  ( pqsat_road(jj) - pq_lowcan(jj) + &
287  zimpl * zdqsat_road(jj) * (t%XT_ROAD(jj,1) - zts_road(jj)) )
288  zheat_rr(jj) = prr(jj) * xcl * (zts_road(jj) - pt_lowcan(jj))
289  !
290  !* 12 heat storage inside roads
291  ! -------------------------
292  !
293  !* 13 road energy residual imbalance for verification
294  ! -----------------------------------------------
295  !
296  pimb_road(jj) = pabs_sw_road(jj) + pabs_lw_road(jj) - pdqs_road(jj) &
297  - zdf_road(jj) * ( phfree_road(jj) + plefree_road(jj)) &
298  - zdn_road(jj) * pgsnow_road(jj)
299  !
300 ENDDO
301 !
302 !-------------------------------------------------------------------------------
303 IF (lhook) CALL dr_hook('ROAD_LAYER_E_BUDGET',1,zhook_handle)
304 !
305 END SUBROUTINE road_layer_e_budget
306 
real, save xcpd
Definition: modd_csts.F90:63
real, save xstefan
Definition: modd_csts.F90:59
real, save xlvtt
Definition: modd_csts.F90:70
integer, parameter jprb
Definition: parkind1.F90:32
subroutine layer_e_budget(PT, PTSTEP, PIMPL, PHC, PTC, PD, PA, PB, PC, PY, PDQS)
real, save xcl
Definition: modd_csts.F90:65
logical lhook
Definition: yomhook.F90:15
subroutine layer_e_budget_get_coef(PT, PTSTEP, PIMPL, PHC, PTC, PD, PA, PB, PC, PY)
subroutine road_layer_e_budget(T, B, PTSTEP, PDN_ROAD, PRHOA, PAC_ROAD, PAC_ROAD_WAT, PLW_RAD, PPS, PQSAT_ROAD, PDELT_ROAD, PEXNS, PABS_SW_ROAD, PGSNOW_ROAD, PQ_LOWCAN, PT_LOWCAN, PTS_WALL_A, PTS_WALL_B, PTSNOW_ROAD, PTS_GARDEN, PLW_WA_TO_R, PLW_WB_TO_R, PLW_S_TO_R, PLW_WIN_TO_R, PEMIT_LW_ROAD, PDQS_ROAD, PABS_LW_ROAD, PHFREE_ROAD, PLEFREE_ROAD, PIMB_ROAD, PRR)