SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
isba_meb.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 isba_meb(TPTIME, OMEB, OMEB_LITTER, OMEB_GNDRES, PGNDLITTER, &
7  oforc_measure, oglacier, &
8  otr_ml, oagri_to_grass, oshade, ostressdef, &
9  osnowdrift, osnowdrift_sublim, osnow_abs_zenith, oirrigate, oirriday, &
10  hsnowmetamo, hsnowrad, hphoto, &
11  hisba, hcpsurf, hrain, hsnow_isba, hsnowres, himplicit_wind, &
12  kwg_layer, ptstep, pvegtype, plat, plon, &
13  pthreshold, pwatsup, pirrig, pirrig_flux, &
14  psoilhcapz, psoilcondz, pfrozen1, &
15  pps, pzenith, psca_sw, psw_rad, pvmod, prr, psr, prhoa, pta, pqa, &
16  ph_veg, pdircoszw, &
17  pexns, pexna, ppet_a_coef, ppet_b_coef, ppeq_a_coef, ppeq_b_coef, &
18  ppew_a_coef, ppew_b_coef, &
19  pzref, puref, pch, pcd, pcdn, pri, presa, phug, phv, phu, pqs, &
20  pz0g_without_snow, &
21  pz0_mebv, pz0h_mebv, pz0eff_mebv, &
22  pz0_mebn, pz0h_mebn, pz0eff_mebn, &
23  pz0_with_snow, pz0h_with_snow, pz0eff, &
24  ptv, ptl, ptg, ptc, pqc, pwr, pwrl, pwrli, pwrvn, pwg, pwgi, &
25  pwrmax_cf, prgl, prsmin, pgamma, prs, &
26  palbnir_tveg, palbvis_tveg,palbnir_tsoil, palbvis_tsoil, pfalb, &
27  psnowalb, psnowalbvis, psnowalbnir, psnowalbfir, &
28  pabc, pfaparc, pfapirc, pmus, plai_effc, &
29  piacan, pfapar, pfapir, pfapar_bs, pfapir_bs, &
30  pah, pbh, pf2i, pdmax, ppoi, pcsp, pfzero, pepso, &
31  pgamm, pqdgamm, pgmes, pgc, pqdgmes, pt1gmes, pt2gmes, &
32  pamax, pqdamax, pt1amax, pt2amax, &
33  pan, panday, panfm, pgpp, panf, presp_biomass_inst, &
34  pff, ppsn, ppalphan, plai, pf2, &
35  pwsat, pwfc, &
36  psnowgran1, psnowgran2, psnowhist,psnowage, &
37  psnowrho, psnowswe, psnowheat, psnowtemp, psnowdz, psnowliq, pfemis, &
38  pswnet_n, pswnet_v, pswnet_g, pswnet_ns, palbt, pswdown_gn, &
39  plw_rad, plwnet_n, plwnet_v, plwnet_g, plwdown_gn, &
40  plev_v_c, ples_v_c, ph_v_c, ph_g_c, pletr_v_c, pler_v_c, ph_c_a, &
41  ph_n_c, ple_v_c, ple_g_c, ple_c_a, ple_n_c, pevap_n_c, pevap_g_c, &
42  psr_gn, pmeltcv, pfrzcv, pmeltadv, &
43  ple_flood, plei_flood, &
44  ple, ph, prn, plei, plegi, pleg,plelitteri,plelitter,pdriplit,prrlit, &
45  plev, pler, pletr, pevap, ples, plesl, &
46  psubl, prestore, pgrndflux, pflsn_cor, pustar, &
47  phpsnow, psnowhmass, prnsnow, phsnow, pgfluxsnow, &
48  pustarsnow, psrsfc, prrsfc, pemisnow, pcdsnow, pchsnow, &
49  pemist, pts_rad, phu_agg, pac_agg, &
50  pdelheatv_sfc, pdelheatg_sfc, pdelheatg, &
51  pdelheatn, pdelheatn_sfc, prestoren, &
52  pd_g, pdzg, pcps, plvtt, plstt, pct, pcv, pcg, pffrozen, &
53  ptdeep_a, ptdeep_b, pdeep_flux, pmuf, pdrip, prrveg, &
54  prisnow, psnow_thrufal, psnow_thrufal_soil, pevapcor, psubvcor,plitcor,&
55  psnowsfch, psndrift, pqsnow )
56 ! ##########################################################################
57 !
58 !
59 !!**** *isba_meb*
60 !!
61 !! PURPOSE
62 !! -------
63 ! Monitor for the calculation of the surface fluxes and of the
64 ! prognostic variables of the surface over natural areas
65 ! with an explicit vegetation layer
66 !
67 ! NOTE...currently MEB can be coupled with
68 ! HISBA='DIF' or '3-L' soil options
69 ! HSNOW='3-L' snow scheme
70 ! Soon, HSNOW=CRO and HPHOTO/=NON (i.e. Ags will be added)
71 !
72 !!** METHOD
73 !! ------
74 !
75 !! EXTERNAL
76 !! --------
77 !!
78 !! IMPLICIT ARGUMENTS
79 !! ------------------
80 !!
81 !!
82 !! REFERENCE
83 !! ---------
84 !!
85 !! Noilhan and Planton (1989)
86 !!
87 !! AUTHOR
88 !! ------
89 !! A. Boone * Meteo-France *
90 !! P. Samuelsson * SMHI *
91 !!
92 !! MODIFICATIONS
93 !! -------------
94 !! Original 10/2014
95 !! (A. Napoly) 09/2015 Add Litter layer option code
96 !!
97 !-------------------------------------------------------------------------------
98 !
99 !* 0. DECLARATIONS
100 ! ------------
101 !
102 USE modd_surf_par, ONLY : xundef
103 USE modd_csts, ONLY : xcpd, xday, xrholw
104 USE modd_meb_par, ONLY : xsw_wght_vis, xsw_wght_nir
105 USE modd_isba_par, ONLY : xrs_max
106 USE modd_data_cover_par, ONLY : nvt_snow
107 !
108 USE modd_type_date_surf, ONLY : date_time
109 !
110 USE mode_thermos
111 USE mode_meb, ONLY : snow_intercept_eff
112 !
113 USE modi_wet_leaves_frac
114 USE modi_veg
115 USE modi_snow_leaves_frac_meb
116 USE modi_preps_for_meb_ebud_rad
117 USE modi_isba_lwnet_meb
118 USE modi_drag_meb
119 USE modi_e_budget_meb
120 USE modi_isba_fluxes_meb
121 USE modi_snow_load_meb
122 USE modi_hydro_veg
123 USE modi_snow3l_isba
124 USE modi_radiative_transfert
125 USE modi_cotwores
126 !
127 !
128 USE yomhook ,ONLY : lhook, dr_hook
129 USE parkind1 ,ONLY : jprb
130 !
131 IMPLICIT NONE
132 !
133 !* 0.1 declarations of arguments
134 ! -------------------------
135 !
136 !
137 !* general variables
138 ! -----------------
139 !
140 TYPE(date_time), INTENT(IN) :: tptime ! current date and time
141 !
142 LOGICAL, INTENT(IN) :: omeb ! True = patch with multi-energy balance
143 ! ! False = patch with classical ISBA
144 LOGICAL, INTENT(IN) :: omeb_litter ! Flag for litter
145 LOGICAL, INTENT(IN) :: omeb_gndres ! Flag for ground resistance
146 LOGICAL, INTENT(IN) :: oforc_measure ! switch for using measured data (drag scheme)
147 LOGICAL, INTENT(IN) :: oglacier ! True = Over permanent snow and ice,
148 ! ! initialise WGI=WSAT,
149 ! ! Hsnow>=10m and allow 0.8<SNOALB<0.85
150 ! ! False = No specific treatment
151 LOGICAL, INTENT(IN) :: osnowdrift ! if=T, activate snowdrift
152 LOGICAL, INTENT(IN) :: osnowdrift_sublim ! if=T, activate snowdrift sublimation
153 LOGICAL, INTENT(IN) :: osnow_abs_zenith ! if=T, activate parametrization of solar absorption
154 ! ! for polar regions
155 LOGICAL, INTENT(IN) :: otr_ml ! Multi-layer SW radiative transfer option (NOTE =T for MEB)
156 LOGICAL, INTENT(IN) :: oagri_to_grass! Used in Multi-layer SW radiative transfer option
157 LOGICAL, DIMENSION(:),INTENT(IN) :: oirrigate ! Irrigation FLAG
158 LOGICAL, DIMENSION(:),INTENT(IN) :: ostressdef ! Ags: vegetation response type to water
159 ! ! stress (true:defensive false:offensive)
160 LOGICAL, DIMENSION(:),INTENT(INOUT) :: oshade ! where vegetation evolution occurs
161 LOGICAL, DIMENSION(:),INTENT(INOUT) :: oirriday ! Irrigation time
162 !
163  CHARACTER(LEN=*), INTENT(IN) :: hisba ! type of ISBA version:
164 ! ! '2-L' (default)
165 ! ! '3-L'
166 ! ! 'DIF'
167  CHARACTER(LEN=*), INTENT(IN) :: hcpsurf ! Specific heat
168 ! ! 'DRY' = dry Cp
169 ! ! 'HUM' = humid Cp fct of qs
170  CHARACTER(LEN=*), INTENT(IN) :: hrain ! Rainfall spatial distribution
171  ! 'DEF' = No rainfall spatial distribution
172  ! 'SGH' = Rainfall exponential spatial distribution
173  CHARACTER(LEN=*), INTENT(IN) :: hsnow_isba ! 'DEF' = Default F-R snow scheme
174 ! ! (Douville et al. 1995)
175 ! ! '3-L' = 3-L snow scheme (option)
176 ! ! (Boone and Etchevers 2000)
177  CHARACTER(LEN=*), INTENT(IN) :: hsnowres ! 'DEF' = Default: Louis (ISBA)
178 ! ! 'RIL' = CROCUS (Martin) method
179 ! ! ISBA-SNOW3L turbulant exchange option
180  CHARACTER(LEN=*), INTENT(IN) :: himplicit_wind! wind implicitation option
181 ! ! 'OLD' = direct
182 ! ! 'NEW' = Taylor serie, order 1
183  CHARACTER(LEN=*), INTENT(IN) :: hsnowmetamo ! Crocus metamorphism scheme:
184 ! ! HSNOWMETAMO = B92 Brun et al 1992
185 ! ! HSNOWMETAMO = C13 Carmagnola et al 2014
186 ! ! HSNOWMETAMO = T07 Taillandier et al 2007
187 ! ! HSNOWMETAMO = F06 Flanner et al 2006
188  CHARACTER(LEN=*), INTENT(IN) :: hsnowrad ! Crocus radiative transfer scheme:
189 ! ! HSNOWMETAMO = B92 Brun et al 1992
190 ! ! HSNOWMETAMO = TAR TARTES (Libois et al 2013)
191 ! ! HSNOWMETAMO = TA1 TARTES with constant impurities
192 ! ! HSNOWMETAMO = TA2 TARTES with constant impurities as a
193 ! ! function of ageing
194  CHARACTER(LEN=*), INTENT(IN) :: hphoto ! Kind of photosynthesis;
195 ! ! 'NON' NOTE: this option currently supported (Jarvis)
196 ! ! 'AGS'
197 ! ! 'LAI'
198 ! ! 'AST' NOTE: this option currently supported (ISBA-Ags)
199 ! ! 'LST'
200 !
201 INTEGER, DIMENSION(:),INTENT(IN) :: kwg_layer ! Number of soil moisture layers (DIF option)
202 !
203 REAL, INTENT(IN) :: ptstep ! Model time step (s)
204 REAL, DIMENSION(:,:), INTENT(IN) :: pvegtype ! fraction of each vegetation (-)
205 REAL, DIMENSION(:), INTENT(IN) :: plat ! Latitude (degrees North)
206 REAL, DIMENSION(:), INTENT(IN) :: plon ! Longitude (degrees East)
207 REAL, DIMENSION(:), INTENT(IN) :: pps ! Pressure [Pa]
208 REAL, DIMENSION(:), INTENT(IN) :: pzenith ! solar zenith angle
209 REAL, DIMENSION(:), INTENT(IN) :: psw_rad ! solar (shortwave) incoming radiation [W/m2]
210 REAL, DIMENSION(:), INTENT(IN) :: plw_rad ! thermal (longwave) incoming radiation [W/m2]
211 REAL, DIMENSION(:), INTENT(IN) :: psca_sw ! solar diffuse incoming radiation [W/m2]
212 REAL, DIMENSION(:), INTENT(IN) :: pexna ! Exner function: forcing level (-)
213 REAL, DIMENSION(:), INTENT(IN) :: pexns ! Exner function: surface (-)
214 REAL, DIMENSION(:), INTENT(IN) :: prr ! Rain rate (kg/m2/s)
215 REAL, DIMENSION(:), INTENT(IN) :: psr ! Snow rate (kg/m2/s)
216 REAL, DIMENSION(:), INTENT(IN) :: prhoa ! air density (kg/m3)
217 REAL, DIMENSION(:), INTENT(IN) :: pvmod ! modulus of the wind
218 ! ! parallel to the orography (m/s)
219 REAL, DIMENSION(:), INTENT(IN) :: pta ! Temperature of atmosphere (K)
220 REAL, DIMENSION(:), INTENT(IN) :: pqa ! specific humidity of atmosphere (kg/kg)
221 REAL, DIMENSION(:), INTENT(IN) :: ph_veg ! height of vegetation
222 REAL, DIMENSION(:), INTENT(IN) :: pzref ! normal distance of the first
223 ! ! atmospheric level to the
224 ! ! orography (m)
225 REAL, DIMENSION(:), INTENT(IN) :: puref ! reference height of the wind (m)
226 ! ! NOTE this is different from ZZREF
227 ! ! ONLY in stand-alone/forced mode,
228 ! ! NOT when coupled to a model (MesoNH)
229 REAL, DIMENSION(:), INTENT(IN) :: pdircoszw ! Director Cosinus along the z
230 ! ! direction at the surface w-point
231 REAL, DIMENSION(:,:), INTENT(IN) :: psoilhcapz ! ISBA-DF Soil heat capacity
232 ! ! profile [J/(m3 K)]
233 REAL, DIMENSION(:,:), INTENT(IN) :: psoilcondz ! ISBA-DF Soil conductivity
234 ! ! profile [W/(m K)]
235 REAL, DIMENSION(:), INTENT(IN) :: pfrozen1 ! surface frozen fraction (-)
236 REAL, DIMENSION(:), INTENT(IN) :: plai ! vegetation Leaf Area Index (m2/m2)
237 REAL, DIMENSION(:), INTENT(IN) :: pgndlitter ! litter thickness (MEB option) (m).
238 REAL, DIMENSION(:), INTENT(IN) :: prgl ! maximum solar radiation
239 ! ! usable in photosynthesis
240 REAL, DIMENSION(:), INTENT(IN) :: prsmin ! minimum stomatal resistance (s/m)
241 REAL, DIMENSION(:), INTENT(IN) :: pgamma ! coefficient for the calculation
242 ! ! of the surface stomatal resistance
243 REAL, DIMENSION(:), INTENT(IN) :: pff ! Floodplain fraction at the surface
244 REAL, DIMENSION(:), INTENT(IN) :: ppsn ! fraction of the grid covered
245 ! ! by snow
246 REAL, DIMENSION(:), INTENT(IN) :: ppalphan ! snow/canopy transition coefficient
247 REAL, DIMENSION(:), INTENT(IN) :: pfalb ! Floodplain albedo
248 REAL, DIMENSION(:), INTENT(IN) :: palbnir_tveg ! albedo of vegetation in NIR
249 ! ! (needed for LM_TR or MEB)
250 REAL, DIMENSION(:), INTENT(IN) :: palbvis_tveg ! albedo of vegetation in VIS
251 ! ! (needed for LM_TR or MEB)
252 REAL, DIMENSION(:), INTENT(IN) :: palbnir_tsoil ! albedo of bare soil in NIR
253 ! ! (needed for LM_TR or MEB)
254 REAL, DIMENSION(:), INTENT(IN) :: palbvis_tsoil ! albedo of bare soil in VIS
255 REAL, DIMENSION(:), INTENT(IN) :: pwrmax_cf ! maximum vegetation interception storage (kg/m2)
256 REAL, DIMENSION(:), INTENT(IN) :: pfemis ! Floodplain emissivity (-)
257 REAL, DIMENSION(:), INTENT(IN) :: pf2 ! Soil water stress factor for transpiration (-)
258 REAL, DIMENSION(:,:), INTENT(IN) :: pwfc ! field capacity profile (m3/m3)
259 REAL, DIMENSION(:,:), INTENT(IN) :: pwsat ! porosity profile (m3/m3)
260 REAL, DIMENSION(:,:), INTENT(INOUT) :: pwg, pwgi ! PWG = soil liquid volumetric water content (m3/m3)
261 ! ! PWGI = soil frozen volumetric water content (m3/m3)
262 REAL, DIMENSION(:), INTENT(IN) :: pz0g_without_snow ! roughness length for momentum at snow-free canopy floor (m)
263 REAL, DIMENSION(:), INTENT(IN) :: pz0_mebv ! roughness length for momentum over MEB vegetation part of patch (m)
264 REAL, DIMENSION(:), INTENT(IN) :: pz0h_mebv ! roughness length for heat over MEB vegetation part of path (m)
265 REAL, DIMENSION(:), INTENT(IN) :: pz0eff_mebv ! roughness length for momentum over MEB vegetation part of patch (m)
266 REAL, DIMENSION(:), INTENT(IN) :: pz0_mebn ! roughness length for momentum over MEB snow part of patch (m)
267 REAL, DIMENSION(:), INTENT(IN) :: pz0h_mebn ! roughness length for heat over MEB snow part of path (m)
268 REAL, DIMENSION(:), INTENT(IN) :: pz0eff_mebn ! roughness length for momentum over MEB snow part of patch (m)
269 REAL, DIMENSION(:), INTENT(IN) :: pz0_with_snow ! roughness length for momentum
270 ! ! (with snow taken into account) (m)
271 REAL, DIMENSION(:), INTENT(IN) :: pz0h_with_snow ! roughness length for heat
272 ! ! (with snow taken into account) (m)
273 REAL, DIMENSION(:), INTENT(IN) :: pz0eff ! roughness length for momentum (m)
274 REAL, DIMENSION(:,:), INTENT(IN) :: pd_g ! Depth of Bottom of Soil layers (m)
275 REAL, DIMENSION(:,:), INTENT(IN) :: pdzg ! Thickness of Soil layers (m)
276 REAL, DIMENSION(:), INTENT(IN) :: pct ! area-averaged effective inverse heat capacity [(K m2)/J]
277 REAL, DIMENSION(:), INTENT(IN) :: pcv ! vegetation inverse heat capacity [(K m2)/J]
278 REAL, DIMENSION(:), INTENT(IN) :: pcg ! soil inverse heat capacity [(K m2)/J]
279 REAL, DIMENSION(:), INTENT(IN) :: pffrozen ! Fraction of frozen flood (-)
280 REAL, DIMENSION(:), INTENT(IN) :: pmuf ! fraction of the grid cell reached by the rainfall (-)
281 !
282 ! implicit atmospheric coupling coefficients:
283 !
284 REAL, DIMENSION(:), INTENT(IN) :: ppet_a_coef, ppet_b_coef, &
285  ppeq_a_coef, ppeq_b_coef, &
286  ppew_a_coef, ppew_b_coef
287 ! ! PPEW_A_COEF A-wind coefficient
288 ! ! PPEW_B_COEF B-wind coefficient
289 ! ! PPET_A_COEF A-air temperature coefficient
290 ! ! PPET_B_COEF B-air temperature coefficient
291 ! ! PPEQ_A_COEF A-air specific humidity coefficient
292 ! ! PPEQ_B_COEF B-air specific humidity coefficient
293 REAL, DIMENSION(:), INTENT(IN) :: ptdeep_a, ptdeep_b ! Deep soil temperature boundary condition
294 ! ! (prescribed)
295 ! PTDEEP_A = Deep soil temperature
296 ! coefficient depending on flux
297 ! PTDEEP_B = Deep soil temperature (prescribed)
298 ! which models heating/cooling from
299 ! below the diurnal wave penetration
300 ! (surface temperature) depth. If it
301 ! is FLAGGED as undefined, then the zero
302 ! flux lower BC is applied.
303 ! Tdeep = PTDEEP_B + PTDEEP_A * PDEEP_FLUX
304 ! (with PDEEP_FLUX in W/m2)
305 !
306 REAL, DIMENSION(:), INTENT(IN) :: pthreshold, pwatsup, pirrig
307 ! PTHRESHOLD = threshold water level for irrigation (-)
308 ! PWATSUP = irrigation water need to maintain a given moisture thresold (kg/m2)
309 ! PIRRIG = irrigation mask (-)
310 !
311 ! ISBA-Ags parameters
312 ! (see also parameters with 'Ags:' in comments)
313 !
314 REAL, DIMENSION(:), INTENT(IN) :: pgc ! cuticular conductance (m s-1)
315 REAL, DIMENSION(:), INTENT(IN) :: pf2i ! critical normilized soil water
316 ! ! content for stress parameterisation
317 REAL, DIMENSION(:), INTENT(IN) :: pdmax ! maximum air saturation deficit
318 ! ! tolerate by vegetation
319 REAL, DIMENSION(:), INTENT(IN) :: pah,pbh ! coefficients for herbaceous water stress
320 ! ! response (offensive or defensive)
321 !
322 REAL, DIMENSION(:), INTENT(IN) :: pcsp ! atmospheric CO2 concentration
323 ! [ppmm]=[kg CO2 / kg air]
324 REAL, DIMENSION(:), INTENT(IN) :: pgmes ! mesophyll conductance (m s-1)
325 !
326 REAL, DIMENSION(:), INTENT(IN) :: ppoi ! Gaussian weights (as above)
327 !
328 REAL, DIMENSION(:), INTENT(IN) :: pfzero ! ideal value of F, no photo-
329 ! ! respiration or saturation deficit
330 REAL, DIMENSION(:), INTENT(IN) :: pepso ! maximum initial quantum use
331 ! ! efficiency (mg J-1 PAR)
332 REAL, DIMENSION(:), INTENT(IN) :: pgamm ! CO2 conpensation concentration (ppmv)
333 REAL, DIMENSION(:), INTENT(IN) :: pqdgamm ! Log of Q10 function for CO2 conpensation
334 ! ! concentration
335 REAL, DIMENSION(:), INTENT(IN) :: pqdgmes ! Log of Q10 function for mesophyll conductance
336 REAL, DIMENSION(:), INTENT(IN) :: pt1gmes ! reference temperature for computing
337 ! ! compensation concentration function for
338 ! ! mesophyll conductance: minimum
339 ! ! temperature
340 REAL, DIMENSION(:), INTENT(IN) :: pt2gmes ! reference temperature for computing
341 ! ! compensation concentration function for
342 ! ! mesophyll conductance: maximum
343 ! ! temperature
344 REAL, DIMENSION(:), INTENT(IN) :: pamax ! leaf photosynthetic capacity (kgCO2 m-2 s-1)
345 REAL, DIMENSION(:), INTENT(IN) :: pqdamax ! Log of Q10 function for leaf photosynthetic capacity
346 REAL, DIMENSION(:), INTENT(IN) :: pt1amax ! reference temperature for computing
347 ! ! compensation concentration function for leaf
348 ! ! photosynthetic capacity: minimum
349 ! ! temperature
350 REAL, DIMENSION(:), INTENT(IN) :: pt2amax ! reference temperature for computing
351 ! ! compensation concentration function for leaf
352 ! ! photosynthetic capacity: maximum
353 ! ! temperature
354 !
355 ! - - - - - - - - - - - - - - - - - - - -
356 !
357 REAL, DIMENSION(:), INTENT(INOUT) :: psnowalb ! Snow albedo
358 REAL, DIMENSION(:), INTENT(INOUT) :: psnowalbvis ! Snow VIS albedo
359 REAL, DIMENSION(:), INTENT(INOUT) :: psnowalbnir ! Snow NIR albedo
360 REAL, DIMENSION(:), INTENT(INOUT) :: psnowalbfir ! Snow FIR albedo
361 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowswe ! Snow model layer liquid water equivalent or
362 ! ! SWE (kg m-2)
363 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowheat ! Snow layer heat content (J/m3)
364 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowrho ! Snow layer average density (kg/m3)
365 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowgran1 ! Snow grain parameter 1
366 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowgran2 ! Snow grain parameter 2
367 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowhist ! Snow grain historical parameter
368 REAL, DIMENSION(:,:), INTENT(INOUT) :: psnowage ! Snow grain age
369 ! ! NOTE : methamorphism is only activated if the flag
370 ! ! OSNOW_METAMO=TRUE
371 !
372 REAL, DIMENSION(:,:), INTENT(INOUT) :: ptg ! Soil layer average temperature (K)
373 REAL, DIMENSION(:), INTENT(INOUT) :: ptv ! Canopy vegetation temperature (K)
374 REAL, DIMENSION(:), INTENT(INOUT) :: ptl ! Litter temperature (K)
375 REAL, DIMENSION(:), INTENT(INOUT) :: ptc ! Canopy air temperature [K]
376 REAL, DIMENSION(:), INTENT(INOUT) :: pqc ! Canopy air specific humidity [kg/kg]
377 REAL, DIMENSION(:), INTENT(INOUT) :: pwr ! liquid water retained on the foliage
378 ! ! of the canopy vegetation [kg/m2]
379 REAL, DIMENSION(:), INTENT(INOUT) :: pwrl ! liquid water retained on the litter
380 REAL, DIMENSION(:), INTENT(INOUT) :: pwrli ! ice retained on the litter
381 REAL, DIMENSION(:), INTENT(INOUT) :: pwrvn ! liquid water equiv of snow retained on the foliage
382 ! ! of the canopy vegetation [kg/m2]
383 REAL, DIMENSION(:), INTENT(INOUT) :: presa ! aerodynamic resistance (s/m)
384 REAL, DIMENSION(:), INTENT(INOUT) :: ple ! total latent heat flux (W/m2)
385 REAL, DIMENSION(:), INTENT(INOUT) :: ple_flood ! Floodplains latent heat flux: liquid part [W/m2]
386 REAL, DIMENSION(:), INTENT(INOUT) :: plei_flood ! Floodplains latent heat flux: frozen part [W/m2]
387 !
388 REAL, DIMENSION(:), INTENT(INOUT) :: pabc ! Ags: abscissa needed for integration
389 ! ! of net assimilation and stomatal
390 ! ! conductance over canopy depth
391 REAL, DIMENSION(:), INTENT(INOUT) :: pfaparc ! Fapar of vegetation (cumul)
392 REAL, DIMENSION(:), INTENT(INOUT) :: pfapirc ! Fapir of vegetation (cumul)
393 REAL, DIMENSION(:), INTENT(INOUT) :: pmus
394 REAL, DIMENSION(:), INTENT(INOUT) :: plai_effc ! Effective LAI (cumul)
395 !
396 ! diagnostic variables for Carbon assimilation
397 !
398 REAL, DIMENSION(:), INTENT(INOUT) :: panfm ! Ags: maximum leaf assimilation
399 REAL, DIMENSION(:), INTENT(INOUT) :: pan ! net CO2 assimilation
400 REAL, DIMENSION(:), INTENT(INOUT) :: panday ! daily net CO2 assimilation
401 !
402 ! - - - - - - - - - - - - - - - - - - - -
403 !
404 REAL, DIMENSION(:,:), INTENT(OUT) :: piacan ! PAR in the canopy at different gauss levels
405 REAL, DIMENSION(:), INTENT(OUT) :: pfapar ! Fapar of vegetation
406 REAL, DIMENSION(:), INTENT(OUT) :: pfapir ! Fapir of vegetation
407 REAL, DIMENSION(:), INTENT(OUT) :: pfapar_bs ! Fapar of bare soil
408 REAL, DIMENSION(:), INTENT(OUT) :: pfapir_bs ! Fapir of bare soil
409 
410 REAL, DIMENSION(:,:), INTENT(OUT) :: psnowtemp ! Snow layer average temperature (K)
411 REAL, DIMENSION(:,:), INTENT(OUT) :: psnowdz ! Snow layer thickness (m)
412 REAL, DIMENSION(:), INTENT(OUT) :: pemisnow ! Snow surface emissivity (-)
413 REAL, DIMENSION(:), INTENT(OUT) :: pswnet_n ! net snow shortwave radiation [W/m2]
414 REAL, DIMENSION(:), INTENT(OUT) :: pswnet_ns ! net snow shortwave radiation for
415 ! ! the *surface* snow layer
416 REAL, DIMENSION(:), INTENT(OUT) :: pswnet_v ! net vegetation canopy shortwave radiation
417 ! ! [W/m2]
418 REAL, DIMENSION(:), INTENT(OUT) :: pswnet_g ! net surface (ground) shortwave radiation [W/m2]
419 REAL, DIMENSION(:), INTENT(OUT) :: palbt ! total surface albedo
420 REAL, DIMENSION(:), INTENT(OUT) :: pswdown_gn ! total shortwave radiation transmitted through
421  ! the vegetation canopy
422 REAL, DIMENSION(:), INTENT(OUT) :: plwnet_v ! net vegetation canopy longwave radiation [W/m2]
423 REAL, DIMENSION(:), INTENT(OUT) :: plwnet_g ! net ground longwave radiation [W/m2]
424 REAL, DIMENSION(:), INTENT(OUT) :: plwnet_n ! net snow longwave radiation [W/m2]
425 REAL, DIMENSION(:), INTENT(OUT) :: plwdown_gn ! total shortwave radiation transmitted through and emitted by
426 ! ! the canopy reaching the snowpack/ground (explicit part) [W/m2]
427 REAL, DIMENSION(:), INTENT(OUT) :: prs ! surface stomatal resistance (s/m)
428 REAL, DIMENSION(:), INTENT(OUT) :: pch ! drag coefficient for heat
429 REAL, DIMENSION(:), INTENT(OUT) :: pcd ! drag coefficient for momentum
430 REAL, DIMENSION(:), INTENT(OUT) :: pcdn ! neutral drag coefficient for momentum
431 REAL, DIMENSION(:), INTENT(OUT) :: pri ! Richardson number
432 REAL, DIMENSION(:), INTENT(OUT) :: phv ! Total effective Halstead coefficient
433 REAL, DIMENSION(:), INTENT(OUT) :: phu ! grid-area humidity of the soil
434 REAL, DIMENSION(:), INTENT(OUT) :: phug ! ground relative humidity
435 REAL, DIMENSION(:), INTENT(OUT) :: pqs ! surface humidity (kg/kg)
436 REAL, DIMENSION(:), INTENT(OUT) :: prn ! net radiation
437 REAL, DIMENSION(:), INTENT(OUT) :: ph ! sensible heat flux
438 REAL, DIMENSION(:), INTENT(OUT) :: plei ! sublimation latent heat flux
439 REAL, DIMENSION(:), INTENT(OUT) :: plegi ! latent heat of sublimation over frozen soil
440 REAL, DIMENSION(:), INTENT(OUT) :: pleg ! latent heat of evaporation
441 REAL, DIMENSION(:), INTENT(OUT) :: plelitteri ! litter evaporation of ice
442 REAL, DIMENSION(:), INTENT(OUT) :: plelitter ! litter sublimation of liquid water
443 REAL, DIMENSION(:), INTENT(OUT) :: pdriplit ! drip from litter
444 REAL, DIMENSION(:), INTENT(OUT) :: prrlit !
445 ! ! over the ground
446 REAL, DIMENSION(:), INTENT(OUT) :: plev ! latent heat of evaporation
447 ! ! over the vegetation
448 REAL, DIMENSION(:), INTENT(OUT) :: pler ! latent heat of the fraction
449 ! ! delta of water retained on the
450 ! ! foliage of the vegetation
451 REAL, DIMENSION(:), INTENT(OUT) :: pletr ! evapotranspiration of the rest
452 ! ! of the vegetation
453 REAL, DIMENSION(:), INTENT(OUT) :: pevap ! total evaporative flux (kg/m2/s)
454 REAL, DIMENSION(:), INTENT(OUT) :: ples ! sublimation from ground-based snowpack [W/m2]
455 REAL, DIMENSION(:), INTENT(OUT) :: plesl ! evaporation from ground-based snowpack [W/m2]
456 REAL, DIMENSION(:), INTENT(OUT) :: psubl ! total sublimation flux soil/snow/vegtation interception (kg/m2/s)
457 REAL, DIMENSION(:), INTENT(OUT) :: prestore ! surface restore flux for Force-Restore, diffusive flux between uppermost and second soil layers
458 ! ! when using the DIF soil option (W/m2)
459 REAL, DIMENSION(:), INTENT(OUT) :: pustar ! friction velocity
460 REAL, DIMENSION(:), INTENT(OUT) :: pmeltadv ! advection heat flux from snowmelt (W/m2)
461 REAL, DIMENSION(:), INTENT(OUT) :: pcps ! heat capacity of air (J/kg/K)
462 REAL, DIMENSION(:), INTENT(OUT) :: plvtt ! latent heat of vaporization (J/kg)
463 REAL, DIMENSION(:), INTENT(OUT) :: plstt ! latent heat of sublimation (J/kg)
464 REAL, DIMENSION(:), INTENT(OUT) :: plev_v_c ! MEB: total evapotranspiration (no sublim) from vegetation canopy overstory [W/m2]
465 REAL, DIMENSION(:), INTENT(OUT) :: ples_v_c ! MEB: total snow sublimation from vegetation canopy overstory [W/m2]
466 REAL, DIMENSION(:), INTENT(OUT) :: ph_v_c ! MEB: sensible heat flux from vegetation canopy overstory [W/m2]
467 REAL, DIMENSION(:), INTENT(OUT) :: ph_g_c ! MEB: sensible heat flux from ground [W/m2]
468 REAL, DIMENSION(:), INTENT(OUT) :: pletr_v_c ! MEB: transpiration from overstory canopy vegetation [W/m2]
469 REAL, DIMENSION(:), INTENT(OUT) :: pler_v_c ! MEB: interception evaporation from overstory canopy vegetation [W/m2]
470 REAL, DIMENSION(:), INTENT(OUT) :: ph_c_a ! MEB: sensible heat flux from canopy air space to the atmosphere [W/m2]
471  ! NOTE total sensible heat flux to the atmosphere also possibly
472  ! includes a contribution from snow covering the canopy
473 REAL, DIMENSION(:), INTENT(OUT) :: ph_n_c ! MEB: sensible heat flux from the snow on the ground [W/m2]
474  ! NOTE total sensible heat flux from the snowpack
475  ! possibly includes a contribution from snow covering the canopy
476 REAL, DIMENSION(:), INTENT(OUT) :: ple_v_c ! MEB: latent heat flux from vegetation canopy overstory [W/m2]
477 REAL, DIMENSION(:), INTENT(OUT) :: ple_g_c ! MEB: latent heat flux from ground [W/m2]
478 REAL, DIMENSION(:), INTENT(OUT) :: ple_c_a ! MEB: latent heat flux from canopy air space to the atmosphere [W/m2]
479  ! NOTE total latent heat flux to the atmosphere also possibly
480  ! includes a contribution from snow covering the canopy
481 REAL, DIMENSION(:), INTENT(OUT) :: ple_n_c ! MEB: latent heat flux from the snow on the ground [W/m2]
482  ! NOTE total latent heat flux from the snowpack
483  ! possibly includes a contribution from snow covering the canopy
484 REAL, DIMENSION(:), INTENT(OUT) :: pevap_n_c ! MEB: Total evap from snow on the ground to canopy air space [kg/m2/s]
485 REAL, DIMENSION(:), INTENT(OUT) :: pevap_g_c ! MEB: Total evap from ground to canopy air space [kg/m2/s]
486 REAL, DIMENSION(:), INTENT(OUT) :: psr_gn ! MEB: total snow reaching the ground snow [kg/m2/s]
487 REAL, DIMENSION(:), INTENT(OUT) :: pmeltcv ! MEB: snow melt rate from the overstory snow reservoir [kg/m2/s]
488 REAL, DIMENSION(:), INTENT(OUT) :: pfrzcv ! MEB: snow refreeze rate from the overstory snow reservoir [kg/m2/s]
489 REAL, DIMENSION(:), INTENT(OUT) :: pgrndflux ! snow/soil-biomass interface flux (W/m2)
490 REAL, DIMENSION(:), INTENT(OUT) :: pflsn_cor ! soil/snow interface correction flux to conserve energy (W/m2)
491 REAL, DIMENSION(:), INTENT(OUT) :: phpsnow ! heat release from rainfall (W/m2)
492 REAL, DIMENSION(:), INTENT(OUT) :: psnowhmass ! snow heat content change from mass changes (J/m2)
493 REAL, DIMENSION(:), INTENT(OUT) :: prnsnow ! net radiative flux from snow (W/m2)
494 REAL, DIMENSION(:), INTENT(OUT) :: phsnow ! sensible heat flux from snow (W/m2)
495 REAL, DIMENSION(:), INTENT(OUT) :: pgfluxsnow ! net heat flux from snow (W/m2)
496 REAL, DIMENSION(:), INTENT(OUT) :: pustarsnow ! friction velocity
497 REAL, DIMENSION(:), INTENT(OUT) :: psrsfc ! Snow rate falling outside of snow
498 ! ! covered grid area [kg/(m2 s)]
499 REAL, DIMENSION(:), INTENT(OUT) :: prrsfc ! Rain rate falling outside of snow and flood
500 ! ! covered grid area [kg/(m2 s)]
501 REAL, DIMENSION(:), INTENT(OUT) :: pcdsnow ! drag coefficient for momentum over snow
502 REAL, DIMENSION(:), INTENT(OUT) :: pchsnow ! drag coefficient for heat over snow
503 REAL, DIMENSION(:), INTENT(OUT) :: pemist ! total effective surface emissivity...LWUP = EMIST*TS_RAD**4 (-)
504 REAL, DIMENSION(:), INTENT(OUT) :: pts_rad ! effective radiative temperature
505 ! ! of the natural surface (K)
506 REAL, DIMENSION(:,:), INTENT(OUT) :: psnowliq ! snow layer liquid water content (m)
507 REAL, DIMENSION(:), INTENT(OUT) :: pac_agg ! aggregated aerodynamic conductance
508  ! for evaporative flux calculations
509 REAL, DIMENSION(:), INTENT(OUT) :: phu_agg ! aggregated relative humidity
510  ! for evaporative flux calculations
511 REAL, DIMENSION(:), INTENT(OUT) :: pdelheatv_sfc ! change in heat storage of the vegetation canopy layer over the current time step (W/m2)
512 REAL, DIMENSION(:), INTENT(OUT) :: pdelheatg_sfc ! change in heat storage of the ground sfc layer over the current time step (W/m2)
513 REAL, DIMENSION(:), INTENT(OUT) :: pdelheatg ! change in heat storage of the entire soil column over the current time step (W/m2)
514 REAL, DIMENSION(:), INTENT(OUT) :: prestoren ! conductive heat flux between the surface and sub-surface soil layers
515 ! ! for the multi-layer snow schemes..for composite snow, it is
516 ! ! equal to PRESTORE (W/m2)
517 REAL, DIMENSION(:), INTENT(OUT) :: pdelheatn ! change in heat storage of the entire snow column over the current time step (W/m2)
518 REAL, DIMENSION(:), INTENT(OUT) :: pdelheatn_sfc ! change in heat storage of the surface snow layer over the current time step (W/m2)
519 REAL, DIMENSION(:), INTENT(OUT) :: pdeep_flux ! Heat flux at bottom of ISBA (W/m2)
520 REAL, DIMENSION(:), INTENT(OUT) :: pdrip ! Water dripping from the vegetation canopy (kg/m2/s)
521 REAL, DIMENSION(:), INTENT(OUT) :: prrveg ! Water intercepted by the vegetation canopy (kg/m2/s)
522 REAL, DIMENSION(:), INTENT(OUT) :: prisnow ! Richarson number over ground-based snowpack (-)
523 REAL, DIMENSION(:), INTENT(OUT) :: psnow_thrufal ! rate that liquid water leaves (explicit) snow pack:
524 ! ! ISBA-ES or CROCUS [kg/(m2 s)]
525 REAL, DIMENSION(:), INTENT(OUT) :: psnow_thrufal_soil !liquid water leaving the snowpack directly to the
526 ! !soil, ISBA-ES: [kg/(m2 s)] (equal to ZSNOW_THRUFAL
527 ! !if OMEB_LITTER=False and zero if OMEB_LITTER=True)
528 ! ! ISBA-ES or CROCUS [kg/(m2 s)]
529 REAL, DIMENSION(:), INTENT(OUT) :: pevapcor ! evaporation correction as last traces of snow
530 ! ! cover ablate..if sublimation exceeds trace amounts
531  ! of snow during time step, required residual mass taken
532  ! from sfc soil layer [kg/(m2 s)]
533 REAL, DIMENSION(:), INTENT(OUT) :: psubvcor ! A possible snow mass correction (to be potentially
534 ! ! removed from soil) (kg/m2/s)
535 REAL, DIMENSION(:), INTENT(OUT) :: plitcor ! A possible ice mass correction in litter layer (to be potentially
536 ! ! removed from soil) (kg/m2/s)
537 REAL, DIMENSION(:), INTENT(OUT) :: psnowsfch ! snow surface layer pseudo-heating term owing to
538 ! ! changes in grid thickness (W/m2)
539 REAL, DIMENSION(:), INTENT(OUT) :: psndrift ! blowing snow sublimation (kg/m2/s)
540 REAL, DIMENSION(:), INTENT(OUT) :: pqsnow ! snow surface specific humidity (kg/kg)
541 REAL, DIMENSION(:), INTENT(OUT) :: pirrig_flux ! (kg/m2/s) irrigation flux (water need)
542 !
543 ! diagnostic variables for Carbon assimilation:
544 !
545 REAL, DIMENSION(:), INTENT(OUT) :: panf ! total assimilation over canopy
546 REAL, DIMENSION(:), INTENT(OUT) :: pgpp ! Gross Primary Production
547 REAL, DIMENSION(:,:), INTENT(OUT) :: presp_biomass_inst ! instantaneous biomass respiration (kgCO2/kgair m/s)
548 !
549 !
550 !* 0.2 declarations of local variables
551 !
552 !
553 REAL, PARAMETER :: ztstep_eb = 300. ! s Minimum time tstep required
554 ! ! to time-split MEB energy budget
555 INTEGER :: jtsplit_eb ! number of time splits
556 INTEGER :: jdt ! time split loop index
557 !
558 REAL :: ztstep ! Local time split timestep (s)
559 REAL, DIMENSION(SIZE(PPS)) :: zwork,zwork2,zwork3,zwork4 ! Working variables [*]
560 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: zsnowcond ! snow thermal conductivity [W/(m K)]
561 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: zsnowhcap ! snow heat capacity [J/(m3 K)]
562 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: zsnowrho ! snow layer density (kg/m3)
563 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: zsnowage ! snow layer grain age
564 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: zsnowswe ! snow layer liquid water equivalent (kg/m2)
565 REAL, DIMENSION(SIZE(PSNOWSWE,1),SIZE(PSNOWSWE,2)) :: ztau_n ! snow rad transmission coef at layer base (-)
566 REAL, DIMENSION(SIZE(PPS)) :: zchip !
567 REAL, DIMENSION(SIZE(PPS)) :: zalbg ! Effective ground albedo
568 REAL, DIMENSION(SIZE(PPS)) :: zsigma_f ! LW transmission factor
569 REAL, DIMENSION(SIZE(PPS)) :: zsigma_fn ! LW transmission factor - including buried (snow)
570 ! ! vegetation effect
571 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_v_dtv ! LW Jacobian: flux derrivative d LWnet_v/dTv [W/(m K2)]
572 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_v_dtg ! LW Jacobian: flux derrivative d LWnet_v/dTg [W/(m K2)]
573 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_v_dtn ! LW Jacobian: flux derrivative d LWnet_v/dTn [W/(m K2)]
574 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_g_dtv ! LW Jacobian: flux derrivative d LWnet_g/dTv [W/(m K2)]
575 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_g_dtg ! LW Jacobian: flux derrivative d LWnet_g/dTg [W/(m K2)]
576 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_g_dtn ! LW Jacobian: flux derrivative d LWnet_g/dTn [W/(m K2)]
577 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_n_dtv ! LW Jacobian: flux derrivative d LWnet_n/dTv [W/(m K2)]
578 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_n_dtg ! LW Jacobian: flux derrivative d LWnet_n/dTg [W/(m K2)]
579 REAL, DIMENSION(SIZE(PPS)) :: zdlwnet_n_dtn ! LW Jacobian: flux derrivative d LWnet_n/dTn [W/(m K2)]
580 REAL, DIMENSION(SIZE(PPS)) :: zwrmax ! maximum canopy water equivalent interception capacity [kg/m2]
581 REAL, DIMENSION(SIZE(PPS)) :: zwrlmax ! maximum litter water equivalent interception capacity [kg/m2]
582 REAL, DIMENSION(SIZE(PPS)) :: zrs ! stomatal resistance (s/m)
583 REAL, DIMENSION(SIZE(PPS)) :: zrsn ! stomatal resistance of non-snow-buried canopy (s/m)
584 ! ! Etv=>0 as F2=>0 (-)
585 REAL, DIMENSION(SIZE(PPS)) :: zwrvnmax ! maximum snow water equivalent interception capacity (kg/m2)
586 REAL, DIMENSION(SIZE(PPS)) :: zpsncv ! intercepted canopy snow fraction (-) NOTE! Not the same as the
587 ! ! ground-based snowpack
588 REAL, DIMENSION(SIZE(PPS)) :: zmeltvn ! intercepted canopy snow net freeze/melt rate (kg/m2/s)
589 ! ! (if it is < 0, this signifies freezing)
590 REAL, DIMENSION(SIZE(PPS)) :: zthrma_ta ! linear transform energy budget coefficient for Ta
591 REAL, DIMENSION(SIZE(PPS)) :: zthrmb_ta ! linear transform energy budget coefficient for Ta
592 REAL, DIMENSION(SIZE(PPS)) :: zthrma_tc ! linear transform energy budget coefficient for Tc
593 REAL, DIMENSION(SIZE(PPS)) :: zthrmb_tc ! linear transform energy budget coefficient for Tc
594 REAL, DIMENSION(SIZE(PPS)) :: zthrma_tn ! linear transform energy budget coefficient for Tn
595 REAL, DIMENSION(SIZE(PPS)) :: zthrmb_tn ! linear transform energy budget coefficient for Tn
596 REAL, DIMENSION(SIZE(PPS)) :: zthrma_tg ! linear transform energy budget coefficient for Tg
597 REAL, DIMENSION(SIZE(PPS)) :: zthrmb_tg ! linear transform energy budget coefficient for Tg
598 REAL, DIMENSION(SIZE(PPS)) :: zthrma_tv ! linear transform energy budget coefficient for Tv
599 REAL, DIMENSION(SIZE(PPS)) :: zthrmb_tv ! linear transform energy budget coefficient for Tv
600 REAL, DIMENSION(SIZE(PPS)) :: zpet_a_coef ! atmospheric coupling coefficient: Ta
601 REAL, DIMENSION(SIZE(PPS)) :: zpet_b_coef ! atmospheric coupling coefficient: Ta
602 REAL, DIMENSION(SIZE(PPS)) :: zkvn ! snow interception efficiency
603 REAL, DIMENSION(SIZE(PPS)) :: zvelc ! wind speed at the top of the canopy (m/s)
604 REAL, DIMENSION(SIZE(PPS)) :: zdelta ! fraction of the foliage
605 ! ! covered with intercepted water (-)
606 REAL, DIMENSION(SIZE(PPS)) :: zhugi ! humidity over frozen bare ground (-)
607 REAL, DIMENSION(SIZE(PPS)) :: zhvn ! Halstead coefficient vegetation canopy above snow (-)
608 REAL, DIMENSION(SIZE(PPS)) :: zhvg ! Halstead coefficient vegetation canopy above snow-free ground (-)
609 REAL, DIMENSION(SIZE(PPS)) :: zleg_delta ! soil evaporation delta fn (-)
610 REAL, DIMENSION(SIZE(PPS)) :: zlegi_delta ! soil sublimation delta fn (-)
611 REAL, DIMENSION(SIZE(PPS)) :: zhsgl ! surface halstead cofficient for bare soil (-)
612 REAL, DIMENSION(SIZE(PPS)) :: zhsgf ! surface halstead cofficient for bare soil ice (-)
613 REAL, DIMENSION(SIZE(PPS)) :: zflxc_c_a ! turb transfer coef between vegetation canopy air and atmosphere (kg/m2/s)
614 REAL, DIMENSION(SIZE(PPS)) :: zflxc_n_a ! ...between the snow on the ground and atmosphere (kg/m2/s)
615 REAL, DIMENSION(SIZE(PPS)) :: zflxc_g_c ! ...between snow-free ground and canopy air (kg/m2/s)
616 REAL, DIMENSION(SIZE(PPS)) :: zflxc_n_c ! ...between snow on the ground and canopy air (kg/m2/s)
617 REAL, DIMENSION(SIZE(PPS)) :: zflxc_vg_c ! ...between vegetation canopy over snow-free ground and canopy air (kg/m2/s)
618 REAL, DIMENSION(SIZE(PPS)) :: zflxc_vn_c ! ...between vegetation canopy over the snow on the ground and canopy air (kg/m2/s)
619 REAL, DIMENSION(SIZE(PPS)) :: zflxc_v_c ! ...between vegetation canopy and canopy air (kg/m2/s)
620 REAL, DIMENSION(SIZE(PPS)) :: zflxc_mom ! Effective drag coefficient for momentum [kg/(m2 s)]
621 REAL, DIMENSION(SIZE(PPS)) :: zqsatg ! saturation specific humidity for PTG (ground surface: kg kg-1)
622 REAL, DIMENSION(SIZE(PPS)) :: zqsatv ! saturation specific humidity for PTV (vegetation canopy: kg kg-1)
623 REAL, DIMENSION(SIZE(PPS)) :: zqsatc ! saturation specific humidity for PTC (canopy air: kg kg-1)
624 REAL, DIMENSION(SIZE(PPS)) :: zqsatn ! saturation specific humidity for PSNOWTEMP (snow surface: kg kg-1)
625 REAL, DIMENSION(SIZE(PPS)) :: zdeltavk ! canopy interception capacity fraction including K-factor (-)
626 REAL, DIMENSION(SIZE(PPS)) :: zcheatv ! Vegetation canopy *effective surface* heat capacity (J m-2 K-1)
627 REAL, DIMENSION(SIZE(PPS)) :: zcheatg ! Understory-ground *effective surface* heat capacity (J m-2 K-1)
628 REAL, DIMENSION(SIZE(PPS)) :: zcheatn ! Ground-based snow *effective surface* heat capacity (J m-2 K-1)
629 REAL, DIMENSION(SIZE(PPS)) :: zhvgs ! Dimensionless pseudo humidity factor for computing
630 ! ! vapor fluxes from the non-buried part of the canopy
631 ! ! to the canopy air (-)
632 REAL, DIMENSION(SIZE(PPS)) :: zhvns ! Dimensionless pseudo humidity factor for computing
633 ! ! vapor fluxes from the partly-buried part of the canopy
634 ! ! to the canopy air (-)
635 REAL, DIMENSION(SIZE(PPS)) :: zdqsat_g ! saturation specific humidity derivative for understory (kg kg-1 K-1)
636 REAL, DIMENSION(SIZE(PPS)) :: zdqsat_v ! saturation specific humidity derivative for the
637 ! ! vegetation canopy (kg kg-1 K-1)
638 REAL, DIMENSION(SIZE(PPS)) :: zdqsati_n ! saturation specific humidity derivative over ice for
639 ! ! the ground-based snowpack (kg kg-1 K-1)
640 REAL, DIMENSION(SIZE(PPS)) :: zdeltat_g ! Time change in soil surface temperature (K)
641 REAL, DIMENSION(SIZE(PPS)) :: zdeltat_v ! Time change in vegetation canopy temperature (K)
642 REAL, DIMENSION(SIZE(PPS)) :: zdeltat_n ! Time change in snowpack surface temperature (K)
643 REAL, DIMENSION(SIZE(PPS)) :: zrnet_v ! Net vegetation canopy radiation (W/m2)
644 REAL, DIMENSION(SIZE(PPS)) :: zrnet_g ! Net understory-ground radiation (W/m2)
645 REAL, DIMENSION(SIZE(PPS)) :: zflxc_c_a_f ! Exchange coefficient between the snow on the ground and
646 ! ! atmosphere modified by a partially to fully buried
647 ! ! vegetation canopy [kg/(m2 s)]
648 REAL, DIMENSION(SIZE(PPS)) :: zflxc_n_a_f ! Exchange coefficient between vegetation canopy air and
649 ! ! atmosphere modified by a partially to fully buried
650 ! ! vegetation canopy [kg/(m2 s)]
651 REAL, DIMENSION(SIZE(PPS)) :: zevap_c_a ! Total canopy evapotranspiration and sublimation
652 ! ! of intercepted snow (kg/m2/s)
653 REAL, DIMENSION(SIZE(PPS)) :: zevap_n_a ! Vapor flux from the ground-based snowpack (part burying
654 ! ! the canopy vegetation) to the atmosphere (kg/m2/s)
655 REAL, DIMENSION(SIZE(PPS)) :: zh_n_a ! Sensible heat flux from the ground-based snowpack (part
656 ! ! burying the canopy vegetation) to the atmosphere (W/m2)
657 REAL, DIMENSION(SIZE(PPS)) :: zvegfact ! Fraction of canopy vegetation possibly receiving
658 ! ! rainfall (-)
659 REAL, DIMENSION(SIZE(PPS)) :: zrrsfc ! The sum of all non-intercepted rain and canopy drip (kg/m2/s)
660 REAL, DIMENSION(SIZE(PPS)) :: zrrsfcl ! The sum of all non-intercepted rain and drip from (kg/m2/s)
661  ! litter
662 REAL, DIMENSION(SIZE(PPS)) :: zles3l ! latent heat flux - sublimation of ice from the ground
663 ! ! based snowpack (W/m2)
664 REAL, DIMENSION(SIZE(PPS)) :: zlel3l ! latent heat flux - evaporation of liquid water from the
665 ! ! ground based snowpack (W/m2))
666 REAL, DIMENSION(SIZE(PPS)) :: zevap3l ! total mass loss via evap & sublm from the ground based snowpack (kg/m2/s)
667 REAL, DIMENSION(SIZE(PPS)) :: zustar2_ic ! friction velocity (possibly implicitly coupled) (m/s)
668 REAL, DIMENSION(SIZE(PPS)) :: zta_ic ! atmospheric temperature (possibly implicitly coupled) (m/s)
669 REAL, DIMENSION(SIZE(PPS)) :: zqa_ic ! atmospheric specific humidity (possibly implicitly coupled) (m/s)
670 REAL, DIMENSION(SIZE(PPS)) :: zswup ! net upwelling shortwave radiation [W/m2]
671 REAL, DIMENSION(SIZE(PPS)) :: zlwup ! net upwelling longwave radiation [W/m2]
672 REAL, DIMENSION(SIZE(PPS)) :: zustar2snow ! snow fraciton velocity squared (m2/s2)
673 REAL, DIMENSION(SIZE(PPS)) :: zvmod ! lowest level atmospheric wind speed update estimate (K)
674 REAL, DIMENSION(SIZE(PPS)) :: zrr ! combined rain rate (above canopy) and irrigation need (kg/m2/s)
675 REAL, DIMENSION(SIZE(PPS)) :: zflsn_cor ! snow/soil-biomass correction flux (W/m2) (not MEB)
676 REAL, DIMENSION(SIZE(PPS)) :: zwsfc ! surface liquid water content for resistances (m3/m3)
677 REAL, DIMENSION(SIZE(PPS)) :: zwisfc ! surface frozen water content for resistances (m3/m3)
678 REAL, DIMENSION(SIZE(PPS)) :: zlesfc ! evaporation from the surface (soil or litter) (W/m2)
679 REAL, DIMENSION(SIZE(PPS)) :: zlesfci ! sublimation from the surface (soil or litter) (W/m2)
680 REAL, DIMENSION(SIZE(PPS)) :: zpermsnowfrac ! fraction of permanent snow/ice
681 !
682 ! - TR_ML radiation option: NOTE...always used by MEB
683 !
684 REAL, DIMENSION(SIZE(PPS),SIZE(PABC)) :: ziacan_sunlit ! Absorbed PAR of each level within the
685 REAL, DIMENSION(SIZE(PPS),SIZE(PABC)) :: ziacan_shade ! canopy - Split into SHADEd and SUNLIT
686 REAL, DIMENSION(SIZE(PPS),SIZE(PABC)) :: zfrac_sun ! fraction of sunlit leaves
687 !
688 REAL, DIMENSION(SIZE(PPS)) :: zlai ! Potentially covered/buried canopy LAI (m2/m2)
689 REAL, DIMENSION(SIZE(PPS)) :: zalbvis_tsoil ! average snow-free ground VIS albedo (soil plus flooded fraction)
690 REAL, DIMENSION(SIZE(PPS)) :: zalbnir_tsoil ! average snow-free ground NIR albedo (soil plus flooded fraction)
691 REAL, DIMENSION(SIZE(PPS)) :: zswnet_s ! Net SW radiation at the surface (below canopy snow/ground/flooded zone)
692 !
693 !
694 ! - CPHOTO/=NON (Ags Option(s)):
695 !
696 REAL, DIMENSION(SIZE(PPS)) :: zqsat ! CPHOTO/=NON (Ags Option(s))diagnosed (past time step) Qsat relative to canopy (for Ags)
697 REAL, DIMENSION(SIZE(PPS)) :: zffv ! submerged vegetation (by flooding) fraction (-)
698 REAL, DIMENSION(SIZE(PPS),SIZE(PABC)) :: ziacan ! PAR in the canopy at different gauss levels: local working needed if
699 ! ! Ags if off (i.e. CPHOTO==NON)
700 !
701 REAL, DIMENSION(:,:), ALLOCATABLE :: ztgl ! Temporary temperature of litter + soil
702 REAL, DIMENSION(:,:), ALLOCATABLE :: zsoilhcapz ! Temporary heat capacity of litter + soil
703 REAL, DIMENSION(:,:), ALLOCATABLE :: zsoilcondz ! Temporary heat conductivity of litter + soil
704 REAL, DIMENSION(:,:), ALLOCATABLE :: zd_g ! Temporary depth of bottom litter + soil layers
705 REAL, DIMENSION(:,:), ALLOCATABLE :: zdzg ! Temporary thickness of litter + soil layers
706 REAL, DIMENSION(:,:), ALLOCATABLE :: zwfc ! Temporary Wfc of bottom litter + soil layers
707 REAL, DIMENSION(:,:), ALLOCATABLE :: zwsat ! Temporary Wsat of bottom litter + soil layers
708 !
709 ! Working sums for flux averaging over MEB time split
710 !
711 REAL, DIMENSION(SIZE(PPS)) :: zh_sum, zh_c_a_sum, zh_n_a_sum, zh_v_c_sum, zh_g_c_sum, &
712  zh_n_c_sum, zhsnow_sum, zhpsnow_sum
713 REAL, DIMENSION(SIZE(PPS)) :: zhu_agg_sum, zac_agg_sum
714 
715 REAL, DIMENSION(SIZE(PPS)) :: zle_sum, zle_c_a_sum, zle_v_c_sum, zle_g_c_sum, &
716  zle_n_c_sum, zletr_v_c_sum, zleg_sum,zlegi_sum,zlesfc_sum,&
717  zlesfci_sum, &
718  zler_v_c_sum, zle_flood_sum, zlei_flood_sum, &
719  zles_v_c_sum, zletr_sum, zler_sum, zlev_sum, &
720  zlei_sum, zles3l_sum, zlel3l_sum, zevap3l_sum, &
721  zustar2_sum, zustar2snow_sum, zcdsnow_sum, &
722  zchsnow_sum, zrisnow_sum, zevap_sum
723 
724 REAL, DIMENSION(SIZE(PPS)) :: zgrndflux_sum, zrestore_sum
725 
726 REAL, DIMENSION(SIZE(PPS)) :: zswnet_v_sum, zswnet_g_sum, zswnet_n_sum, zlwnet_v_sum, &
727  zlwnet_g_sum, zlwnet_n_sum, zemist_sum, zswup_sum, &
728  zlwup_sum
729 REAL, DIMENSION(SIZE(PPS)) :: zdelheatg_sfc_sum, zdelheatv_sfc_sum, zdelheatg_sum
730 !
731 REAL(KIND=JPRB) :: zhook_handle
732 !
733 INTEGER :: ini, inl, jj, jl
734 REAL, DIMENSION(SIZE(PWR)) :: zphasel ! Phase changement in litter (W/m2)
735 REAL, DIMENSION(SIZE(PWR)) :: zctsfc
736 REAL, DIMENSION(SIZE(PFROZEN1)) :: zfrozen1sfc
737 !-------------------------------------------------------------------------------
738 !
739 !* 1.0 Preliminaries
740 ! -------------
741 !
742 IF (lhook) CALL dr_hook('ISBA_MEB',0,zhook_handle)
743 !
744 !
745 piacan(:,:) = 0.
746 pfapar(:) = 0.
747 pfapir(:) = 0.
748 pfapar_bs(:) = 0.
749 pfapir_bs(:) = 0.
750 prrlit(:) =0.0
751 pdriplit(:) =0.0
752 !
753 plegi(:) = 0.
754 pleg(:) = 0.
755 zlesfci(:)= 0.
756 zlesfc(:) = 0.
757 !
758 ziacan_sunlit(:,:) = xundef
759 ziacan_shade(:,:) = xundef
760 zfrac_sun(:,:) = xundef
761 zlai(:) = xundef
762 zalbvis_tsoil(:) = xundef
763 zalbnir_tsoil(:) = xundef
764 zswnet_s(:) = xundef
765 zqsat(:) = xundef
766 zwork(:) = xundef
767 zwork2(:) = xundef
768 zwork3(:) = xundef
769 zwork4(:) = xundef
770 !
771 !* 1.1 Preliminaries for litter parameters
772 ! -----------------------------------
773 !
774 ini=SIZE(pwg,1)
775 inl=SIZE(pwg,2)
776 !
777  CALL allocate_local_vars_prep_grid_soil
778 !
779 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
780 !
781 !* 1.2 Preliminaries for litter temperature
782 ! ------------------------------------
783 !
784 ! Concatenate PTL and PTG and the parameters linked to heat transfer into the soil
785 !
786  CALL prep_meb_soil(omeb_litter,psoilhcapz,psoilcondz,pwsat,pwfc,pd_g,pdzg,ptg, &
787  pwg(:,1),pwgi(:,1),pwrl,pwrli,ptl,pgndlitter,zd_g,zdzg,ztgl, &
788  zsoilhcapz,zsoilcondz,zwsat,zwfc,zwsfc,zwisfc,zctsfc,pct, &
789  pfrozen1,zfrozen1sfc )
790 !
791 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
792 !
793 !* 2.0 Preliminaries for energy and radiation budget
794 ! ---------------------------------------------
795 !
796 zpermsnowfrac(:) = pvegtype(:,nvt_snow)
797 !
798 ! Local working:
799 ! - possibly adjust these prognostic variables locally, but do not save
800 !
801 zsnowrho(:,:) = psnowrho(:,:)
802 zsnowage(:,:) = psnowage(:,:)
803 zsnowswe(:,:) = psnowswe(:,:)
804 !
805  CALL preps_for_meb_ebud_rad(pps, &
806  plai,zsnowrho,zsnowswe,psnowheat, &
807  psnowtemp,psnowdz,zsnowcond,zsnowhcap,pemisnow, &
808  zsigma_f,zchip, &
809  ptstep,psr,pta,pvmod,zsnowage,zpermsnowfrac )
810 !
811 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
812 !
813 !* 3.0 Shortwave radiative transfer
814 ! ----------------------------
815 !
816 ! Calculate snow albedo: split into spectral bands:
817 !
818  CALL snowalb_spectral_bands_meb(pvegtype,psnowalb,zsnowrho,zsnowage,pps, &
819  ppsn,psnowdz,pzenith, &
820  psnowalbvis,psnowalbnir,psnowalbfir,ztau_n)
821 !
822 !
823 ! NOTE, currently MEB only uses 2 of 3 potential snow albedo spectral bands
824 !
825 !
826 WHERE(psnowalb(:) /= xundef)
827  zlai(:) = plai(:)*(1.0-ppalphan(:))
828  zalbvis_tsoil(:) = palbvis_tsoil(:)*(1.-ppsn(:)) + ppsn(:)*psnowalbvis(:)
829  zalbnir_tsoil(:) = palbnir_tsoil(:)*(1.-ppsn(:)) + ppsn(:)*psnowalbnir(:)
830 ELSEWHERE
831  zlai(:) = plai(:)
832  zalbvis_tsoil(:) = palbvis_tsoil(:)
833  zalbnir_tsoil(:) = palbnir_tsoil(:)
834 END WHERE
835 !
836  CALL radiative_transfert(oagri_to_grass, pvegtype, &
837  palbvis_tveg, zalbvis_tsoil, palbnir_tveg, zalbnir_tsoil, &
838  psw_rad, zlai, pzenith, pabc, &
839  pfaparc, pfapirc, pmus, plai_effc, oshade, ziacan, &
840  ziacan_sunlit, ziacan_shade, zfrac_sun, &
841  pfapar, pfapir, pfapar_bs, pfapir_bs )
842 
843 ! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
844 ! albedo: diagnosed from shortwave energy budget closure
845 
846 palbt(:) = 1. - (xsw_wght_vis*(pfapar(:)+pfapar_bs(:)) + &
847  xsw_wght_nir*(pfapir(:)+pfapir_bs(:)))
848 zswup(:) = psw_rad(:)*palbt(:)
849 palbt(:) = zswup(:)/max(1.e-5, psw_rad(:))
850 
851 ! Diagnose all-wavelength SW radiative budget components:
852 
853 pswnet_v(:) = psw_rad(:)*(xsw_wght_vis*pfapar(:) + &
854  xsw_wght_nir*pfapir(:) )
855 zswnet_s(:) = psw_rad(:)*(xsw_wght_vis*pfapar_bs(:) + &
856  xsw_wght_nir*pfapir_bs(:))
857 pswnet_n(:) = zswnet_s(:)* ppsn(:)
858 pswnet_g(:) = zswnet_s(:)*(1.-ppsn(:))
859 
860 ! Quantity of net shortwave radiation absorbed in surface snow layer
861 
862 pswnet_ns(:) = pswnet_n(:)*(1.0 - ztau_n(:,1))
863 
864 ! Compute all-wavelength effective ground albedo
865 
866 zalbg(:) = xsw_wght_nir*zalbnir_tsoil(:) + &
867  xsw_wght_vis*zalbvis_tsoil(:)
868 
869 ! Any SW radiation reaching the base of the lowest snow layer can pass
870 ! into the soil:
871 
872 ztau_n(:,SIZE(psnowswe,2)) = ztau_n(:,SIZE(psnowswe,2))*(1.-zalbg(:))
873 
874 ! Downwelling SW radiation arriving at ground/snow surface
875 
876 pswdown_gn(:) = zswnet_s(:)/(1.-zalbg(:))
877 !
878 !
879 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
880 !
881 !* 4.0 Longwave radiative transfer
882 ! ---------------------------
883 !
884  CALL isba_lwnet_meb(plai,ppsn,ppalphan, &
885  pemisnow,pfemis,pff, &
886  ptv,ztgl(:,1),psnowtemp(:,1), &
887  plw_rad,plwnet_n,plwnet_v,plwnet_g, &
888  zdlwnet_v_dtv,zdlwnet_v_dtg,zdlwnet_v_dtn, &
889  zdlwnet_g_dtv,zdlwnet_g_dtg,zdlwnet_g_dtn, &
890  zdlwnet_n_dtv,zdlwnet_n_dtg,zdlwnet_n_dtn, &
891  zsigma_f,zsigma_fn,plwdown_gn )
892 !
893 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
894 !
895 !* 5.0 Fraction of leaves occupied by intercepted water
896 ! ------------------------------------------------
897 !
898 ! Vegetation canopy:
899 !
900 ! First, compute an effective veg fraction: it can only be < unity if vegetation is buried by snowpack...
901 !
902 zwork(:) = (1.0 - ppsn(:) + ppsn(:)*(1.0 - ppalphan(:)))
903 !
904  CALL wet_leaves_frac(pwr, zwork, pwrmax_cf, pz0_mebv, plai, zwrmax, zdelta)
905 !
906 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
907 !
908 !* 6.0 Plant stress, stomatal resistance and, possibly, CO2 assimilation
909 ! --------------------------------------------------------------------
910 !
911 ! MEB-NOTE here assumed HPHOTO=='DEF' or 'AST' for now
912 ! More Ags options to be added later
913 !
914 IF (hphoto=='NON') THEN
915 !
916 ! Canopy vegetation (no snow, or snow below the main part of the canopy):
917 !
918  CALL veg(psw_rad, ptc, pqc, pps, prgl, plai, prsmin, pgamma, pf2, zrs)
919 !
920 !
921 ELSE IF (maxval(pgmes) /= xundef .OR. minval(pgmes) /= xundef) THEN
922 !
923 ! NOTE: For now we assume that forest canopy can be flooded.
924 ! However, we need to likely compute a fraction like PALPHAN (for snow vertical extent)
925 ! for floods for grasses/crops/shrubs...i.e. low vegetation
926 
927  zffv(:) = 0.0
928 
929  zqsat(:) = qsat(ptv,pps)
930  CALL cotwores(ptstep, hphoto, otr_ml, oshade, &
931  pvegtype, ostressdef, pah, pbh, pf2i, pdmax, &
932  ppoi, pcsp, ptv, pf2, psw_rad, presa, pqc, zqsat, ple, &
933  ppalphan, zdelta, plai, prhoa, pzenith, pfzero, pepso, &
934  pgamm, pqdgamm, pgmes, pgc, pqdgmes, pt1gmes, pt2gmes, &
935  pamax, pqdamax, pt1amax, pt2amax, zffv, &
936  ziacan_sunlit, ziacan_shade, zfrac_sun, ziacan, &
937  pabc, pan, panday, zrs, panfm, pgpp, panf, presp_biomass_inst(:,1))
938 !
939  piacan(:,:) = ziacan(:,:)
940 !
941 ELSE
942  presp_biomass_inst(:,1) = 0.0
943  pgpp(:) = 0.0
944 ENDIF
945 !
946 ! Additional resistance for possibly snow-buried canopy vegetation:
947 !
948 zrsn(:) = zrs(:)/( 1.0 - min(ppalphan(:), 1.0 - (zrs(:)/xrs_max)) )
949 !
950 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
951 !
952 !* 6.0 Canopy snow (intercepted) needed diagnostics:
953 ! ---------------------------------------------
954 !
955  CALL snow_leaves_frac_meb(ppsn,ppalphan,pwrvn,ptv,zchip,plai, &
956  zwrvnmax,zpsncv,zmeltvn)
957 !
958 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
959 !
960 !* 7.0 Aerodynamic drag and heat/mass transfer/fluxes
961 ! and energy budget solution
962 ! ----------------------------------------------
963 !
964 ! NOTE, this assumes thermodynamic variable herein is potential T
965 
966 zpet_a_coef(:) = -ppet_a_coef(:)*xcpd
967 zpet_b_coef(:) = ppet_b_coef(:)*xcpd
968 zthrma_ta(:) = xcpd/pexna(:)
969 zthrmb_ta(:) = 0.0
970 zwork(:) = xcpd/pexns(:)
971 zthrma_tc(:) = zwork(:)
972 zthrmb_tc(:) = 0.0
973 zthrma_tn(:) = zwork(:)
974 zthrmb_tn(:) = 0.0
975 zthrma_tg(:) = zwork(:)
976 zthrmb_tg(:) = 0.0
977 zthrma_tv(:) = zwork(:)
978 zthrmb_tv(:) = 0.0
979 !
980 !
981 ! Possibly split time step if large:
982 ! Although the energy budget is fully implicit, a very small canopy heat capacity
983 ! (and neglect of canopy air space heat capacity) can possibly lead to
984 ! numerical shocks, especially during transition periods between stable and unstable
985 ! regimes. Thus, for relatively large steps, a simple time split scheme is activated.
986 ! Note that soil moisture is held constant, while turbulent exchange coefficients are updated during the split.
987 ! Also, experience shows that splitting at least once for moderately sized time steps
988 ! is quite effective in removing any lingering small but possible oscillations.
989 ! Finally, for *very* small time steps (such as those for high res runs), no split is performed.
990 ! Fluxes are averaged over the time split for conservation.
991 !
992 jtsplit_eb = 1 + int(ptstep/ztstep_eb) ! number of split-time steps
993 ztstep = ptstep/jtsplit_eb ! split time step...for relatively small time steps, no split
994 !
995 ! initialize time split sums for fluxes:
996 !
997  CALL init_sum_fluxes_meb_tsplit
998 !
999 !
1000 ! Note, when implicitly coupled to the atmosphere, these
1001 ! 3 variables will evolve during the split...we used updated
1002 ! values for turbulent exchange computations (drag_meb).
1003 ! NOTE...when explicit coupling used, these 3 variables do NOT vary
1004 ! during the split.
1005 !
1006 zvmod(:) = pvmod(:)
1007 zta_ic(:) = pta(:)
1008 zqa_ic(:) = pqa(:)
1009 !
1010 !
1011 loop_time_split_eb: DO jdt=1,jtsplit_eb
1012 !* 7.1 Aerodynamic drag and heat transfer coefficients
1013 ! -----------------------------------------------
1014 !
1015  CALL drag_meb(oforc_measure, &
1016  ztgl(:,1), ptc, ptv, psnowtemp(:,1), &
1017  zta_ic, pqc, zqa_ic, zvmod, &
1018  zwsfc, zwisfc, zwsat(:,1), zwfc(:,1), &
1019  pexns, pexna, pps, &
1020  prr, psr, prhoa, pz0g_without_snow, &
1021  pz0_mebv, pz0h_mebv, pz0eff_mebv, &
1022  pz0_mebn, pz0h_mebn, pz0eff_mebn, &
1023  pz0_with_snow, pz0h_with_snow, pz0eff, &
1024  zsnowswe(:,1), &
1025  pwr, zchip, ztstep, zrs, zrsn, &
1026  ppsn, ppalphan, pzref, puref, ph_veg, pdircoszw, &
1027  zpsncv, zdelta, plai, omeb_gndres, &
1028  pch, pcd, pcdn, pri, presa, zvelc, &
1029  pcdsnow, pchsnow, prisnow, zustar2snow, &
1030  phug, zhugi, phv, zhvg, zhvn, phu, pqs, prs, &
1031  zleg_delta, zlegi_delta, zhsgl, zhsgf, &
1032  zflxc_c_a, zflxc_n_a, zflxc_g_c, zflxc_n_c, &
1033  zflxc_vg_c, zflxc_vn_c, zflxc_mom, &
1034  zqsatg, zqsatv, zqsatc, zqsatn, zdeltavk )
1035 !
1036  zkvn(:) = snow_intercept_eff(zchip,zvelc,zwrvnmax)
1037 
1038 !* 7.2 Resolution of the surface energy budgets
1039 ! ----------------------------------------
1040 !
1041  CALL e_budget_meb(hisba,hcpsurf,ztstep, &
1042  pps,pcg,zctsfc,pcv,pwrvn,pwr, &
1043  ptdeep_a,ptdeep_b,zd_g,zsoilcondz,zsoilhcapz, &
1044  psnowdz,zsnowcond,zsnowhcap, &
1045  pswnet_v,pswnet_g,pswnet_ns,ztau_n, &
1046  plwnet_v,plwnet_g,plwnet_n, &
1047  zdlwnet_v_dtv,zdlwnet_v_dtg,zdlwnet_v_dtn, &
1048  zdlwnet_g_dtv,zdlwnet_g_dtg,zdlwnet_g_dtn, &
1049  zdlwnet_n_dtv,zdlwnet_n_dtg,zdlwnet_n_dtn, &
1050  ppew_a_coef,ppew_b_coef,zpet_a_coef,ppeq_a_coef,zpet_b_coef,ppeq_b_coef, &
1051  zthrma_ta,zthrmb_ta,zthrma_tc,zthrmb_tc, &
1052  zthrma_tg,zthrmb_tg,zthrma_tv,zthrmb_tv,zthrma_tn,zthrmb_tn, &
1053  zqsatg,zqsatv,zqsatn, &
1054  pff,pffrozen,ppsn,ppalphan,zpsncv, &
1055  zcheatv,zcheatg,zcheatn, &
1056  zleg_delta,zlegi_delta,phug,zhugi,zhvg,zhvn,zfrozen1sfc, &
1057  zflxc_c_a,zflxc_g_c,zflxc_vg_c,zflxc_vn_c,zflxc_n_c,zflxc_n_a, &
1058  zflxc_mom, &
1059  ztgl,ptv,psnowtemp, &
1060  zflxc_v_c,zhvgs,zhvns, &
1061  zdqsat_g,zdqsat_v,zdqsati_n, &
1062  ptc,pqc,zta_ic,zqa_ic,zustar2_ic,zvmod, &
1063  zdeltat_g,zdeltat_v,zdeltat_n,pgrndflux,pcps,plvtt,plstt, &
1064  phpsnow,pmeltadv,prestore,pdeep_flux, &
1065  pdelheatv_sfc,pdelheatg_sfc,pdelheatg )
1066 !
1067 !* 7.3 Energy and momentum fluxes and radiative temperature and emissivity
1068 ! -------------------------------------------------------------------
1069 !
1070  CALL isba_fluxes_meb(prhoa, &
1071  zsigma_f,zsigma_fn,pemisnow, &
1072  zrnet_v,zrnet_g,prnsnow, &
1073  pswnet_v,pswnet_g,pswnet_n, &
1074  plwnet_v,plwnet_g,plwnet_n, &
1075  zdlwnet_v_dtv,zdlwnet_v_dtg,zdlwnet_v_dtn, &
1076  zdlwnet_g_dtv,zdlwnet_g_dtg,zdlwnet_g_dtn, &
1077  zdlwnet_n_dtv,zdlwnet_n_dtg,zdlwnet_n_dtn, &
1078  zthrma_ta,zthrmb_ta,zthrma_tc,zthrmb_tc, &
1079  zthrma_tg,zthrmb_tg,zthrma_tv,zthrmb_tv,zthrma_tn,zthrmb_tn, &
1080  zqsatg,zqsatv,zqsatn, &
1081  pff,ppsn,ppalphan,zpsncv,zfrozen1sfc,pffrozen, &
1082  zleg_delta,zlegi_delta,phug,zhugi,zhvg,zhvn, &
1083  zflxc_c_a,zflxc_g_c,zflxc_vg_c,zflxc_vn_c,zflxc_n_c,zflxc_n_a, &
1084  zflxc_mom,zflxc_v_c,zhvgs,zhvns, &
1085  ztgl,ptv,psnowtemp, &
1086  zdqsat_g,zdqsat_v,zdqsati_n, &
1087  ptc,pqc,zta_ic,zqa_ic, &
1088  zdeltavk, &
1089  zdeltat_g,zdeltat_v,zdeltat_n, &
1090  zswup,psw_rad,plw_rad, &
1091  prn,zlwup, &
1092  ph_c_a,ph_v_c,ph_g_c,ph_n_c,zh_n_a,phsnow,ph, &
1093  ple_c_a,ple_v_c,ple_g_c,ple_n_c, &
1094  zevap_c_a,plev_v_c,pevap_g_c,pevap_n_c,zevap_n_a, &
1095  pevap,psubl,pletr_v_c,pler_v_c,zlesfc,zlesfci, &
1096  ple_flood,plei_flood,zles3l,zlel3l, &
1097  zevap3l,ples_v_c,pletr,pler,plev,ple,plei, &
1098  pts_rad,pemist,plstt )
1099 !
1100 ! Compute aggregated coefficients for evaporation
1101 ! Sum(LEC+LES+LEL) = ACagg * Lv * RHOA * (HUagg.Qsat - Qa)
1102 !
1103  zflxc_c_a_f(:) = zflxc_c_a(:)*(1.0-ppsn(:)*ppalphan(:))
1104  zflxc_n_a_f(:) = zflxc_n_a(:)* ppsn(:)*ppalphan(:)
1105 
1106  phu_agg(:) = (zflxc_c_a_f(:)*pqc(:) + zflxc_n_a_f(:)*zqsatn(:))/ &
1107  (zflxc_c_a_f(:)*zqsatc(:) + zflxc_n_a_f(:)*zqsatn(:))
1108 
1109  pac_agg(:) = zflxc_c_a_f(:) + zflxc_n_a_f(:) ! kg/m2/s
1110 !
1111 ! Sum fluxes over time split:
1112 
1113  CALL sum_fluxes_meb_tsplit
1114 
1115 ENDDO loop_time_split_eb
1116 !
1117  CALL avg_fluxes_meb_tsplit ! average fluxes over time split
1118 !
1119 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1120 !
1121 !* 8.0 Snow explicit canopy loading/interception
1122 ! ------------------------------------------
1123 !
1124  CALL snow_load_meb(ptstep,psr,ptv,zwrvnmax,zkvn,zcheatv,pler_v_c,ples_v_c,zmeltvn, &
1125  zvelc,pmeltcv,pfrzcv,psr_gn,pwr,pwrvn,psubvcor,plvtt,plstt)
1126 !
1127 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1128 !
1129 !* 9.0 Snow explicit canopy loading/interception
1130 ! ------------------------------------------
1131 !
1132 zrr(:) = prr(:)
1133 pirrig_flux(:) = 0.0
1134 !
1135 !* add irrigation over vegetation to liquid precipitation (rr)
1136 ! Water "need" treated as if sprayed from above (over vegetation and soil):
1137 !
1138 IF (SIZE(oirrigate)>0) THEN
1139  WHERE (oirrigate(:) .AND. pirrig(:)>0. .AND. pirrig(:) /= xundef .AND. (pf2(:)<pthreshold(:)) )
1140  pirrig_flux(:) = pwatsup(:) / xday
1141  zrr(:) = prr(:) + pwatsup(:)/xday
1142  oirriday(:) = .true.
1143  END WHERE
1144 ENDIF
1145 !
1146 ! Call canopy interception...here because meltwater should be allowed to fall
1147 ! on understory snowpack
1148 !
1149 ! Fraction of canopy vegetation possibly receiving rainfall/irrigation
1150 !
1151 zvegfact(:) = zsigma_f(:)*(1.0-ppalphan(:)*ppsn(:))
1152 !
1153 ! The sum of all non-intercepted rain and drip is "ZRRSFC" (kg/m2/s):
1154 ! this is then partitioned by snow scheme into part falling on
1155 ! snowpack and part falling onto snow-free understory.
1156 !
1157 !
1158  CALL hydro_veg(hrain, ptstep, pmuf, &
1159  zrr, plev_v_c, pletr_v_c, zvegfact, zpsncv, &
1160  pwr, zwrmax, zrrsfc, pdrip, prrveg, plvtt )
1161 !
1162 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1163 !
1164 !* 10.0 Explicit snow scheme (MEB: impose surface fluxes as upper BC)
1165 ! ----------------------------------------------------------------
1166 !
1167  CALL snow3l_isba(hisba, hsnow_isba, hsnowres, omeb, oglacier, himplicit_wind, &
1168  tptime, ptstep, pvegtype, &
1169  psnowswe, psnowheat, psnowrho, psnowalb, &
1170  psnowgran1, psnowgran2, psnowhist,psnowage, &
1171  ztgl, pcg, zctsfc, zsoilhcapz, zsoilcondz(:,1), &
1172  pps, pta, psw_rad, pqa, pvmod, plw_rad, zrrsfc, psr_gn, &
1173  prhoa, puref, pexns, pexna, pdircoszw, plvtt, plstt, &
1174  pzref, pz0_with_snow, pz0eff, pz0h_with_snow, zalbg, zd_g, zdzg, &
1175  ppew_a_coef, ppew_b_coef, &
1176  ppet_a_coef, ppeq_a_coef, ppet_b_coef, ppeq_b_coef, &
1177  psnow_thrufal, pgrndflux, pflsn_cor, prestoren, pevapcor, &
1178  pswnet_n, pswnet_ns, plwnet_n, &
1179  prnsnow, phsnow, pgfluxsnow, phpsnow, ples, plesl, zevap3l, &
1180  psndrift, pustarsnow, &
1181  ppsn, psrsfc, prrsfc, psnowsfch, pdelheatn, pdelheatn_sfc, &
1182  pemisnow, pcdsnow, pchsnow, psnowtemp, psnowliq, psnowdz, &
1183  psnowhmass, prisnow, pzenith, pdelheatg, pdelheatg_sfc, plat, plon, pqsnow, &
1184  osnowdrift, osnowdrift_sublim, osnow_abs_zenith, &
1185  hsnowmetamo, hsnowrad )
1186 !
1187 ! If a litter layer exists, compute hydrology:
1188 !
1189 IF(omeb_litter)THEN
1190 !
1191  zwork(:) = 0.
1192  zwork2(:) = pwrl(:)
1193  zwork3(:) = 1.
1194  zwork4(:) = psnow_thrufal(:) + zrrsfc(:)*(1-ppsn)
1195  zwrlmax(:) = pgndlitter(:)*zwfc(:,1)*xrholw
1196 
1197  CALL hydro_veg(hrain, ptstep, pmuf, &
1198  zwork4(:), zlesfc,zwork, zwork3, zwork,&
1199  pwrl , zwrlmax, zrrsfcl, pdriplit, prrlit, plvtt)
1200 !
1201  prrsfc(:) = zrrsfcl(:)
1202  psnow_thrufal_soil(:) = 0.0
1203 !
1204 ELSE
1205 !
1206  psnow_thrufal_soil(:) = psnow_thrufal(:)
1207 !
1208 ENDIF
1209 !
1210 !* 11.0 Separate litter and soil temperature
1211 ! ------------------------------------
1212 !
1213 
1214  CALL reshift_meb_soil(omeb_litter,ztgl,ptl,ptg,zlesfc,zlesfci, &
1215  pleg,plegi,plelitter,plelitteri)
1216 !
1217 !
1218 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1219 !
1220  CALL deallocate_local_vars_prep_grid_soil
1221 !
1222 IF(omeb_litter)THEN
1223 !
1224  CALL ice_litter(ptstep, plelitteri, &
1225  psoilhcapz, &
1226  ptg, ptl, pwgi, pwg, kwg_layer, &
1227  pdzg,pwrl,pwrli,pgndlitter,zphasel, &
1228  zctsfc,plstt,plitcor)
1229 !
1230 ENDIF
1231 !
1232 IF (lhook) CALL dr_hook('ISBA_MEB',1,zhook_handle)
1233 !
1234 !-------------------------------------------------------------------------------
1235 !
1236  CONTAINS
1237 !
1238 !===============================================================================
1239 !
1240 SUBROUTINE init_sum_fluxes_meb_tsplit
1241 !
1242 IMPLICIT NONE
1243 !
1244 !
1245 !* 0.2 declarations of local variables
1246 !
1247 REAL(KIND=JPRB) :: zhook_handle
1248 !
1249 !-------------------------------------------------------------------------------
1250 !
1251 IF (lhook) CALL dr_hook('ISBA_MEB:INIT_SUM_FLUXES_MEB_TSPLIT ',0,zhook_handle)
1252 !
1253 ! sensible heat fluxes:
1254 !
1255 zh_sum(:) = 0.0
1256 zh_c_a_sum(:) = 0.0
1257 zh_n_a_sum(:) = 0.0
1258 zh_v_c_sum(:) = 0.0
1259 zh_g_c_sum(:) = 0.0
1260 zh_n_c_sum(:) = 0.0
1261 zhsnow_sum(:) = 0.0
1262 !
1263 ! latent heat/water vapor fluxes:
1264 !
1265 zle_sum(:) = 0.0
1266 zle_c_a_sum(:) = 0.0
1267 zle_v_c_sum(:) = 0.0
1268 zle_g_c_sum(:) = 0.0
1269 zle_n_c_sum(:) = 0.0
1270 zletr_v_c_sum(:) = 0.0
1271 zleg_sum(:) = 0.0
1272 zlegi_sum(:) = 0.0
1273 zlesfc_sum(:) = 0.0
1274 zlesfci_sum(:) = 0.0
1275 zler_v_c_sum(:) = 0.0
1276 zle_flood_sum(:) = 0.0
1277 zlei_flood_sum(:)= 0.0
1278 zles_v_c_sum(:) = 0.0
1279 zletr_sum(:) = 0.0
1280 zler_sum(:) = 0.0
1281 zlev_sum(:) = 0.0
1282 zlei_sum(:) = 0.0
1283 zles3l_sum(:) = 0.0
1284 zlel3l_sum(:) = 0.0
1285 zevap3l_sum(:) = 0.0
1286 zevap_sum(:) = 0.0
1287 !
1288 zhu_agg_sum(:) = 0.0
1289 zac_agg_sum(:) = 0.0
1290 !
1291 ! momentum/turb:
1292 !
1293 zustar2_sum(:) = 0.0
1294 zustar2snow_sum(:) = 0.
1295 zcdsnow_sum(:) = 0.
1296 zchsnow_sum(:) = 0.
1297 zrisnow_sum(:) = 0.
1298 !
1299 ! surface interfacial/sub-surface heat fluxes:
1300 !
1301 zgrndflux_sum(:) = 0.0
1302 zrestore_sum(:) = 0.0
1303 zhpsnow_sum(:) = 0.0
1304 !
1305 ! radiative fluxes:
1306 !
1307 zswnet_v_sum(:) = 0.0
1308 zswnet_g_sum(:) = 0.0
1309 zswnet_n_sum(:) = 0.0
1310 zlwnet_v_sum(:) = 0.0
1311 zlwnet_g_sum(:) = 0.0
1312 zlwnet_n_sum(:) = 0.0
1313 zemist_sum(:) = 0.0
1314 zswup_sum(:) = 0.0
1315 zlwup_sum(:) = 0.0
1316 !
1317 zdelheatv_sfc_sum(:) = 0.0
1318 zdelheatg_sfc_sum(:) = 0.0
1319 zdelheatg_sum(:) = 0.0
1320 !
1321 IF (lhook) CALL dr_hook('ISBA_MEB:INIT_SUM_FLUXES_MEB_TSPLIT ',1,zhook_handle)
1322 !
1323 END SUBROUTINE init_sum_fluxes_meb_tsplit
1324 !
1325 !===============================================================================
1326 !
1327 SUBROUTINE sum_fluxes_meb_tsplit
1328 !
1329 IMPLICIT NONE
1330 !
1331 !* 0.2 declarations of local variables
1332 !
1333 REAL(KIND=JPRB) :: zhook_handle
1334 !
1335 !-------------------------------------------------------------------------------
1336 !
1337 IF (lhook) CALL dr_hook('ISBA_MEB:SUM_FLUXES_MEB_TSPLIT ',0,zhook_handle)
1338 !
1339 ! Sum fluxes over MEB TIME SPLIT:
1340 !
1341 ! sensible heat fluxes:
1342 
1343 zh_sum(:) = zh_sum(:) + ph(:)
1344 zh_c_a_sum(:) = zh_c_a_sum(:) + ph_c_a(:)
1345 zh_n_a_sum(:) = zh_n_a_sum(:) + zh_n_a(:)
1346 zh_v_c_sum(:) = zh_v_c_sum(:) + ph_v_c(:)
1347 zh_g_c_sum(:) = zh_g_c_sum(:) + ph_g_c(:)
1348 zh_n_c_sum(:) = zh_n_c_sum(:) + ph_n_c(:)
1349 zhsnow_sum(:) = zhsnow_sum(:) + phsnow(:)
1350 !
1351 ! latent heat/water vapor fluxes:
1352 !
1353 zle_sum(:) = zle_sum(:) + ple(:)
1354 zle_c_a_sum(:) = zle_c_a_sum(:) + ple_c_a(:)
1355 zle_v_c_sum(:) = zle_v_c_sum(:) + ple_v_c(:)
1356 zle_g_c_sum(:) = zle_g_c_sum(:) + ple_g_c(:)
1357 zle_n_c_sum(:) = zle_n_c_sum(:) + ple_n_c(:)
1358 zletr_v_c_sum(:) = zletr_v_c_sum(:) + pletr_v_c(:)
1359 zleg_sum(:) = zleg_sum(:) + pleg(:)
1360 zlegi_sum(:) = zlegi_sum(:) + plegi(:)
1361 zlesfc_sum(:) = zlesfc_sum(:) + zlesfc(:)
1362 zlesfci_sum(:) = zlesfci_sum(:) + zlesfci(:)
1363 zler_v_c_sum(:) = zler_v_c_sum(:) + pler_v_c(:)
1364 zle_flood_sum(:) = zle_flood_sum(:) + ple_flood(:)
1365 zlei_flood_sum(:)= zlei_flood_sum(:)+ plei_flood(:)
1366 zles_v_c_sum(:) = zles_v_c_sum(:) + ples_v_c(:)
1367 zletr_sum(:) = zletr_sum(:) + pletr(:)
1368 zler_sum(:) = zler_sum(:) + pler(:)
1369 zlev_sum(:) = zlev_sum(:) + plev(:)
1370 zlei_sum(:) = zlei_sum(:) + plei(:)
1371 zles3l_sum(:) = zles3l_sum(:) + zles3l(:)
1372 zlel3l_sum(:) = zlel3l_sum(:) + zlel3l(:)
1373 zevap3l_sum(:) = zevap3l_sum(:) + zevap3l(:)
1374 zevap_sum(:) = zevap_sum(:) + pevap(:)
1375 !
1376 zhu_agg_sum(:) = zhu_agg_sum(:) + phu_agg(:)
1377 zac_agg_sum(:) = zac_agg_sum(:) + pac_agg(:)
1378 !
1379 ! momentum/turb:
1380 !
1381 zustar2_sum(:) = zustar2_sum(:) + zustar2_ic(:)
1382 zustar2snow_sum(:) = zustar2snow_sum(:) + zustar2snow(:)
1383 zcdsnow_sum(:) = zcdsnow_sum(:) + pcdsnow(:)
1384 zchsnow_sum(:) = zchsnow_sum(:) + pchsnow(:)
1385 zrisnow_sum(:) = zrisnow_sum(:) + prisnow(:)
1386 !
1387 ! surface interfacial/sub-surface heat fluxes:
1388 !
1389 zgrndflux_sum(:) = zgrndflux_sum(:) + pgrndflux(:)
1390 zrestore_sum(:) = zrestore_sum(:) + prestore(:)
1391 zhpsnow_sum(:) = zhpsnow_sum(:) + phpsnow(:)
1392 !
1393 ! radiative fluxes:
1394 !
1395 zswnet_v_sum(:) = zswnet_v_sum(:) + pswnet_v(:)
1396 zswnet_g_sum(:) = zswnet_g_sum(:) + pswnet_g(:)
1397 zswnet_n_sum(:) = zswnet_n_sum(:) + pswnet_n(:)
1398 zlwnet_v_sum(:) = zlwnet_v_sum(:) + plwnet_v(:)
1399 zlwnet_g_sum(:) = zlwnet_g_sum(:) + plwnet_g(:)
1400 zlwnet_n_sum(:) = zlwnet_n_sum(:) + plwnet_n(:)
1401 zemist_sum(:) = zemist_sum(:) + pemist(:)
1402 zswup_sum(:) = zswup_sum(:) + zswup(:)
1403 zlwup_sum(:) = zlwup_sum(:) + zlwup(:)
1404 !
1405 zdelheatv_sfc_sum(:) = zdelheatv_sfc_sum(:) + pdelheatv_sfc(:)
1406 zdelheatg_sfc_sum(:) = zdelheatg_sfc_sum(:) + pdelheatg_sfc(:)
1407 zdelheatg_sum(:) = zdelheatg_sum(:) + pdelheatg(:)
1408 !
1409 IF (lhook) CALL dr_hook('ISBA_MEB:SUM_FLUXES_MEB_TSPLIT ',1,zhook_handle)
1410 !
1411 END SUBROUTINE sum_fluxes_meb_tsplit
1412 !
1413 !===============================================================================
1414 !
1415 SUBROUTINE avg_fluxes_meb_tsplit
1416 !
1417 USE modd_csts, ONLY : xstefan
1418 !
1419 IMPLICIT NONE
1420 !
1421 !* 0.2 declarations of local variables
1422 !
1423 REAL(KIND=JPRB) :: zhook_handle
1424 !
1425 !-------------------------------------------------------------------------------
1426 !
1427 IF (lhook) CALL dr_hook('ISBA_MEB:AVG_FLUXES_MEB_TSPLIT ',0,zhook_handle)
1428 !
1429 ! Average fluxes over MEB TIME SPLIT:
1430 !
1431 ! sensible heat fluxes:
1432 !
1433 ph(:) = zh_sum(:) /jtsplit_eb
1434 ph_c_a(:) = zh_c_a_sum(:) /jtsplit_eb
1435 zh_n_a(:) = zh_n_a_sum(:) /jtsplit_eb
1436 ph_v_c(:) = zh_v_c_sum(:) /jtsplit_eb
1437 ph_g_c(:) = zh_g_c_sum(:) /jtsplit_eb
1438 ph_n_c(:) = zh_n_c_sum(:) /jtsplit_eb
1439 phsnow(:) = zhsnow_sum(:) /jtsplit_eb
1440 !
1441 ! latent heat/water vapor fluxes:
1442 !
1443 ple(:) = zle_sum(:) /jtsplit_eb
1444 ple_c_a(:) = zle_c_a_sum(:) /jtsplit_eb
1445 ple_v_c(:) = zle_v_c_sum(:) /jtsplit_eb
1446 ple_g_c(:) = zle_g_c_sum(:) /jtsplit_eb
1447 ple_n_c(:) = zle_n_c_sum(:) /jtsplit_eb
1448 pletr_v_c(:) = zletr_v_c_sum(:) /jtsplit_eb
1449 pleg(:) = zleg_sum(:) /jtsplit_eb
1450 plegi(:) = zlegi_sum(:) /jtsplit_eb
1451 zlesfc(:) = zlesfc_sum(:) /jtsplit_eb
1452 zlesfci(:) = zlesfci_sum(:) /jtsplit_eb
1453 pler_v_c(:) = zler_v_c_sum(:) /jtsplit_eb
1454 ple_flood(:) = zle_flood_sum(:) /jtsplit_eb
1455 plei_flood(:)= zlei_flood_sum(:)/jtsplit_eb
1456 ples_v_c(:) = zles_v_c_sum(:) /jtsplit_eb
1457 pletr(:) = zletr_sum(:) /jtsplit_eb
1458 pler(:) = zler_sum(:) /jtsplit_eb
1459 plev(:) = zlev_sum(:) /jtsplit_eb
1460 plei(:) = zlei_sum(:) /jtsplit_eb
1461 ples(:) = zles3l_sum(:) /jtsplit_eb
1462 plesl(:) = zlel3l_sum(:) /jtsplit_eb
1463 zevap3l(:) = zevap3l_sum(:) /jtsplit_eb
1464 pevap(:) = zevap_sum(:) /jtsplit_eb
1465 !
1466 phu_agg(:) = zhu_agg_sum(:) /jtsplit_eb
1467 pac_agg(:) = zac_agg_sum(:) /jtsplit_eb
1468 !
1469 ! momentum/turb:
1470 !
1471 pustar(:) = sqrt( zustar2_sum(:) /jtsplit_eb )
1472 pustarsnow(:) = sqrt( zustar2snow_sum(:)/jtsplit_eb )
1473 pcdsnow(:) = zcdsnow_sum(:) /jtsplit_eb
1474 pchsnow(:) = zchsnow_sum(:) /jtsplit_eb
1475 prisnow(:) = zrisnow_sum(:) /jtsplit_eb
1476 !
1477 ! surface interfacial/sub-surface heat fluxes:
1478 !
1479 pgrndflux(:) = zgrndflux_sum(:) /jtsplit_eb
1480 prestore(:) = zrestore_sum(:) /jtsplit_eb
1481 phpsnow(:) = zhpsnow_sum(:) /jtsplit_eb
1482 !
1483 ! radiative fluxes:
1484 !
1485 pswnet_v(:) = zswnet_v_sum(:) /jtsplit_eb
1486 pswnet_g(:) = zswnet_g_sum(:) /jtsplit_eb
1487 pswnet_n(:) = zswnet_n_sum(:) /jtsplit_eb
1488 plwnet_v(:) = zlwnet_v_sum(:) /jtsplit_eb
1489 plwnet_g(:) = zlwnet_g_sum(:) /jtsplit_eb
1490 plwnet_n(:) = zlwnet_n_sum(:) /jtsplit_eb
1491 pemist(:) = zemist_sum(:) /jtsplit_eb
1492 zswup(:) = zswup_sum(:) /jtsplit_eb
1493 zlwup(:) = zlwup_sum(:) /jtsplit_eb
1494 !
1495 pdelheatv_sfc(:) = zdelheatv_sfc_sum(:) /jtsplit_eb
1496 pdelheatg_sfc(:) = zdelheatg_sfc_sum(:) /jtsplit_eb
1497 pdelheatg(:) = zdelheatg_sum(:) /jtsplit_eb
1498 !
1499 ! Additional diagnostics depending on AVG quantities:
1500 !
1501 pts_rad(:) = ((zlwup(:) - plw_rad(:)*(1.0-pemist(:)))/(xstefan*pemist(:)))**0.25
1502 !
1503 zrnet_v(:) = pswnet_v(:) + plwnet_v(:)
1504 !
1505 zrnet_g(:) = pswnet_g(:) + plwnet_g(:)
1506 !
1507 prnsnow(:) = pswnet_n(:) + plwnet_n(:)
1508 !
1509 prn(:) = zrnet_v(:) + zrnet_g(:) + prnsnow(:)
1510 !
1511 plev_v_c(:) = ple_v_c(:) - ples_v_c(:)
1512 !
1513 IF (lhook) CALL dr_hook('ISBA_MEB:AVG_FLUXES_MEB_TSPLIT ',1,zhook_handle)
1514 !
1515 END SUBROUTINE avg_fluxes_meb_tsplit
1516 !
1517 !===============================================================================
1518 SUBROUTINE snowalb_spectral_bands_meb(PVEGTYPE,PSNOWALB,PSNOWRHO,PSNOWAGE,PPS, &
1519  ppsn,psnowdz,pzenith, &
1520  psnowalbvis,psnowalbnir,psnowalbfir, &
1521  ptau_n)
1522 !
1523 ! Split Total snow albedo into N-spectral bands
1524 ! NOTE currently MEB only uses 2 bands of the 3 possible.
1525 !
1526 USE modd_surf_par, ONLY : xundef
1527 USE modd_data_cover_par, ONLY : nvt_snow
1528 USE modd_meb_par, ONLY : xsw_wght_vis, xsw_wght_nir
1529 USE modd_snow_par, ONLY : nspec_band_snow
1530 USE modd_snow_metamo, ONLY : xsnowdzmin
1531 !
1532 USE mode_snow3l, ONLY : snow3lalb, snow3ldopt
1533 !
1534 IMPLICIT NONE
1535 !
1536 !* 0.1 declarations of arguments
1537 !
1538 REAL, DIMENSION(:,:), INTENT(IN) :: pvegtype ! fraction of each vegetation (-)
1539 REAL, DIMENSION(:), INTENT(IN) :: psnowalb ! Snow albedo (total)
1540 REAL, DIMENSION(:,:), INTENT(IN) :: psnowrho ! Snow layer average density (kg/m3)
1541 REAL, DIMENSION(:,:), INTENT(IN) :: psnowdz ! Snow layer thickness (m)
1542 REAL, DIMENSION(:), INTENT(IN) :: pzenith ! Zenith angle (rad)
1543 REAL, DIMENSION(:), INTENT(IN) :: ppsn ! snow fraction (-)
1544 REAL, DIMENSION(:,:), INTENT(IN) :: psnowage ! Snow grain age
1545 REAL, DIMENSION(:), INTENT(IN) :: pps ! Pressure [Pa]
1546 REAL, DIMENSION(:), INTENT(OUT) :: psnowalbvis ! Snow VIS albedo
1547 REAL, DIMENSION(:), INTENT(OUT) :: psnowalbnir ! Snow NIR albedo
1548 REAL, DIMENSION(:), INTENT(OUT) :: psnowalbfir ! Snow FIR (UV) albedo
1549 REAL, DIMENSION(:,:), INTENT(OUT) :: ptau_n ! SW absorption (coef) in uppermost snow layer (-)
1550 !
1551 !* 0.2 declarations of local variables
1552 !
1553 INTEGER :: jj, ji, ini, inlvls
1554 REAL, DIMENSION(SIZE(PPS)) :: zwork, zworka, zage
1555 REAL, DIMENSION(SIZE(PPS)) :: zprojlat, zdsgrain, zbeta1, zbeta2, zbeta3, &
1556  zopticalpath1, zopticalpath2, zopticalpath3
1557 REAL, DIMENSION(SIZE(PPS)) :: zpermsnowfrac
1558 REAL, DIMENSION(SIZE(PSNOWDZ,1),SIZE(PSNOWDZ,2)) :: zsnowdz
1559 REAL, DIMENSION(SIZE(PPS),NSPEC_BAND_SNOW) :: zspectralalbedo
1560 ! ZSPECTRALALBEDO = spectral albedo (3 bands in algo:
1561 ! MEB currently uses 2)
1562 ! 1=VIS, 2=NIR, 3=UV
1563 !
1564 REAL(KIND=JPRB) :: zhook_handle
1565 !
1566 !-------------------------------------------------------------------------------
1567 !
1568 IF (lhook) CALL dr_hook('ISBA_MEB:SNOWALB_SPECTRAL_BANDS_MEB',0,zhook_handle)
1569 !
1570 ini = SIZE(psnowdz,1)
1571 inlvls = SIZE(psnowdz,2)
1572 !
1573 ! 1) Spectral albedo
1574 ! ------------------
1575 !
1576 zwork(:) = 0.0
1577 zworka(:) = psnowalb(:)
1578 zpermsnowfrac(:) = pvegtype(:,nvt_snow)
1579 !
1580  CALL snow3lalb(zworka,zspectralalbedo,psnowrho(:,1),psnowage(:,1),zpermsnowfrac,pps)
1581 !
1582 ! Since we only consider VIS and NIR bands for soil and veg in MEB currently:
1583 ! (also note, here PSNOWALB doesn't evolve...we just diagnose spectral components).
1584 !
1585 WHERE(psnowalb(:)/=xundef)
1586 !
1587  psnowalbvis(:) = zspectralalbedo(:,1)
1588 !
1589 ! We diagnose NIR albedo such that total albedo is conserved
1590 ! (using just 2 spectral bands in MEB)
1591 !
1592  psnowalbnir(:) = (psnowalb(:) - xsw_wght_vis*psnowalbvis(:))/xsw_wght_nir
1593 !
1594 ! currently NOT used by MEB
1595 !
1596  psnowalbfir(:) = xundef
1597 !
1598 ! For the surface layer absorbtion computation:
1599 !
1600  zspectralalbedo(:,1) = psnowalbvis(:)
1601  zspectralalbedo(:,2) = psnowalbnir(:)
1602  zspectralalbedo(:,3) = psnowalbfir(:)
1603 !
1604 ELSEWHERE
1605 !
1606  psnowalbvis(:) = xundef
1607  psnowalbnir(:) = xundef
1608  psnowalbfir(:) = xundef
1609 !
1610 END WHERE
1611 !
1612 ! Snow optical grain diameter (no age dependency over polar regions):
1613 !
1614 zage(:) = (1.0-zpermsnowfrac(:))*psnowage(:,1)
1615 !
1616 zdsgrain(:) = snow3ldopt(psnowrho(:,1),zage)
1617 !
1618 ! 2) SW absorption in uppermost snow layer
1619 ! ----------------------------------------
1620 ! For now, consider just 2 bands with MEB, so renormalize:
1621 
1622 zspectralalbedo(:,1) = zspectralalbedo(:,1)
1623 zspectralalbedo(:,2) = (psnowalb(:) - xsw_wght_vis*zspectralalbedo(:,1))/xsw_wght_nir
1624 !
1625 ! Adjust thickness to be as in snow computations:
1626 !
1627 DO jj=1,inlvls
1628  DO ji=1,ini
1629  zsnowdz(ji,jj) = psnowdz(ji,jj)/max(1.e-4,ppsn(ji))
1630  ENDDO
1631 ENDDO
1632 !
1633  CALL snow3lradtrans(xsnowdzmin, zspectralalbedo, zsnowdz, psnowrho, &
1634  zpermsnowfrac, pzenith, psnowage, ptau_n)
1635 !
1636 IF (lhook) CALL dr_hook('ISBA_MEB:SNOWALB_SPECTRAL_BANDS_MEB',1,zhook_handle)
1637 !
1638 END SUBROUTINE snowalb_spectral_bands_meb
1639 !===============================================================================
1640  SUBROUTINE snow3lradtrans(PSNOWDZMIN, PSPECTRALALBEDO, PSNOWDZ, PSNOWRHO, &
1641  ppermsnowfrac, pzenith, psnowage, pradtrans)
1642 !
1643 !! PURPOSE
1644 !! -------
1645 ! Calculate the transmission of shortwave (solar) radiation
1646 ! through the snowpack (using a form of Beer's Law: exponential
1647 ! decay of radiation with increasing snow depth).
1648 !
1649 USE modd_surf_par, ONLY : xundef
1650 USE modd_snow_par, ONLY : xvspec1,xvspec2,xvspec3,xvbeta1,xvbeta2, &
1651  xvbeta4,xvbeta3,xvbeta5, xmincoszen
1652 USE modd_meb_par, ONLY : xsw_wght_vis, xsw_wght_nir
1653 !
1654 USE mode_snow3l, ONLY : snow3ldopt
1655 !
1656 IMPLICIT NONE
1657 !
1658 !* 0.1 declarations of arguments
1659 !
1660 REAL, INTENT(IN) :: psnowdzmin
1661 !
1662 REAL, DIMENSION(:), INTENT(IN) :: ppermsnowfrac
1663 REAL, DIMENSION(:), INTENT(IN) :: pzenith
1664 REAL, DIMENSION(:,:), INTENT(IN) :: psnowrho, psnowdz, psnowage
1665 REAL, DIMENSION(:,:), INTENT(IN) :: pspectralalbedo
1666 !
1667 REAL, DIMENSION(:,:), INTENT(OUT) :: pradtrans
1668 !
1669 !
1670 !* 0.2 declarations of local variables
1671 !
1672 INTEGER :: jj, ji
1673 !
1674 INTEGER :: ini
1675 INTEGER :: inlvls
1676 !
1677 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: zradtot, zprojlat, zcoszen
1678 REAL, DIMENSION(SIZE(PSNOWRHO,1)) :: zopticalpath1, zopticalpath2, zopticalpath3
1679 !
1680 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zdsgrain, zcoef, zsnowdz, zage
1681 REAL, DIMENSION(SIZE(PSNOWRHO,1),SIZE(PSNOWRHO,2)) :: zbeta1, zbeta2, zbeta3, zwork
1682 !
1683 REAL(KIND=JPRB) :: zhook_handle
1684 !-------------------------------------------------------------------------------
1685 !
1686 ! 0. Initialization:
1687 ! ------------------
1688 !
1689 IF (lhook) CALL dr_hook('SNOW3LRADTRANS',0,zhook_handle)
1690 !
1691 ini = SIZE(psnowdz(:,:),1)
1692 inlvls = SIZE(psnowdz(:,:),2)
1693 !
1694 !
1695 ! 1. Vanishingly thin snowpack check:
1696 ! -----------------------------------
1697 ! For vanishingly thin snowpacks, much of the radiation
1698 ! can pass through snowpack into underlying soil, making
1699 ! a large (albeit temporary) thermal gradient: by imposing
1700 ! a minimum thickness, this increases the radiation absorbtion
1701 ! for vanishingly thin snowpacks.
1702 !
1703 zsnowdz(:,:) = max(psnowdzmin, psnowdz(:,:))
1704 !
1705 !
1706 ! 2. Extinction of net shortwave radiation
1707 ! ----------------------------------------
1708 ! Fn of snow depth and density (Loth and Graf 1993:
1709 ! SNOWCVEXT => from Bohren and Barkstrom 1974
1710 ! SNOWAGRAIN and SNOWBGRAIN=> from Jordan 1976)
1711 !
1712 ! Coefficient for taking into account the increase of path length of rays
1713 ! in snow due to zenithal angle
1714 !
1715 zcoszen(:)=max(xmincoszen,cos(pzenith(:)))
1716 !
1717 ! This formulation is incorrect but it compensate partly the fact that
1718 ! the albedo formulation does not account for zenithal angle.
1719 ! Only for polar or glacier regions
1720 !
1721 zprojlat(:)=(1.0-ppermsnowfrac(:))+ppermsnowfrac(:)/zcoszen(:)
1722 !
1723 ! Snow optical grain diameter (no age dependency over polar regions):
1724 !
1725 zage(:,:) = 0.
1726 DO jj=1,inlvls
1727  DO ji=1,ini
1728  IF(psnowage(ji,jj)/=xundef)THEN
1729  zage(ji,jj) = (1.0-ppermsnowfrac(ji))*psnowage(ji,jj)
1730  ENDIF
1731  ENDDO
1732 ENDDO
1733 !
1734 zdsgrain(:,:) = snow3ldopt(psnowrho,zage)
1735 !
1736 ! Extinction coefficient from Brun et al. (1989):
1737 !
1738 zwork(:,:)=sqrt(zdsgrain(:,:))
1739 !
1740 zbeta1(:,:)=max(xvbeta1*psnowrho(:,:)/zwork(:,:),xvbeta2)
1741 zbeta2(:,:)=max(xvbeta3*psnowrho(:,:)/zwork(:,:),xvbeta4)
1742 zbeta3(:,:)=xvbeta5
1743 !
1744 zopticalpath1(:) = 0.0
1745 zopticalpath2(:) = 0.0
1746 zopticalpath3(:) = 0.0
1747 !
1748 DO jj=1,inlvls
1749  DO ji=1,ini
1750  !
1751  zopticalpath1(ji) = zopticalpath1(ji) + zbeta1(ji,jj)*zsnowdz(ji,jj)
1752  zopticalpath2(ji) = zopticalpath2(ji) + zbeta2(ji,jj)*zsnowdz(ji,jj)
1753 
1754  zcoef(ji,jj) = xsw_wght_vis*(1.0-pspectralalbedo(ji,1))*exp(-zopticalpath1(ji)*zprojlat(ji)) &
1755  + xsw_wght_nir*(1.0-pspectralalbedo(ji,2))*exp(-zopticalpath2(ji)*zprojlat(ji))
1756 
1757  ENDDO
1758 ENDDO
1759 !
1760 ! 3. Radiation trans at base of each layer
1761 ! ----------------------------------
1762 ! NOTE, at level=0, rad = Swnet*(1-alb) so radcoef(0)=1 implicitly
1763 !
1764 pradtrans(:,:) = zcoef(:,:)
1765 !
1766 IF (lhook) CALL dr_hook('SNOW3LRADTRANS',1,zhook_handle)
1767 !
1768 !-------------------------------------------------------------------------------
1769 !
1770 END SUBROUTINE snow3lradtrans
1771 !===============================================================================
1772 SUBROUTINE allocate_local_vars_prep_grid_soil
1773 !
1774 IMPLICIT NONE
1775 !
1776 !* 0.2 declarations of local variables
1777 !
1778 INTEGER :: inll
1779 !
1780 REAL(KIND=JPRB) :: zhook_handle
1781 !
1782 !-------------------------------------------------------------------------------
1783 
1784 IF (lhook) CALL dr_hook('ISBA_MEB:ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',0,zhook_handle)
1785 
1786 inll = inl
1787 IF(omeb_litter)inll = inl + 1
1788 
1789 ALLOCATE ( ztgl(ini, inll ))
1790 ALLOCATE ( zsoilhcapz(ini, inll ))
1791 ALLOCATE ( zsoilcondz(ini, inll ))
1792 ALLOCATE ( zd_g(ini, inll ))
1793 ALLOCATE ( zdzg(ini, inll ))
1794 ALLOCATE ( zwfc(ini, inll ))
1795 ALLOCATE ( zwsat(ini, inll ))
1796 
1797 IF (lhook) CALL dr_hook('ISBA_MEB:ALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',1,zhook_handle)
1798 
1799 END SUBROUTINE allocate_local_vars_prep_grid_soil
1800 !===============================================================================
1801 SUBROUTINE deallocate_local_vars_prep_grid_soil
1802 !
1803 IMPLICIT NONE
1804 !
1805 !* 0.2 declarations of local variables
1806 !
1807 REAL(KIND=JPRB) :: zhook_handle
1808 !
1809 !-------------------------------------------------------------------------------
1810 
1811 IF (lhook) CALL dr_hook('ISBA_MEB:DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',0,zhook_handle)
1812 
1813 DEALLOCATE ( ztgl )
1814 DEALLOCATE ( zsoilhcapz )
1815 DEALLOCATE ( zsoilcondz )
1816 DEALLOCATE ( zd_g )
1817 DEALLOCATE ( zdzg )
1818 DEALLOCATE ( zwsat )
1819 DEALLOCATE ( zwfc )
1820 
1821 IF (lhook) CALL dr_hook('ISBA_MEB:DEALLOCATE_LOCAL_VARS_PREP_GRID_SOIL ',1,zhook_handle)
1822 
1823 END SUBROUTINE deallocate_local_vars_prep_grid_soil
1824 !===============================================================================
1825 SUBROUTINE reshift_meb_soil(OMEB_LITTER,PTGL,PTL,PTG,PLESFC,PLESFCI, &
1826  pleg,plegi,plelitter,plelitteri)
1827 !
1828 IMPLICIT NONE
1829 !
1830 !* 0.1 declarations of arguments
1831 !
1832 LOGICAL, INTENT(IN) :: omeb_litter
1833 REAL, DIMENSION(:,:), INTENT(IN) :: ptgl
1834 REAL, DIMENSION(:), INTENT(IN) :: plesfc
1835 REAL, DIMENSION(:), INTENT(IN) :: plesfci
1836 REAL, DIMENSION(:), INTENT(OUT) :: pleg
1837 REAL, DIMENSION(:), INTENT(OUT) :: plegi
1838 REAL, DIMENSION(:), INTENT(OUT) :: plelitter
1839 REAL, DIMENSION(:), INTENT(OUT) :: plelitteri
1840 REAL, DIMENSION(:), INTENT(OUT) :: ptl
1841 REAL, DIMENSION(:,:), INTENT(OUT) :: ptg
1842 !
1843 !* 0.2 declarations of local variables
1844 !
1845 INTEGER :: jj, jl
1846 !
1847 REAL(KIND=JPRB) :: zhook_handle
1848 !
1849 !-------------------------------------------------------------------------------
1850 
1851 ini = SIZE(ptg,1)
1852 inl = SIZE(ptg,2)
1853 
1854 IF (lhook) CALL dr_hook('ISBA_MEB:FINISH_MEB_SOIL ',0,zhook_handle)
1855 
1856 IF (omeb_litter)THEN
1857 
1858  ptl(:) = ptgl(:,1)
1859 
1860  DO jl=1,inl
1861  DO jj=1,ini
1862  ptg(jj,jl) = ptgl(jj,jl+1)
1863  ENDDO
1864  ENDDO
1865 
1866  pleg(:) = 0.0
1867  plegi(:) = 0.0
1868  plelitter(:) = plesfc(:)
1869  plelitteri(:) = plesfci(:)
1870 ELSE
1871 
1872  ptg(:,:) = ptgl(:,:)
1873 
1874  pleg(:) = plesfc(:)
1875  plegi(:) = plesfci(:)
1876  plelitter(:) = 0.
1877  plelitteri(:) = 0.
1878 
1879 ENDIF
1880 
1881 
1882 IF (lhook) CALL dr_hook('ISBA_MEB:FINISH_MEB_SOIL ',1,zhook_handle)
1883 
1884 END SUBROUTINE reshift_meb_soil
1885 !===============================================================================
1886 SUBROUTINE prep_meb_soil(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,PWSAT,PWFC,PD_G,PDZG,PTG,PWG,PWGI,PWRL,PWRLI, &
1887  ptl,pgndlitter,pd_gl,pdzgl,ptgl,psoilhcapl,psoilcondl,pwsatl,pwfcl,pwsfc,pwisfc,&
1888  pctsfc,pct,pfrozen1,pfrozen1sfc )
1889 !
1890 USE modd_csts, ONLY : xrholw,xrholi, xcl, xci
1891 USE modd_isba_par, ONLY : xwgmin, xomsph
1892 !
1893 IMPLICIT NONE
1894 !
1895 !* 0.1 declarations of arguments
1896 !
1897 LOGICAL, INTENT(IN) :: omeb_litter
1898 REAL, DIMENSION(:,:), INTENT(IN) :: psoilhcapz
1899 REAL, DIMENSION(:,:), INTENT(IN) :: psoilcondz
1900 REAL, DIMENSION(:,:), INTENT(IN) :: pwsat
1901 REAL, DIMENSION(:,:), INTENT(IN) :: pwfc
1902 REAL, DIMENSION(:,:), INTENT(IN) :: pd_g
1903 REAL, DIMENSION(:,:), INTENT(IN) :: pdzg
1904 REAL, DIMENSION(:,:), INTENT(IN) :: ptg
1905 REAL, DIMENSION(:), INTENT(IN) :: pwg
1906 REAL, DIMENSION(:), INTENT(IN) :: pwgi
1907 REAL, DIMENSION(:), INTENT(IN) :: pct
1908 REAL, DIMENSION(:), INTENT(IN) :: pwrl
1909 REAL, DIMENSION(:), INTENT(IN) :: pwrli
1910 REAL, DIMENSION(:), INTENT(IN) :: ptl
1911 REAL, DIMENSION(:), INTENT(IN) :: pfrozen1
1912 REAL, DIMENSION(:), INTENT(IN) :: pgndlitter
1913 REAL, DIMENSION(:,:), INTENT(OUT) :: pd_gl
1914 REAL, DIMENSION(:,:), INTENT(OUT) :: pdzgl
1915 REAL, DIMENSION(:,:), INTENT(OUT) :: ptgl
1916 REAL, DIMENSION(:,:), INTENT(OUT) :: psoilhcapl
1917 REAL, DIMENSION(:,:), INTENT(OUT) :: psoilcondl
1918 REAL, DIMENSION(:,:), INTENT(OUT) :: pwsatl
1919 REAL, DIMENSION(:,:), INTENT(OUT) :: pwfcl
1920 REAL, DIMENSION(:), INTENT(OUT) :: pwsfc
1921 REAL, DIMENSION(:), INTENT(OUT) :: pwisfc
1922 REAL, DIMENSION(:), INTENT(OUT) :: pctsfc
1923 REAL, DIMENSION(:), INTENT(OUT) :: pfrozen1sfc
1924 !
1925 !* 0.2 declarations of local variables
1926 !
1927 INTEGER :: ini, inl, jj, jl
1928 !
1929 REAL(KIND=JPRB) :: zhook_handle
1930 !
1931 !* 0.3 declarations of local parameters
1932 !
1933 REAL, PARAMETER :: z1 = 45.0 !litter bulk density (kg/m3)
1934 REAL, PARAMETER :: z2 = 0.1 !coeff for litter conductivity (K/m)
1935 REAL, PARAMETER :: z3 = 0.03 !coeff for litter conductivity
1936 REAL, PARAMETER :: z4 = 0.95 !litter porosity (m3/m3)
1937 REAL, PARAMETER :: z5 = 0.12 !litter field capacity (m3/m3)
1938 !
1939 REAL, DIMENSION(SIZE(PWG)) :: zwork
1940 !
1941 !-------------------------------------------------------------------------------
1942 !
1943 IF (lhook) CALL dr_hook('ISBA_MEB:PREP_MEB_SOIL',0,zhook_handle)
1944 !
1945 ini = SIZE(ptg,1)
1946 inl = SIZE(ptg,2)
1947 !
1948 zwork(:) = 0.0
1949 IF(omeb_litter)THEN
1950  ptgl(:,1) = ptl(:)
1951  zwork(:) = pwrl(:)/(xrholw*pgndlitter(:))
1952  psoilhcapl(:,1) = xomsph*z1 + (xcl*xrholw)*zwork(:) + (xci*xrholi/xrholw)*pwrli(:)/pgndlitter(:)
1953  psoilcondl(:,1) = z2 + z3 * zwork(:)
1954  pwsatl(:,1) = z4
1955  pwfcl(:,1) = z5
1956  pd_gl(:,1) = pgndlitter(:)
1957  pdzgl(:,1) = pgndlitter(:)
1958  pctsfc(:) = 1. / (psoilhcapl(:,1) * pgndlitter(:))
1959  pfrozen1sfc(:) = pwrli(:) / ( pwrli(:) + max(pwrl(:), (xwgmin*xrholw)*pgndlitter(:) ))
1960 
1961  DO jl=1,inl
1962  DO jj=1,ini
1963  ptgl(jj,jl+1) = ptg(jj,jl)
1964  psoilhcapl(jj,jl+1) = psoilhcapz(jj,jl)
1965  psoilcondl(jj,jl+1) = psoilcondz(jj,jl)
1966  pwsatl(jj,jl+1) = pwsat(jj,jl)
1967  pwfcl(jj,jl+1) = pwfc(jj,jl)
1968  pd_gl(jj,jl+1) = pgndlitter(jj) + pd_g(jj,jl)
1969  pdzgl(jj,jl+1) = pdzg(jj,jl)
1970  ENDDO
1971  ENDDO
1972  pwsfc(:) = pwrl(:) /(xrholw*pgndlitter(:)) ! (m3/m3)
1973  pwisfc(:) = pwrli(:)/(xrholw*pgndlitter(:)) ! (m3/m3)
1974 
1975 ELSE
1976  ptgl(:,:) = ptg(:,:)
1977  psoilhcapl(:,:) = psoilhcapz(:,:)
1978  psoilcondl(:,:) = psoilcondz(:,:)
1979  pwsatl(:,:) = pwsat(:,:)
1980  pwfcl(:,:) = pwfc(:,:)
1981  pd_gl(:,:) = pd_g(:,:)
1982  pdzgl(:,:) = pdzg(:,:)
1983  pctsfc(:) = pct(:)
1984  pwsfc(:) = pwg(:)
1985  pwisfc(:) = pwgi(:)
1986  pfrozen1sfc(:) = pfrozen1(:)
1987 ENDIF
1988 IF (lhook) CALL dr_hook('ISBA_MEB:PREP_MEB_SOIL',1,zhook_handle)
1989 
1990 END SUBROUTINE prep_meb_soil
1991 !===============================================================================
1992 SUBROUTINE ice_litter(PTSTEP, PLELITTERI, &
1993  psoilhcapz, &
1994  ptg, ptl, pwgi, pwg, kwg_layer, &
1995  pdzg,pwrl,pwrli,pgndlitter,pphasel, &
1996  pctsfc,plstt,plitcor)
1997 !
1998 USE modd_csts, ONLY : xlmtt, xtt, xci, xrholi, xrholw
1999 !
2000 IMPLICIT NONE
2001 !
2002 !* 0.1 declarations of arguments
2003 !
2004 REAL, INTENT(IN) :: ptstep
2005 ! PTSTEP = Model time step (s)
2006 !
2007 REAL, DIMENSION(:), INTENT(IN) :: plelitteri
2008 ! PLELITTERI = ice sublimation (m s-1)
2009 REAL, DIMENSION(:), INTENT(IN) :: pctsfc
2010 REAL, DIMENSION(:), INTENT(IN) :: plstt
2011 !
2012 REAL, DIMENSION(:), INTENT(INOUT) :: ptl, pwrl, pwrli
2013 ! PTL = litter temperature (K)
2014 ! PWRL = litter water content (kg/m2)
2015 ! PWRLI = litter ice content (kg/m2)
2016 REAL, DIMENSION(:,:), INTENT(IN) :: psoilhcapz
2017 ! PSOILHCAPZ = soil heat capacity [J/(m3 K)]
2018 REAL, DIMENSION(:,:), INTENT(IN) :: pdzg
2019 ! PDZG = Layer thickness (DIF option)
2020 REAL, DIMENSION(:), INTENT(IN) :: pgndlitter
2021 ! PGNDLITTER = Litter thickness (m)
2022 REAL, DIMENSION(:,:), INTENT(INOUT) :: ptg, pwgi, pwg
2023 ! PTG = soil temperature (K)
2024 ! PWGI = soil volumetric ice content (m3/m3)
2025 ! PWG = soil volumetric liquid water content (m3/m3)
2026 !
2027 INTEGER, DIMENSION(:), INTENT(IN) :: kwg_layer
2028 ! KWG_LAYER = Number of soil moisture layers (DIF option)
2029 !
2030 REAL, DIMENSION(:), INTENT(OUT) :: pphasel
2031 ! PPHASEL = Phase changement in litter (W/m2)
2032 REAL, DIMENSION(:), INTENT(OUT) :: plitcor
2033 ! PLITCOR = A possible ice mass correction (to be potentially
2034 ! removed from soil) (kg/m2/s)
2035 !
2036 !* 0.2 declarations of local variables
2037 !
2038 INTEGER :: jl ! loop control
2039 !
2040 INTEGER :: inl ! Number of explicit soil layers
2041 !
2042 REAL, DIMENSION(SIZE(PTG,1)) :: zexcess, zk, zhcapl,zelitteri, &
2043  zdeltat,zphase,zphasem,zphasef,zphasex, &
2044  zwrl,zwrli,z0,zphasec
2045 !
2046 REAL :: zpsi
2047 !
2048 REAL(KIND=JPRB) :: zhook_handle
2049 !
2050 !* 0.3 declaration of local parameters
2051 !
2052 REAL, PARAMETER :: zertol = 1.e-6 ! (-) error tolerance
2053 REAL, PARAMETER :: ztauice = 3300. ! (s) litter phase change characteristic time scale
2054 REAL, PARAMETER :: zwrlsat = 0.85 ! (m3/m3) litter porosity
2055 !
2056 !-------------------------------------------------------------------------------
2057 !
2058 IF (lhook) CALL dr_hook('ISBA_MEB:ICE_LITTER',0,zhook_handle)
2059 !
2060 ! Initialization:
2061 ! ---------------
2062 !
2063 !
2064 inl = maxval(kwg_layer(:))
2065 !
2066 zexcess(:) = 0.0
2067 zphasec(:) = 0.0
2068 plitcor(:) = 0.0
2069 !
2070 zhcapl(:) = 1/(pctsfc(:)*pgndlitter(:))
2071 !
2072 !-------------------------------------------------------------------------------
2073 !
2074 ! 1. Surface layer vegetation insulation coefficient (-)
2075 ! ---------------------------------------------------
2076 !
2077 ! 1.1 Convert to m3/m3
2078 ! -----------------
2079 !
2080 zwrl(:) = pwrl(:) /(xrholw*pgndlitter(:))
2081 zwrli(:) = pwrli(:)/(xrholw*pgndlitter(:))
2082 !
2083 ! 2. Litter ice evolution computation:
2084 ! --------------------------------
2085 !
2086 zdeltat(:) = ptl(:) - xtt
2087 !
2088 !
2089 ! *Melt* ice if energy and ice available:
2090 !
2091 zphasem(:) = (ptstep/ztauice)*min((xci*xrholi)*max(0.0,zdeltat(:)),zwrli(:)*(xlmtt*xrholw))
2092 !
2093 ! *Freeze* liquid water if energy and water available and do not exceed porosity:
2094 !
2095 zphasef(:) = (ptstep/ztauice)*min((xci*xrholi)*max(0.0,-zdeltat(:)),zwrl(:)*(xlmtt*xrholw))
2096 zphasef(:) = min(zphasef(:) , (zwrlsat - zwrli(:)) * (xlmtt*xrholw) )
2097 !
2098 zphase(:) = zphasef(:) - zphasem(:)
2099 
2100 ! Update heat content if melting or freezing
2101 !
2102 ptl(:) = ptl(:) + zphase(:)/zhcapl(:)
2103 !
2104 ! Get estimate of actual total phase change (J/m3) for equivalent litter water changes:
2105 
2106 zphasex(:) = zphase(:)
2107 !
2108 ! Adjust ice and liquid water conents (m3/m3) accordingly :
2109 !
2110 zwrl(:) = zwrl(:) - zphasex/(xlmtt*xrholw)
2111 zwrli(:) = zwrli(:) + zphasex/(xlmtt*xrholw)
2112 !
2113 ! 2.1 Convert to Kg/m2
2114 ! -----------------
2115 !
2116 pwrl(:) = zwrl(:) * pgndlitter(:) * xrholw
2117 pwrli(:)= zwrli(:) * pgndlitter(:) * xrholw
2118 !
2119 ! 3. Adjust litter ice content for sublimation
2120 ! -----------------------------------------
2121 !
2122 !
2123 zelitteri(:) = plelitteri(:) * (ptstep/plstt)
2124 zexcess(:) = max( 0.0 , zelitteri(:) - pwrli(:) )
2125 plitcor=zexcess/ptstep
2126 pwrli(:) = pwrli(:) - ( zelitteri(:) - zexcess(:) )
2127 !
2128 ! 4. Prevent some possible problems
2129 ! ------------------------------
2130 !
2131 pwgi(:,1) = pwgi(:,1)- zexcess(:) / (xrholw * pdzg(:,1))
2132 !
2133 zexcess(:) = max( 0.0, - pwgi(:,1) )
2134 pwgi(:,1) = pwgi(:,1) + zexcess(:)
2135 pwg(:,1) = pwg(:,1) - zexcess(:)
2136 ptg(:,1) = ptg(:,1) + zexcess(:) * (xlmtt*xrholw)/psoilhcapz(:,1)
2137 !
2138 DO jl=1,inl-1
2139  zexcess(:) = max(0.0,-pwg(:,jl))
2140  pwg(:,jl+1) = pwg(:,jl+1) - zexcess(:)*pdzg(:,jl)/pdzg(:,jl+1)
2141  pwg(:,jl) = pwg(:,jl) + zexcess(:)
2142 ENDDO
2143 !
2144 ! 5. Prevent from keeping track of ice in litter
2145 ! -------------------------------------------
2146 !
2147 WHERE (pwrli(:) < zertol )
2148  pwrl(:) = pwrl(:) + pwrli(:)
2149  ptl(:) = ptl(:) + pwrli(:) * xlmtt / pgndlitter(:) / zhcapl(:)
2150  zphasec(:) = pwrli(:) * xlmtt / pgndlitter(:)
2151  pwrli(:) = 0.0
2152 ELSEWHERE
2153  zphasec(:) = 0.0
2154 END WHERE
2155 !
2156 pphasel(:)=(zphase(:) + zphasec(:))/ptstep*pgndlitter(:)
2157 !
2158 !
2159 IF (lhook) CALL dr_hook('ISBA_MEB:ICE_LITTER',1,zhook_handle)
2160 !
2161 END SUBROUTINE ice_litter
2162 !===============================================================================
2163 
2164 END SUBROUTINE isba_meb
modd_isba_par
Definition: modd_isba_par.F90:6
snow3lradtrans
subroutine snow3lradtrans(PSNOWDZMIN, PSPECTRALALBEDO, PSNOWDZ, PSNOWRHO, PPERMSNOWFRAC, PZENITH, PSNOWAGE, PRADTRANS)
Definition: isba_meb.F90:1640
snow3l_isba
subroutine snow3l_isba(HISBA, HSNOW_ISBA, HSNOWRES, OMEB, OGLACIER, HIMPLICIT_WIND, TPTIME, PTSTEP, PVEGTYPE, PSNOWSWE, PSNOWHEAT, PSNOWRHO, PSNOWALB, PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST, PSNOWAGE, PTG, PCG, PCT, PSOILHCAPZ, PSOILCONDZ, PPS, PTA, PSW_RAD, PQA, PVMOD, PLW_RAD, PRR, PSR, PRHOA, PUREF, PEXNS, PEXNA, PDIRCOSZW, PLVTT, PLSTT, PZREF, PZ0NAT, PZ0EFF, PZ0HNAT, PALB, PD_G, PDZG, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PTHRUFAL, PGRNDFLUX, PFLSN_COR, PGSFCSNOW, PEVAPCOR, PSWNETSNOW, PSWNETSNOWS, PLWNETSNOW, PRNSNOW, PHSNOW, PGFLUXSNOW, PHPSNOW, PLES3L, PLEL3L, PEVAP, PSNDRIFT, PUSTARSNOW, PPSN, PSRSFC, PRRSFC, PSNOWSFCH, PDELHEATN, PDELHEATN_SFC, PEMISNOW, PCDSNOW, PCHSNOW, PSNOWTEMP, PSNOWLIQ, PSNOWDZ, PSNOWHMASS, PRI, PZENITH, PDELHEATG, PDELHEATG_SFC, PLAT, PLON, PQS, OSNOWDRIFT, OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH, HSNOWMETAMO, HSNOWRAD)
Definition: snow3L_isba.F90:6
mode_snow3l
Definition: mode_snow3l.F90:6
deallocate_local_vars_prep_grid_soil
subroutine deallocate_local_vars_prep_grid_soil
Definition: isba_meb.F90:1801
hydro_veg
subroutine hydro_veg(HRAIN, PTSTEP, PMUF, PRR, PLEV, PLETR, PVEG, PPSNV, PWR, PWRMAX, PPG, PDRIP, PRRVEG, PLVTT)
Definition: hydro_veg.F90:6
isba_meb
subroutine isba_meb(TPTIME, OMEB, OMEB_LITTER, OMEB_GNDRES, PGNDLITTER, OFORC_MEASURE, OGLACIER, OTR_ML, OAGRI_TO_GRASS, OSHADE, OSTRESSDEF, OSNOWDRIFT, OSNOWDRIFT_SUBLIM, OSNOW_ABS_ZENITH, OIRRIGATE, OIRRIDAY, HSNOWMETAMO, HSNOWRAD, HPHOTO, HISBA, HCPSURF, HRAIN, HSNOW_ISBA, HSNOWRES, HIMPLICIT_WIND, KWG_LAYER, PTSTEP, PVEGTYPE, PLAT, PLON, PTHRESHOLD, PWATSUP, PIRRIG, PIRRIG_FLUX, PSOILHCAPZ, PSOILCONDZ, PFROZEN1, PPS, PZENITH, PSCA_SW, PSW_RAD, PVMOD, PRR, PSR, PRHOA, PTA, PQA, PH_VEG, PDIRCOSZW, PEXNS, PEXNA, PPET_A_COEF, PPET_B_COEF, PPEQ_A_COEF, PPEQ_B_COEF, PPEW_A_COEF, PPEW_B_COEF, PZREF, PUREF, PCH, PCD, PCDN, PRI, PRESA, PHUG, PHV, PHU, PQS, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, PTV, PTL, PTG, PTC, PQC, PWR, PWRL, PWRLI, PWRVN, PWG, PWGI, PWRMAX_CF, PRGL, PRSMIN, PGAMMA, PRS, PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, PFALB, PSNOWALB, PSNOWALBVIS, PSNOWALBNIR, PSNOWALBFIR, PABC, PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, PIACAN, PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS, PAH, PBH, PF2I, PDMAX, PPOI, PCSP, PFZERO, PEPSO, PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PAN, PANDAY, PANFM, PGPP, PANF, PRESP_BIOMASS_INST, PFF, PPSN, PPALPHAN, PLAI, PF2, PWSAT, PWFC, PSNOWGRAN1, PSNOWGRAN2, PSNOWHIST, PSNOWAGE, PSNOWRHO, PSNOWSWE, PSNOWHEAT, PSNOWTEMP, PSNOWDZ, PSNOWLIQ, PFEMIS, PSWNET_N, PSWNET_V, PSWNET_G, PSWNET_NS, PALBT, PSWDOWN_GN, PLW_RAD, PLWNET_N, PLWNET_V, PLWNET_G, PLWDOWN_GN, PLEV_V_C, PLES_V_C, PH_V_C, PH_G_C, PLETR_V_C, PLER_V_C, PH_C_A, PH_N_C, PLE_V_C, PLE_G_C, PLE_C_A, PLE_N_C, PEVAP_N_C, PEVAP_G_C, PSR_GN, PMELTCV, PFRZCV, PMELTADV, PLE_FLOOD, PLEI_FLOOD, PLE, PH, PRN, PLEI, PLEGI, PLEG, PLELITTERI, PLELITTER, PDRIPLIT, PRRLIT, PLEV, PLER, PLETR, PEVAP, PLES, PLESL, PSUBL, PRESTORE, PGRNDFLUX, PFLSN_COR, PUSTAR, PHPSNOW, PSNOWHMASS, PRNSNOW, PHSNOW, PGFLUXSNOW, PUSTARSNOW, PSRSFC, PRRSFC, PEMISNOW, PCDSNOW, PCHSNOW, PEMIST, PTS_RAD, PHU_AGG, PAC_AGG, PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG, PDELHEATN, PDELHEATN_SFC, PRESTOREN, PD_G, PDZG, PCPS, PLVTT, PLSTT, PCT, PCV, PCG, PFFROZEN, PTDEEP_A, PTDEEP_B, PDEEP_FLUX, PMUF, PDRIP, PRRVEG, PRISNOW, PSNOW_THRUFAL, PSNOW_THRUFAL_SOIL, PEVAPCOR, PSUBVCOR, PLITCOR, PSNOWSFCH, PSNDRIFT, PQSNOW)
Definition: isba_meb.F90:6
modd_data_cover_par
Definition: modd_data_cover_par.F90:6
mode_thermos
Definition: mode_thermos.F90:6
prep_meb_soil
subroutine prep_meb_soil(OMEB_LITTER, PSOILHCAPZ, PSOILCONDZ, PWSAT, PWFC, PD_G, PDZG, PTG, PWG, PWGI, PWRL, PWRLI, PTL, PGNDLITTER, PD_GL, PDZGL, PTGL, PSOILHCAPL, PSOILCONDL, PWSATL, PWFCL, PWSFC, PWISFC, PCTSFC, PCT, PFROZEN1, PFROZEN1SFC)
Definition: isba_meb.F90:1886
ice_litter
subroutine ice_litter(PTSTEP, PLELITTERI, PSOILHCAPZ, PTG, PTL, PWGI, PWG, KWG_LAYER, PDZG, PWRL, PWRLI, PGNDLITTER, PPHASEL, PCTSFC, PLSTT, PLITCOR)
Definition: isba_meb.F90:1992
snow_load_meb
subroutine snow_load_meb(PTSTEP, PSR, PTV, PWRVNMAX, PKVN, PCHEATV, PLERCV, PLESC, PMELTVN, PVELC, PMELTCV, PFRZCV, PUNLOADSNOW, PWRV, PWRVN, PSUBVCOR, PLVTT, PLSTT)
Definition: snow_load_meb.F90:6
mode_meb::snow_intercept_eff
Definition: mode_meb.F90:59
preps_for_meb_ebud_rad
subroutine preps_for_meb_ebud_rad(PPS, PLAICV, PSNOWRHO, PSNOWSWE, PSNOWHEAT, PSNOWTEMP, PSNOWDZ, PSCOND, PHEATCAPS, PEMISNOW, PSIGMA_F, PCHIP, PTSTEP, PSR, PTA, PVMOD, PSNOWAGE, PPERMSNOWFRAC)
Definition: preps_for_meb_ebud_rad.F90:6
modd_meb_par
Definition: modd_meb_par.F90:6
reshift_meb_soil
subroutine reshift_meb_soil(OMEB_LITTER, PTGL, PTL, PTG, PLESFC, PLESFCI, PLEG, PLEGI, PLELITTER, PLELITTERI)
Definition: isba_meb.F90:1825
sum_fluxes_meb_tsplit
subroutine sum_fluxes_meb_tsplit
Definition: isba_meb.F90:1327
wet_leaves_frac
subroutine wet_leaves_frac(PWRM, PVEG, PWRMAX_CF, PZ0, PLAI, PWRMAX, PDELTA)
Definition: wet_leaves_frac.F90:6
allocate_local_vars_prep_grid_soil
subroutine allocate_local_vars_prep_grid_soil
Definition: isba_meb.F90:1772
drag_meb
subroutine drag_meb(LFORC_MEASURE, PTG, PTC, PTV, PSNOWTEMP, PTA, PQC, PQA, PVMOD, PWG, PWGI, PWSAT, PWFC, PEXNS, PEXNA, PPS, PRR, PSR, PRHOA, PZ0G_WITHOUT_SNOW, PZ0_MEBV, PZ0H_MEBV, PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PZ0_WITH_SNOW, PZ0H_WITH_SNOW, PZ0EFF, PSNOWSWE, PWR, PCHIP, PTSTEP, PRS_VG, PRS_VN, PPSN, PPALPHAN, PZREF, PUREF, PH_VEG, PDIRCOSZW, PPSNCV, PDELTA, PLAI, OMEB_GNDRES, PCH, PCD, PCDN, PRI, PRA, PVELC, PCDSNOW, PCHSNOW, PRISNOW, PUSTAR2SNOW, PHUG, PHUGI, PHV, PHVG, PHVN, PHU, PQS, PRS, PLEG_DELTA, PLEGI_DELTA, PHSGL, PHSGF, PFLXC_C_A, PFLXC_N_A, PFLXC_G_C, PFLXC_N_C, PFLXC_VG_C, PFLXC_VN_C, PFLXC_MOM, PQSATG, PQSATV, PQSATC, PQSATN, PDELTAVK)
Definition: drag_meb.F90:7
avg_fluxes_meb_tsplit
subroutine avg_fluxes_meb_tsplit
Definition: isba_meb.F90:1415
isba_fluxes_meb
subroutine isba_fluxes_meb(PRHOA, PSIGMA_F, PSIGMA_FN, PEMIS_N, PRNET_V, PRNET_G, PRNET_N, PSWNET_V, PSWNET_G, PSWNET_N, PLWNET_V, PLWNET_G, PLWNET_N, PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN, PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN, PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN, PTHRMA_TA, PTHRMB_TA, PTHRMA_TC, PTHRMB_TC, PTHRMA_TG, PTHRMB_TG, PTHRMA_TV, PTHRMB_TV, PTHRMA_TN, PTHRMB_TN, PQSAT_G, PQSAT_V, PQSATI_N, PFF, PPSN, PPSNA, PPSNCV, PFROZEN1, PFFROZEN, PLEG_DELTA, PLEGI_DELTA, PHUG, PHUGI, PHVG, PHVN, PFLXC_C_A, PFLXC_G_C, PFLXC_VG_C, PFLXC_VN_C, PFLXC_N_C, PFLXC_N_A, PFLXC_MOM, PFLXC_V_C, PHVGS, PHVNS, PTG, PTV, PTN, PDQSAT_G, PDQSAT_V, PDQSATI_N, PTC, PQC, PTA_IC, PQA_IC, PDELTA_V, PDELTAT_G, PDELTAT_V, PDELTAT_N, PSW_UP, PSW_RAD, PLW_RAD, PRNET, PLW_UP, PH_C_A, PH_V_C, PH_G_C, PH_N_C, PH_N_A, PH_N, PH, PLE_C_A, PLE_V_C, PLE_G_C, PLE_N_C, PEVAP_C_A, PLEV_V_C, PEVAP_G_C, PEVAP_N_C, PEVAP_N_A, PEVAP, PSUBL, PLETR_V_C, PLER_V_C, PLEG, PLEGI, PLE_FLOOD, PLEI_FLOOD, PLES, PLEL, PEVAPN, PLES_V_C, PLETR, PLER, PLEV, PLE, PLEI, PTS_RAD, PEMIS, PLSTT)
Definition: isba_fluxes_meb.F90:6
init_sum_fluxes_meb_tsplit
subroutine init_sum_fluxes_meb_tsplit
Definition: isba_meb.F90:1240
isba_lwnet_meb
subroutine isba_lwnet_meb(PLAI, PPSN, PPSNA, PEMIS_N, PEMIS_F, PFF, PTV, PTG, PTN, PLW_RAD, PLWNET_N, PLWNET_V, PLWNET_G, PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN, PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN, PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN, PSIGMA_F, PSIGMA_FN, PLWDOWN_GN)
Definition: isba_lwnet_meb.F90:6
cotwores
subroutine cotwores(PTSTEP, HPHOTO, OTR_ML, OSHADE, PVEGTYPE, OSTRESSDEF, PAH, PBH, PF2I, PDMAX, PPOI, PCSP, PTG, PF2, PSW_RAD, PRA, PQA, PQSAT, PLE, PPSNV, PDELTA, PLAI, PRHOA, PZENITH, PFZERO, PEPSO, PGAMM, PQDGAMM, PGMES, PGC, PQDGMES, PT1GMES, PT2GMES, PAMAX, PQDAMAX, PT1AMAX, PT2AMAX, PFFV, PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN, PIACAN, PABC, PAN, PANDAY, PRS, PANFM, PGPP, PANF, PRESP_LEAF)
Definition: cotwores.F90:6
mode_thermos::qsat
Definition: mode_thermos.F90:57
modd_type_date_surf::date_time
Definition: modd_type_date_surf.F90:46
mode_meb
Definition: mode_meb.F90:6
e_budget_meb
subroutine e_budget_meb(HISBA, HCPSURF, PTSTEP, PPS, PCG, PCT, PCV, PWRVN, PWR, PTDEEP_A, PTDEEP_B, PD_G, PSOILCONDZ, PSOILHCAPZ, PSNOWDZ, PSNOWCONDZ, PSNOWHCAPZ, PSWNET_V, PSWNET_G, PSWNET_N, PTAU_N, PLWNET_V, PLWNET_G, PLWNET_N, PLWNET_V_DTV, PLWNET_V_DTG, PLWNET_V_DTN, PLWNET_G_DTV, PLWNET_G_DTG, PLWNET_G_DTN, PLWNET_N_DTV, PLWNET_N_DTG, PLWNET_N_DTN, PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, PTHRMA_TA, PTHRMB_TA, PTHRMA_TC, PTHRMB_TC, PTHRMA_TG, PTHRMB_TG, PTHRMA_TV, PTHRMB_TV, PTHRMA_TN, PTHRMB_TN, PQSAT_G, PQSAT_V, PQSATI_N, PFF, PFFROZEN, PPSN, PPSNA, PPSNCV, PCHEATV, PCHEATG, PCHEATN, PLEG_DELTA, PLEGI_DELTA, PHUG, PHUGI, PHVG, PHVN, PFROZEN1, PFLXC_C_A, PFLXC_G_C, PFLXC_VG_C, PFLXC_VN_C, PFLXC_N_C, PFLXC_N_A, PFLXC_MOM, PTG, PTV, PTN, PFLXC_V_C, PHVGS, PHVNS, PDQSAT_G, PDQSAT_V, PDQSATI_N, PTC, PQC, PTA_IC, PQA_IC, PUSTAR2_IC, PVMOD, PDELTAT_G, PDELTAT_V, PDELTAT_N, PGRNDFLUX, PCPS, PLVTT, PLSTT, PHPSNOW, PMELTADV, PRESTORE, PDEEP_FLUX, PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG)
Definition: e_budget_meb.F90:6
veg
subroutine veg(PSW_RAD, PTA, PQA, PPS, PRGL, PLAI, PRSMIN, PGAMMA, PF2, PRS)
Definition: veg.F90:6
modd_surf_par
Definition: modd_surf_par.F90:6
modd_snow_metamo
Definition: modd_snow_metamo.F90:8
modd_snow_par
Definition: modd_snow_par.F90:6
modd_type_date_surf
Definition: modd_type_date_surf.F90:6
mode_snow3l::snow3ldopt
Definition: mode_snow3l.F90:126
mode_snow3l::snow3lalb
Definition: mode_snow3l.F90:132
snow_leaves_frac_meb
subroutine snow_leaves_frac_meb(PPSN, PPALPHAN, PWRVN, PTV, PCHIP, PLAIV, PWRVNMAX, PDELTAVN, PMELTVN)
Definition: snow_leaves_frac_meb.F90:6
radiative_transfert
subroutine radiative_transfert(OAGRI_TO_GRASS, PVEGTYPE, PALBVIS_VEG, PALBVIS_SOIL, PALBNIR_VEG, PALBNIR_SOIL, PSW_RAD, PLAI, PZENITH, PABC, PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, OSHADE, PIACAN, PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN, PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS)
Definition: radiative_transfert.F90:6
modd_csts
Definition: modd_csts.F90:6
snowalb_spectral_bands_meb
subroutine snowalb_spectral_bands_meb(PVEGTYPE, PSNOWALB, PSNOWRHO, PSNOWAGE, PPS, PPSN, PSNOWDZ, PZENITH, PSNOWALBVIS, PSNOWALBNIR, PSNOWALBFIR, PTAU_N)
Definition: isba_meb.F90:1518
Generated on Fri May 13 2016 09:31:04 for SURFEX by   doxygen 1.8.5