SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
coupling_isba_canopyn.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 coupling_isba_canopy_n (DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, &
7  hprogram, hcoupling, &
8  ptstep, kyear, kmonth, kday, ptime, ki, ksv, ksw, ptsun, pzenith, pzenith2, &
9  pazim, pzref, puref, pzs, pu, pv, pqa, pta, prhoa, psv, pco2, hsv, &
10  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, ppa, &
11  psftq, psfth, psfts, psfco2, psfu, psfv, &
12  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
13  ppew_a_coef, ppew_b_coef, &
14  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
15  htest )
16 ! ###############################################################################
17 !
18 !!**** *COUPLING_ISBA_CANOPY_n * - Adds a SBL into ISBA
19 !!
20 !! PURPOSE
21 !! -------
22 !
23 !!** METHOD
24 !! ------
25 !!
26 !! REFERENCE
27 !! ---------
28 !!
29 !!
30 !! AUTHOR
31 !! ------
32 !! V. Masson
33 !!
34 !! MODIFICATIONS
35 !! -------------
36 !! Original 09/2007
37 !! S. Riette 06/2009 Initialisation of XT, XQ, XU and XTKE on canopy levels
38 !! S. Riette 01/2010 Use of interpol_sbl to compute 10m wind diagnostic
39 !! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI
40 !! B. Decharme 04/2013 new coupling variables
41 !----------------------------------------------------------------
42 !
43 !
44 USE modd_surfex_n, ONLY : isba_model_t
45 !
46 USE modd_data_cover_n, ONLY : data_cover_t
47 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
48 USE modd_surf_atm_n, ONLY : surf_atm_t
49 USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
50 USE modd_data_teb_garden_n, ONLY : data_teb_garden_t
51 USE modd_data_teb_greenroof_n, ONLY : data_teb_greenroof_t
52 USE modd_teb_greenroof_option_n, ONLY : teb_greenroof_options_t
53 USE modd_dst_n, ONLY : dst_t
54 USE modd_slt_n, ONLY : slt_t
55 !
56 !
57 USE modd_csts, ONLY : xcpd
58 USE modd_surf_par, ONLY : xundef
59 USE modd_canopy_turb, ONLY : xalpsbl
60 !
61 USE mode_coupling_canopy
62 !
63 USE modi_init_isba_sbl
64 !
65 USE modi_canopy_evol
66 USE modi_canopy_grid_update
67 !
68 USE modi_coupling_isba_n
69 !
70 USE modi_isba_canopy
71 USE modi_sso_beljaars04
72 !
73 USE yomhook ,ONLY : lhook, dr_hook
74 USE parkind1 ,ONLY : jprb
75 !
76 IMPLICIT NONE
77 !
78 !* 0.1 declarations of arguments
79 !
80 !
81 TYPE(isba_model_t), INTENT(INOUT) :: im
82 TYPE(data_cover_t), INTENT(INOUT) :: dtco
83 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
84 TYPE(surf_atm_t), INTENT(INOUT) :: u
85 TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
86 TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
87 TYPE(data_teb_greenroof_t), INTENT(INOUT) :: dtgr
88 TYPE(teb_greenroof_options_t), INTENT(INOUT) :: tgro
89 TYPE(dst_t), INTENT(INOUT) :: dst
90 TYPE(slt_t), INTENT(INOUT) :: slt
91 !
92  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling surf. schemes
93  CHARACTER(LEN=1), INTENT(IN) :: hcoupling ! type of coupling
94  ! 'E' : explicit
95  ! 'I' : implicit
96 INTEGER, INTENT(IN) :: kyear ! current year (UTC)
97 INTEGER, INTENT(IN) :: kmonth ! current month (UTC)
98 INTEGER, INTENT(IN) :: kday ! current day (UTC)
99 REAL, INTENT(IN) :: ptime ! current time since midnight (UTC, s)
100 INTEGER, INTENT(IN) :: ki ! number of points
101 INTEGER, INTENT(IN) :: ksv ! number of scalars
102 INTEGER, INTENT(IN) :: ksw ! number of short-wave spectral bands
103 REAL, DIMENSION(KI), INTENT(IN) :: ptsun ! solar time (s from midnight)
104 REAL, INTENT(IN) :: ptstep ! atmospheric time-step (s)
105 REAL, DIMENSION(KI), INTENT(IN) :: pzref ! height of T,q forcing (m)
106 REAL, DIMENSION(KI), INTENT(IN) :: puref ! height of wind forcing (m)
107 !
108 REAL, DIMENSION(KI), INTENT(IN) :: pta ! air temperature forcing (K)
109 REAL, DIMENSION(KI), INTENT(IN) :: pqa ! air humidity forcing (kg/m3)
110 REAL, DIMENSION(KI), INTENT(IN) :: prhoa ! air density (kg/m3)
111 REAL, DIMENSION(KI,KSV),INTENT(IN) :: psv ! scalar variables
112 ! ! chemistry: first char. in HSV: '#' (molecule/m3)
113 ! !
114  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: hsv ! name of all scalar variables
115 REAL, DIMENSION(KI), INTENT(IN) :: pu ! zonal wind (m/s)
116 REAL, DIMENSION(KI), INTENT(IN) :: pv ! meridian wind (m/s)
117 REAL, DIMENSION(KI,KSW),INTENT(IN) :: pdir_sw ! direct solar radiation (on horizontal surf.)
118 ! ! (W/m2)
119 REAL, DIMENSION(KI,KSW),INTENT(IN) :: psca_sw ! diffuse solar radiation (on horizontal surf.)
120 ! ! (W/m2)
121 REAL, DIMENSION(KSW),INTENT(IN) :: psw_bands ! mean wavelength of each shortwave band (m)
122 REAL, DIMENSION(KI), INTENT(IN) :: pzenith ! zenithal angle at t (radian from the vertical)
123 REAL, DIMENSION(KI), INTENT(IN) :: pzenith2 ! zenithal angle at t+1 (radian from the vertical)
124 REAL, DIMENSION(KI), INTENT(IN) :: pazim ! azimuthal angle (radian from North, clockwise)
125 REAL, DIMENSION(KI), INTENT(IN) :: plw ! longwave radiation (on horizontal surf.)
126 ! ! (W/m2)
127 REAL, DIMENSION(KI), INTENT(IN) :: pps ! pressure at atmospheric model surface (Pa)
128 REAL, DIMENSION(KI), INTENT(IN) :: ppa ! pressure at forcing level (Pa)
129 REAL, DIMENSION(KI), INTENT(IN) :: pzs ! atmospheric model CANOPY (m)
130 REAL, DIMENSION(KI), INTENT(IN) :: pco2 ! CO2 concentration in the air (kg/m3)
131 REAL, DIMENSION(KI), INTENT(IN) :: psnow ! snow precipitation (kg/m2/s)
132 REAL, DIMENSION(KI), INTENT(IN) :: prain ! liquid precipitation (kg/m2/s)
133 !
134 !
135 REAL, DIMENSION(KI), INTENT(OUT) :: psfth ! flux of heat (W/m2)
136 REAL, DIMENSION(KI), INTENT(OUT) :: psftq ! flux of water vapor (kg/m2/s)
137 REAL, DIMENSION(KI), INTENT(OUT) :: psfu ! zonal momentum flux (Pa)
138 REAL, DIMENSION(KI), INTENT(OUT) :: psfv ! meridian momentum flux (Pa)
139 REAL, DIMENSION(KI), INTENT(OUT) :: psfco2 ! flux of CO2 (m/s*kg_CO2/kg_air)
140 REAL, DIMENSION(KI,KSV),INTENT(OUT):: psfts ! flux of scalar var. (kg/m2/s)
141 !
142 REAL, DIMENSION(KI), INTENT(OUT) :: ptrad ! radiative temperature (K)
143 REAL, DIMENSION(KI,KSW),INTENT(OUT):: pdir_alb! direct albedo for each spectral band (-)
144 REAL, DIMENSION(KI,KSW),INTENT(OUT):: psca_alb! diffuse albedo for each spectral band (-)
145 REAL, DIMENSION(KI), INTENT(OUT) :: pemis ! emissivity (-)
146 !
147 REAL, DIMENSION(KI), INTENT(OUT) :: ptsurf ! surface effective temperature (K)
148 REAL, DIMENSION(KI), INTENT(OUT) :: pz0 ! roughness length for momentum (m)
149 REAL, DIMENSION(KI), INTENT(OUT) :: pz0h ! roughness length for heat (m)
150 REAL, DIMENSION(KI), INTENT(OUT) :: pqsurf ! specific humidity at surface (kg/kg)
151 !
152 REAL, DIMENSION(KI), INTENT(IN) :: ppew_a_coef! implicit coefficients
153 REAL, DIMENSION(KI), INTENT(IN) :: ppew_b_coef! needed if HCOUPLING='I'
154 REAL, DIMENSION(KI), INTENT(IN) :: ppet_a_coef
155 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_a_coef
156 REAL, DIMENSION(KI), INTENT(IN) :: ppet_b_coef
157 REAL, DIMENSION(KI), INTENT(IN) :: ppeq_b_coef
158  CHARACTER(LEN=2), INTENT(IN) :: htest ! must be equal to 'OK'
159 !
160 !* 0.2 declarations of local variables
161 !
162 !* forcing variables
163 !
164 REAL, DIMENSION(KI) :: zwind ! lowest atmospheric level wind speed (m/s)
165 REAL, DIMENSION(KI) :: zexna ! Exner function at lowest SBL scheme level (-)
166 REAL, DIMENSION(KI) :: zta ! temperature (K)
167 REAL, DIMENSION(KI) :: zpa ! pressure (Pa)
168 REAL, DIMENSION(KI) :: zzref ! temperature forcing level (m)
169 REAL, DIMENSION(KI) :: zuref ! wind forcing level (m)
170 REAL, DIMENSION(KI) :: zu ! zonal wind (m/s)
171 REAL, DIMENSION(KI) :: zv ! meridian wind (m/s)
172 REAL, DIMENSION(KI) :: zqa ! specific humidity (kg/m3)
173 REAL, DIMENSION(KI) :: zpeq_a_coef ! specific humidity implicit
174 REAL, DIMENSION(KI) :: zpeq_b_coef ! coefficients (hum. in kg/kg)
175 !
176 !
177 ! canopy turbulence scheme
178 !
179 REAL, DIMENSION(KI) :: zcanopy ! height of canopy (m)
180 REAL, DIMENSION(KI) :: zsflux_u ! Surface flux u'w' (m2/s2)
181 REAL, DIMENSION(KI) :: zsflux_t ! Surface flux w'T' (mK/s)
182 REAL, DIMENSION(KI) :: zsflux_q ! Surface flux w'q' (kgm2/s)
183 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zforc_u ! tendency due to drag force for wind
184 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zdforc_udu! formal derivative of
185 ! ! tendency due to drag force for wind
186 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zforc_e ! tendency due to drag force for TKE
187 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zdforc_ede! formal derivative of
188 ! ! tendency due to drag force for TKE
189 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zforc_t ! tendency due to drag force for Temp
190 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zdforc_tdt! formal derivative of
191 ! ! tendency due to drag force for Temp
192 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zforc_q ! tendency due to drag force for Temp
193 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zdforc_qdq! formal derivative of
194 ! ! tendency due to drag force for hum.
195 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zlmo ! MO length
196 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zlm ! mixing length
197 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zleps ! dissipative length
198 REAL, DIMENSION(KI) :: zh ! canopy height (m)
199 REAL, DIMENSION(KI) :: zustar ! friction velocity including drag effect (m/s)
200 REAL, DIMENSION(KI) :: zustar_ground! friction velocity at ground only (ISBA) (m/s)
201 !
202 REAL, DIMENSION(KI) :: zpet_a_coef ! temperature implicit
203 REAL, DIMENSION(KI) :: zpet_b_coef ! coefficients (K)
204 REAL, DIMENSION(KI) :: zpew_a_coef ! wind implicit
205 REAL, DIMENSION(KI) :: zpew_b_coef ! coefficients (m/s)
206 !
207 REAL, DIMENSION(KI) :: zalfau ! V+(1) = - alfa rho u'w'(1) + beta
208 REAL, DIMENSION(KI) :: zbetau ! V+(1) = - alfa rho u'w'(1) + beta
209 REAL, DIMENSION(KI) :: zalfath ! Th+(1) = - alfa rho w'th'(1) + beta
210 REAL, DIMENSION(KI) :: zbetath ! Th+(1) = - alfa rho w'th'(1) + beta
211 REAL, DIMENSION(KI) :: zalfaq ! Q+(1) = - alfa rho w'q'(1) + beta
212 REAL, DIMENSION(KI) :: zbetaq ! Q+(1) = - alfa rho w'q'(1) + beta
213 !
214  CHARACTER(LEN=1) :: gcoupling
215 !
216 REAL, DIMENSION(KI) ::zcanopy_density
217 REAL, DIMENSION(KI) ::zuw_ground
218 REAL, DIMENSION(KI) ::zduwdu_ground
219 !
220 REAL, DIMENSION(KI,IM%ICP%NLVL) :: zz ! height above displacement height
221 !
222 INTEGER :: jj
223 REAL(KIND=JPRB) :: zhook_handle
224 
225 !-------------------------------------------------------------------------------------
226 !
227 !
228 !* 1. Preliminary computations of the SBL scheme
229 ! ------------------------------------------
230 !
231 IF (lhook) CALL dr_hook('COUPLING_ISBA_CANOPY_N',0,zhook_handle)
232 IF (im%I%LCANOPY) THEN
233 !
234 !* 1.1 Updates canopy vertical grid as a function of forcing height
235 ! ------------------------------------------------------------
236 !
237 !* determines where is the forcing level and modifies the upper levels of the canopy grid
238 !
239  zcanopy = 0.
240  CALL canopy_grid_update(ki,im%ICP%NLVL,zcanopy,puref,im%ICP%XZ,im%ICP%XZF,im%ICP%XDZ,im%ICP%XDZF)
241 !
242 !
243 !
244 !* 1.2 Allocations and initialisations
245 ! -------------------------------
246 !
247 !
248 ! 1.2.1 First time step canopy initialisation
249 !
250  IF(any(im%ICP%XT(:,:) == xundef)) THEN
251  CALL init_isba_sbl(im%I%CISBA, im%I%CCPSURF, im%ICP%NLVL, ptstep, ppa, pps, pta, pqa, prhoa, pu, pv, &
252  pdir_sw, psca_sw, psw_bands, prain, psnow, &
253  pzref, puref, im%I%XTG(:,1,:), im%I%XPATCH, im%I%XWG(:,1,:), im%I%XWGI(:,1,:), &
254  im%I%XZ0, im%I%XSSO_SLOPE, im%I%XRESA, im%I%XVEG, im%I%XLAI, &
255  im%I%XWR, im%I%XRGL, im%I%XRSMIN, im%I%XGAMMA, im%I%XWRMAX_CF, im%I%XZ0_O_Z0H, &
256  im%I%XWFC, im%I%XWSAT, im%I%TSNOW, im%ICP%XZ, &
257  im%ICP%XT, im%ICP%XQ, im%ICP%XU, im%ICP%XTKE, im%ICP%XP)
258  ENDIF
259 !
260 !* 1.3 Allocations
261 ! -----------
262 !
263  CALL init_forc( zforc_u, zdforc_udu, zforc_e, zdforc_ede, &
264  zforc_t, zdforc_tdt, zforc_q, zdforc_qdq )
265 !
266  zsflux_u = 0.
267  zsflux_t = 0.
268  zsflux_q = 0.
269 !
270  zlmo = spread(im%ICP%XLMO,2,im%ICP%NLVL)
271 !
272 !* default :
273 !* no canopy in ISBA scheme
274 !
275  zh = 0.
276 !
277 !
278 !* determine for each level the height above displacement height
279 !
280  zz(:,:) = im%ICP%XZ(:,:)
281 !
282 !* 1.4 canopy for wind drag only
283 ! -------------------------
284 !
285  IF (im%I%LCANOPY_DRAG) THEN
286 !* mean canopy height
287 !
288 !* in ecoclimap, height is set retrieved from roughness length (z0/0.13)
289  DO jj=1,ki
290  zh(jj) = sum(im%I%XPATCH(jj,:)*im%I%XZ0(jj,:)/0.13)
291  zh(jj) = min(zh(jj), im%ICP%XZF(jj,im%ICP%NLVL))
292  IF (zh(jj)<=im%ICP%XDZ(jj,1)) zh(jj) = 0.
293 !
294 !* canopy for wind drag only
295  zcanopy_density(jj) = sum(im%I%XPATCH(jj,:)*im%I%XLAI(jj,:))
296  zuw_ground(jj) = 0.
297  zduwdu_ground(jj) = 0.
298  !
299  ENDDO
300 !
301 !* computes tendencies on wind and Tke due to canopy
302  CALL isba_canopy(im%I, &
303  ki,im%ICP%NLVL,im%ICP%XZ,im%ICP%XZF,im%ICP%XDZ,im%ICP%XDZF,&
304  zh,zcanopy_density,im%ICP%XU,im%ICP%XTKE, &
305  zuw_ground, zduwdu_ground, &
306  zforc_u,zdforc_udu,zforc_e,zdforc_ede )
307 !
308  ENDIF
309 !
310 !* 1.4 Subgrid-scale orographic drag (Beljaars et al 2004)
311 ! -----------------------------
312 !
313  IF (im%I%CROUGH=='BE04') THEN
314 !
315 !* computes tendencies on wind and Tke due to subgridscale orography
316  CALL sso_beljaars04(uss, &
317  ki,im%ICP%NLVL,im%ICP%XZ,im%I%XSSO_STDEV,im%ICP%XU,zforc_u,zdforc_udu )
318 !
319  ENDIF
320 !
321 !
322 !* 1.5 Computes coefficients for implicitation
323 ! ---------------------------------------
324 !
325  zwind = sqrt(pu**2+pv**2)
326  CALL canopy_evol(ki,im%ICP%NLVL,ptstep,1,zz,zwind,pta,pqa,ppa,prhoa, &
327  zsflux_u,zsflux_t,zsflux_q, &
328  zforc_u,zdforc_udu,zforc_e,zdforc_ede, &
329  zforc_t,zdforc_tdt,zforc_q,zdforc_qdq, &
330  im%ICP%XZ,im%ICP%XZF,im%ICP%XDZ,im%ICP%XDZF,im%ICP%XU,&
331  im%ICP%XTKE,im%ICP%XT,im%ICP%XQ,zlmo,zlm,zleps,im%ICP%XP,zustar, &
332  zalfau,zbetau,zalfath,zbetath,zalfaq,zbetaq )
333 !
334 !* 1.6 Goes from atmospheric forcing to canopy forcing height
335 ! ------------------------------------------------------
336 !
337  gcoupling ='I'
338 !
339  CALL init_coupling_canopy( im%ICP%XP(:,1), ppa, im%ICP%XT(:,1), im%ICP%XQ(:,1), &
340  pu, pv, im%ICP%XZ(:,1), im%ICP%XU(:,1), &
341  prhoa, zalfau, zbetau, zalfath, &
342  zbetath, zalfaq, zbetaq, &
343  zpa, zta, zqa, zu, zv, &
344  zuref, zzref, zexna, &
345  zpew_a_coef, zpew_b_coef, &
346  zpet_a_coef, zpet_b_coef, &
347  zpeq_a_coef, zpeq_b_coef )
348 !
349 !-------------------------------------------------------------------------------------
350 ELSE
351 !-------------------------------------------------------------------------------------
352 !
353 !* 2. If no canopy scheme is used, forcing is not modified
354 ! ----------------------------------------------------
355 !
356  gcoupling = hcoupling
357 !
358  CALL init_coupling( hcoupling, &
359  pps, ppa, pta, pqa, pu, pv, &
360  puref, pzref, &
361  ppew_a_coef, ppew_b_coef, &
362  ppet_a_coef, ppet_b_coef, &
363  ppeq_a_coef, ppeq_b_coef, &
364  zpa, zta, zqa, zu, zv, &
365  zuref, zzref, &
366  zpew_a_coef, zpew_b_coef, &
367  zpet_a_coef, zpet_b_coef, &
368  zpeq_a_coef, zpeq_b_coef )
369 !
370 END IF
371 !
372 !-------------------------------------------------------------------------------------
373 !
374 !* 2. Call of ISBA
375 ! ------------
376 !
377  CALL coupling_isba_n(dtco, ug, u, uss, im, dtgd, dtgr, tgro, dst, slt, &
378  hprogram, gcoupling, &
379  ptstep, kyear, kmonth, kday, ptime, &
380  ki, ksv, ksw, &
381  ptsun, pzenith, pzenith2, &
382  zzref, zuref, pzs, zu, zv, zqa, zta, prhoa, psv, pco2, hsv, &
383  prain, psnow, plw, pdir_sw, psca_sw, psw_bands, pps, zpa, &
384  psftq, psfth, psfts, psfco2, psfu, psfv, &
385  ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0, pz0h, pqsurf, &
386  zpew_a_coef, zpew_b_coef, &
387  zpet_a_coef, zpeq_a_coef, zpet_b_coef, zpeq_b_coef, &
388  'OK' )
389 !
390 !-------------------------------------------------------------------------------------
391 !
392 !* 3. End if no canopy is used
393 ! ------------------------
394 !
395 IF (.NOT. im%I%LCANOPY .AND. lhook) CALL dr_hook('COUPLING_ISBA_CANOPY_N',1,zhook_handle)
396 IF (.NOT. im%I%LCANOPY) RETURN
397 !
398 !-------------------------------------------------------------------------------------
399 !
400 !* 4. Computes the impact of surface on air
401 ! -------------------------------------
402 !
403  CALL init_forc( zforc_u, zdforc_udu, zforc_e, zdforc_ede, &
404  zforc_t, zdforc_tdt, zforc_q, zdforc_qdq )
405 !
406 zsflux_u = - sqrt(psfu(:)**2+psfv(:)**2) / prhoa(:)
407 zsflux_t(:) = psfth(:) / xcpd * zexna(:) / prhoa(:)
408 zsflux_q(:) = psftq(:)
409 !
410 !-------------------------------------------------------------------------------------
411 !
412 !* 5. Computes the impact of canopy on air
413 ! ------------------------------------
414 !
415 IF (im%I%LCANOPY_DRAG) THEN
416 !
417  DO jj=1,ki
418  zuw_ground(jj) = -sqrt(psfu(jj)**2+psfv(jj)**2)/ prhoa(jj)
419  zduwdu_ground(jj) = 0.
420  IF (im%ICP%XU(jj,1) /=0.) zduwdu_ground(jj) = 2. * zuw_ground(jj) / im%ICP%XU(jj,1)
421  ENDDO
422 
423 !* computes tendencies on wind and Tke due to canopy and surface
424  CALL isba_canopy(im%I, &
425  ki,im%ICP%NLVL,im%ICP%XZ,im%ICP%XZF,im%ICP%XDZ,im%ICP%XDZF,&
426  zh,zcanopy_density,im%ICP%XU,im%ICP%XTKE, &
427  zuw_ground, zduwdu_ground, &
428  zforc_u,zdforc_udu,zforc_e,zdforc_ede )
429 
430  zsflux_u = 0. ! surface friction is incorporated in ZFORC_U by ISBA_CANOPY routine
431 !
432 END IF
433 !
434 !
435 IF (im%I%CROUGH=='BE04') THEN
436 !
437 !* computes tendencies on wind and Tke due to subgridscale orography
438  CALL sso_beljaars04(uss, &
439  ki,im%ICP%NLVL,im%ICP%XZ,im%I%XSSO_STDEV,im%ICP%XU,zforc_u,zdforc_udu )
440 !
441 ENDIF
442 !
443 !-------------------------------------------------------------------------------------
444 !
445 !* 6. Evolution of canopy air due to these impacts
446 ! --------------------------------------------
447 !
448 zwind = sqrt(pu**2+pv**2)
449  CALL canopy_evol(ki,im%ICP%NLVL,ptstep,2,zz,zwind,pta,pqa,ppa,prhoa, &
450  zsflux_u,zsflux_t,zsflux_q, &
451  zforc_u,zdforc_udu,zforc_e,zdforc_ede, &
452  zforc_t,zdforc_tdt,zforc_q,zdforc_qdq, &
453  im%ICP%XZ,im%ICP%XZF,im%ICP%XDZ,im%ICP%XDZF,im%ICP%XU,im%ICP%XTKE,&
454  im%ICP%XT,im%ICP%XQ,zlmo,zlm,zleps,im%ICP%XP,zustar, &
455  zalfau,zbetau,zalfath,zbetath,zalfaq,zbetaq )
456 !
457 im%ICP%XLMO(:) = zlmo(:,im%ICP%NLVL)
458 !
459 ! Momentum fluxes if canopy is used
460 !
461 !* Total friction due to surface averaged friction and averaged canopy drag
462 IF (im%I%LCANOPY_DRAG .OR. im%I%CROUGH=='BE04') THEN
463  DO jj=1,ki
464  zustar_ground(jj) = sqrt(sqrt(psfu(jj)**2+psfv(jj)**2)/prhoa(jj))
465  IF (zustar_ground(jj)>0.) THEN
466  psfu(jj) = psfu(jj) * zustar(jj)**2/zustar_ground(jj)**2
467  psfv(jj) = psfv(jj) * zustar(jj)**2/zustar_ground(jj)**2
468  ENDIF
469  ENDDO
470 !* Total friction due to surface averaged friction and averaged canopy drag
471  IF (im%DGI%LSURF_BUDGET) THEN
472  im%DGI%XAVG_FMU = psfu
473  im%DGI%XAVG_FMV = psfv
474  ENDIF
475 END IF
476 !
477 !-------------------------------------------------------------------------------------
478 !
479 !* 7. 2m and 10m diagnostics if canopy is used
480 ! ----------------------------------------
481 !
482 !
483 IF (im%DGI%N2M>=1) CALL init_2m_10m( im%ICP%XP(:,2), im%ICP%XT(:,2), im%ICP%XQ(:,2), im%ICP%XU, im%ICP%XZ, &
484  pu, pv, zwind, prhoa, &
485  im%DGI%XAVG_T2M, im%DGI%XAVG_Q2M, im%DGI%XAVG_HU2M, &
486  im%DGI%XAVG_ZON10M, im%DGI%XAVG_MER10M, &
487  im%DGI%XAVG_WIND10M, im%DGI%XAVG_WIND10M_MAX, im%DGI%XAVG_T2M_MIN, &
488  im%DGI%XAVG_T2M_MAX, im%DGI%XAVG_HU2M_MIN, im%DGI%XAVG_HU2M_MAX )
489 !
490 IF (lhook) CALL dr_hook('COUPLING_ISBA_CANOPY_N',1,zhook_handle)
491 !
492 !-------------------------------------------------------------------------------------
493 !
494 END SUBROUTINE coupling_isba_canopy_n
modd_slt_n
Definition: modd_sltn.F90:5
modd_surf_atm_sso_n::surf_atm_sso_t
Definition: modd_surf_atm_sson.F90:40
modd_data_teb_greenroof_n::data_teb_greenroof_t
Definition: modd_data_teb_greenroofn.F90:40
modd_slt_n::slt_t
Definition: modd_sltn.F90:18
mode_coupling_canopy::init_coupling_canopy
subroutine init_coupling_canopy(PP, PPA, PT, PQ, PU, PV, PZ, PXU, PRHOA, PALFAU, PBETAU, PALFATH, PBETATH, PALFAQ, PBETAQ, PPPA, PTTA, PQQA, PUU, PVV, PUUREF, PZZREF, PEXNA, PPEW_AA_COEF, PPEW_BB_COEF, PPET_AA_COEF, PPET_BB_COEF, PPEQ_AA_COEF, PPEQ_BB_COEF)
Definition: mode_coupling_canopy.F90:51
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
sso_beljaars04
subroutine sso_beljaars04(USS, KI, KLVL, PZ, PSSO_STDEV, PU, PFORC_U, PDFORC_UDU)
Definition: sso_beljaars04.F90:6
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_surfex_n
Definition: modd_surfexn.F90:5
modd_data_cover_n
Definition: modd_data_covern.F90:6
coupling_isba_n
subroutine coupling_isba_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_isban.F90:6
coupling_isba_canopy_n
subroutine coupling_isba_canopy_n(DTCO, UG, U, USS, IM, DTGD, DTGR, TGRO, DST, SLT, HPROGRAM, HCOUPLING, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST)
Definition: coupling_isba_canopyn.F90:6
modd_teb_greenroof_option_n::teb_greenroof_options_t
Definition: modd_teb_greenroof_optionn.F90:48
modd_teb_greenroof_option_n
Definition: modd_teb_greenroof_optionn.F90:6
isba_canopy
subroutine isba_canopy(I, KI, KLVL, PZ, PZF, PDZ, PDZF, PHEIGHT, PCANOPY_DENSITY, PU, PTKE, PUW_GROUND, PDUWDU_GROUND, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE)
Definition: isba_canopy.F90:6
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
modd_data_teb_greenroof_n
Definition: modd_data_teb_greenroofn.F90:6
init_isba_sbl
subroutine init_isba_sbl(HISBA, HCPSURF, KLVL, PTSTEP, PPA, PPS, PTA, PQA, PRHOA, PU, PV, PDIR_SW, PSCA_SW, PSW_BANDS, PRAIN, PSNOW, PZREF, PUREF, PTG, PPATCH, PWG, PWGI, PZ0, PSSO_SLOPE, PRESA, PVEG, PLAI, PWR, PRGL, PRSMIN, PGAMMA, PWRMAX_CF, PZ0_O_Z0H, PWFC, PWSAT, PTSNOW, PZ, PT, PQ, PWIND, PTKE, PP)
Definition: init_isba_sbl.F90:6
canopy_grid_update
subroutine canopy_grid_update(KI, KLVL, PH, PZFORC, PZ, PZF, PDZ, PDZF)
Definition: canopy_grid_update.F90:6
mode_coupling_canopy::init_coupling
subroutine init_coupling(HCOUPLING, PPS, PPA, PTA, PQA, PU, PV, PUREF, PZREF, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPET_B_COEF, PPEQ_A_COEF, PPEQ_B_COEF, PPPA, PTTA, PQQA, PUU, PVV, PUUREF, PZZREF, PPEW_AA_COEF, PPEW_BB_COEF, PPET_AA_COEF, PPET_BB_COEF, PPEQ_AA_COEF, PPEQ_BB_COEF)
Definition: mode_coupling_canopy.F90:132
modd_dst_n::dst_t
Definition: modd_dstn.F90:19
modd_data_teb_garden_n::data_teb_garden_t
Definition: modd_data_teb_gardenn.F90:40
modd_surf_atm_sso_n
Definition: modd_surf_atm_sson.F90:6
mode_coupling_canopy::init_2m_10m
subroutine init_2m_10m(PP, PT, PQ, PXU, PXZ, PU, PV, PWIND, PRHOA, PT2M, PQ2M, PHU2M, PZON10M, PMER10M, PWIND10M, PWIND10M_MAX, PT2M_MIN, PT2M_MAX, PHU2M_MIN, PHU2M_MAX)
Definition: mode_coupling_canopy.F90:210
mode_coupling_canopy
Definition: mode_coupling_canopy.F90:6
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
mode_coupling_canopy::init_forc
subroutine init_forc(PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ)
Definition: mode_coupling_canopy.F90:15
modd_data_teb_garden_n
Definition: modd_data_teb_gardenn.F90:6
canopy_evol
subroutine canopy_evol(KI, KLVL, PTSTEP, KIMPL, PZZ, PWIND, PTA, PQA, PPA, PRHOA, PSFLUX_U, PSFLUX_T, PSFLUX_Q, PFORC_U, PDFORC_UDU, PFORC_E, PDFORC_EDE, PFORC_T, PDFORC_TDT, PFORC_Q, PDFORC_QDQ, PZ, PZF, PDZ, PDZF, PU, PTKE, PT, PQ, PLMO, PLM, PLEPS, PP, PUSTAR, PALFAU, PBETAU, PALFATH, PBETATH, PALFAQ, PBETAQ, ONEUTRAL)
Definition: canopy_evol.F90:6
modd_dst_n
Definition: modd_dstn.F90:5
modd_csts
Definition: modd_csts.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
modd_canopy_turb
Definition: modd_canopy_turb.F90:6
Generated on Fri May 13 2016 09:31:01 for SURFEX by   doxygen 1.8.5