Context Navigation

source: branches/publications/ORCHIDEE_CN_CAN_r5698/src_sechiba/hydrol.f90 @ 7346

Last change on this file since 7346 was 5698, checked in by aude.valade, 5 years ago
fix calculation of vevapnu that was generating negative swc in hydrol_split_soil
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 314.8 KB

Line
1	! ===================================================================================================\n
2	! MODULE : hydrol
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This module computes the soil moisture processes on continental points.
10	!!
11	!!\n DESCRIPTION : contains hydrol_main, hydrol_initialize, hydrol_finalise, hydrol_init,
12	!! hydrol_var_init, hydrol_alma,
13	!! hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil.
14	!! The assumption in this module is that very high vertical resolution is
15	!! needed in order to properly resolve the vertical diffusion of water in
16	!! the soils. Furthermore we have taken into account the sub-grid variability
17	!! of soil properties and vegetation cover by allowing the co-existence of
18	!! different soil moisture columns in the same grid box.
19	!! This routine was originaly developed by Patricia deRosnay.
20	!!
21	!! RECENT CHANGE(S) : None
22	!!
23	!! REFERENCE(S) :
24	!! - de Rosnay, P., J. Polcher, M. Bruen, and K. Laval, Impact of a physically based soil
25	!! water flow and soil-plant interaction representation for modeling large-scale land surface
26	!! processes, J. Geophys. Res, 107 (10.1029), 2002. \n
27	!! - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled
28	!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. \n
29	!! - de Rosnay, P., M. Bruen, and J. Polcher, Sensitivity of surface fluxes to the number of layers in the soil
30	!! model used in GCMs, Geophysical research letters, 27 (20), 3329 - 3332, 2000. \n
31	!! - dâOrgeval, T., J. Polcher, and P. De Rosnay, Sensitivity of the West African hydrological
32	!! cycle in ORCHIDEE to infiltration processes, Hydrol. Earth Syst. Sci. Discuss, 5, 2251 - 2292, 2008. \n
33	!! - Carsel, R., and R. Parrish, Developing joint probability distributions of soil water retention
34	!! characteristics, Water Resources Research, 24 (5), 755 - 769, 1988. \n
35	!! - Mualem, Y., A new model for predicting the hydraulic conductivity of unsaturated porous
36	!! media, Water Resources Research, 12 (3), 513 - 522, 1976. \n
37	!! - Van Genuchten, M., A closed-form equation for predicting the hydraulic conductivity of
38	!! unsaturated soils, Soil Science Society of America Journal, 44 (5), 892 - 898, 1980. \n
39	!! - Campoy, A., Ducharne, A., Cheruy, F., Hourdin, F., Polcher, J., and Dupont, J.-C., Response
40	!! of land surface fluxes and precipitation to different soil bottom hydrological conditions in a
41	!! general circulation model, J. Geophys. Res, in press, 2013. \n
42	!! - Gouttevin, I., Krinner, G., Ciais, P., Polcher, J., and Legout, C. , 2012. Multi-scale validation
43	!! of a new soil freezing scheme for a land-surface model with physically-based hydrology.
44	!! The Cryosphere, 6, 407-430, doi: 10.5194/tc-6-407-2012. \n
45	!!
46	!! SVN :
47	!! $HeadURL$
48	!! $Date$
49	!! $Revision$
50	!! \n
51	!_ ===============================================================================================\n
52	MODULE hydrol
53
54	USE ioipsl
55	USE xios_orchidee
56	USE constantes
57	USE constantes_soil
58	USE pft_parameters
59	USE sechiba_io_p
60	USE grid
61	USE explicitsnow
62
63	IMPLICIT NONE
64
65	PRIVATE
66	PUBLIC :: hydrol_main, hydrol_initialize, hydrol_finalize, hydrol_clear
67
68	!
69	! variables used inside hydrol module : declaration and initialisation
70	!
71	LOGICAL, SAVE :: first_hydrol_main=.TRUE. !! Initialisation has to be done one time (true/false)
72	!$OMP THREADPRIVATE(first_hydrol_main)
73	LOGICAL, SAVE :: doponds=.FALSE. !! Reinfiltration flag (true/false)
74	!$OMP THREADPRIVATE(doponds)
75	REAL(r_std), SAVE :: froz_frac_corr !! Coefficient for water frozen fraction correction
76	!$OMP THREADPRIVATE(froz_frac_corr)
77	REAL(r_std), SAVE :: max_froz_hydro !! Coefficient for water frozen fraction correction
78	!$OMP THREADPRIVATE(max_froz_hydro)
79	REAL(r_std), SAVE :: smtot_corr !! Coefficient for water frozen fraction correction
80	!$OMP THREADPRIVATE(smtot_corr)
81	LOGICAL, SAVE :: do_rsoil=.FALSE. !! Flag to calculate rsoil for bare soile evap
82	!$OMP THREADPRIVATE(do_rsoil)
83	LOGICAL, SAVE :: ok_dynroot !! Flag to activate dynamic root profile to optimize soil
84	!! moisture usage, similar to Beer et al. 2007
85	!$OMP THREADPRIVATE(ok_dynroot)
86	CHARACTER(LEN=80) , SAVE :: var_name !! To store variables names for I/O
87	!$OMP THREADPRIVATE(var_name)
88	!
89	REAL(r_std), PARAMETER :: allowed_err = 2.0E-8_r_std
90	REAL(r_std), PARAMETER :: EPS1 = EPSILON(un) !! A small number
91	! one dimension array allocated, computed, saved and got in hydrol module
92	! Values per soil type
93	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: nvan !! Van Genuchten coeficients n (unitless)
94	! RK: 1/n=1-m
95	!$OMP THREADPRIVATE(nvan)
96	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: avan !! Van Genuchten coeficients a
97	!! @tex $(mm^{-1})$ @endtex
98	!$OMP THREADPRIVATE(avan)
99	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcr !! Residual volumetric water content
100	!! @tex $(m^{3} m^{-3})$ @endtex
101	!$OMP THREADPRIVATE(mcr)
102	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcs !! Saturated volumetric water content
103	!! @tex $(m^{3} m^{-3})$ @endtex
104	!$OMP THREADPRIVATE(mcs)
105	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ks !! Hydraulic conductivity at saturation
106	!! @tex $(mm d^{-1})$ @endtex
107	!$OMP THREADPRIVATE(ks)
108	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pcent !! Fraction of saturated volumetric soil moisture above
109	!! which transpir is max (0-1, unitless)
110	!$OMP THREADPRIVATE(pcent)
111	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcf !! Volumetric water content at field capacity
112	!! @tex $(m^{3} m^{-3})$ @endtex
113	!$OMP THREADPRIVATE(mcf)
114	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcw !! Volumetric water content at wilting point
115	!! @tex $(m^{3} m^{-3})$ @endtex
116	!$OMP THREADPRIVATE(mcw)
117	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_awet !! Vol. wat. cont. above which albedo is cst
118	!! @tex $(m^{3} m^{-3})$ @endtex
119	!$OMP THREADPRIVATE(mc_awet)
120	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_adry !! Vol. wat. cont. below which albedo is cst
121	!! @tex $(m^{3} m^{-3})$ @endtex
122	!$OMP THREADPRIVATE(mc_adry)
123
124	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_beg !! Total amount of water on vegetation at start of time
125	!! step @tex $(kg m^{-2})$ @endtex
126	!$OMP THREADPRIVATE(tot_watveg_beg)
127	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_end !! Total amount of water on vegetation at end of time step
128	!! @tex $(kg m^{-2})$ @endtex
129	!$OMP THREADPRIVATE(tot_watveg_end)
130	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_beg !! Total amount of water in the soil at start of time step
131	!! @tex $(kg m^{-2})$ @endtex
132	!$OMP THREADPRIVATE(tot_watsoil_beg)
133	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_end !! Total amount of water in the soil at end of time step
134	!! @tex $(kg m^{-2})$ @endtex
135	!$OMP THREADPRIVATE(tot_watsoil_end)
136	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_beg !! Total amount of snow at start of time step
137	!! @tex $(kg m^{-2})$ @endtex
138	!$OMP THREADPRIVATE(snow_beg)
139	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_end !! Total amount of snow at end of time step
140	!! @tex $(kg m^{-2})$ @endtex
141	!$OMP THREADPRIVATE(snow_end)
142	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delsoilmoist !! Change in soil moisture @tex $(kg m^{-2})$ @endtex
143	!$OMP THREADPRIVATE(delsoilmoist)
144	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delintercept !! Change in interception storage
145	!! @tex $(kg m^{-2})$ @endtex
146	!$OMP THREADPRIVATE(delintercept)
147	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delswe !! Change in SWE @tex $(kg m^{-2})$ @endtex
148	!$OMP THREADPRIVATE(delswe)
149	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: undermcr !! Nb of tiles under mcr for a given time step
150	!$OMP THREADPRIVATE(undermcr)
151	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget !! zero/one when veget fraction is zero/higher (1)
152	!$OMP THREADPRIVATE(mask_veget)
153	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile !! zero/one where soil tile is zero/higher (1)
154	!$OMP THREADPRIVATE(mask_soiltile)
155	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: humrelv !! Water stress index for transpiration
156	!! for each soiltile x PFT couple (0-1, unitless)
157	!$OMP THREADPRIVATE(humrelv)
158	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegstressv !! Water stress index for vegetation growth
159	!! for each soiltile x PFT couple (0-1, unitless)
160	!$OMP THREADPRIVATE(vegstressv)
161	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us !! Water stress index for transpiration
162	!! (by soil layer and PFT) (0-1, unitless)
163	!$OMP THREADPRIVATE(us)
164	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol !! Throughfall per PFT
165	!! @tex $(kg m^{-2})$ @endtex
166	!$OMP THREADPRIVATE(precisol)
167	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol_ns !! Throughfall per soiltile
168	!! @tex $(kg m^{-2})$ @endtex
169	!$OMP THREADPRIVATE(precisol_ns)
170	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ae_ns !! Bare soil evaporation per soiltile
171	!! @tex $(kg m^{-2})$ @endtex
172	!$OMP THREADPRIVATE(ae_ns)
173	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation
174	!! per soiltile (used to deconvoluate vevapnu)
175	!! (0-1, unitless)
176	!$OMP THREADPRIVATE(evap_bare_lim_ns)
177	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: free_drain_coef !! Coefficient for free drainage at bottom
178	!! (0-1, unitless)
179	!$OMP THREADPRIVATE(free_drain_coef)
180	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: zwt_force !! Prescribed water table depth (m)
181	!$OMP THREADPRIVATE(zwt_force)
182	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: frac_bare_ns !! Evaporating bare soil fraction per soiltile
183	!! (0-1, unitless)
184	!$OMP THREADPRIVATE(frac_bare_ns)
185	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: rootsink !! Transpiration sink by soil layer and soiltile
186	!! @tex $(kg m^{-2})$ @endtex
187	!$OMP THREADPRIVATE(rootsink)
188	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsnowveg !! Sublimation of snow on vegetation
189	!! @tex $(kg m^{-2})$ @endtex
190	!$OMP THREADPRIVATE(subsnowveg)
191	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio !! Sublimation of snow on other surface types
192	!! (ice, lakes,...) @tex $(kg m^{-2})$ @endtex
193	!$OMP THREADPRIVATE(subsnownobio)
194	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: icemelt !! Ice melt @tex $(kg m^{-2})$ @endtex
195	!$OMP THREADPRIVATE(icemelt)
196	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsinksoil !! Excess of sublimation as a sink for the soil
197	!! @tex $(kg m^{-2})$ @endtex
198	!$OMP THREADPRIVATE(subsinksoil)
199	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot !! Total Total fraction of grid-cell covered by PFTs
200	!! (bare soil + vegetation) (1; 1)
201	!$OMP THREADPRIVATE(vegtot)
202	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: resdist !! Soiltile values from previous time-step (1; 1)
203
204	!$OMP THREADPRIVATE(resdist)
205	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot_old !! Total Total fraction of grid-cell covered by PFTs
206	!! from previous time-step (1; 1)
207	!$OMP THREADPRIVATE(vegtot_old)
208	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mx_eau_var !! Maximum water content of the soil @tex $(kg m^{-2})$ @endtex
209	!$OMP THREADPRIVATE(mx_eau_var)
210
211	! arrays used by cwrr scheme
212	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: nroot !! Normalized root length fraction in each soil layer
213	!! (0-1, unitless)
214	!! DIM = kjpindex * nvm * nslm
215	!$OMP THREADPRIVATE(nroot)
216	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kfact_root !! Factor to increase Ks towards the surface
217	!! (unitless)
218	!! DIM = kjpindex * nslm * nstm
219	!$OMP THREADPRIVATE(kfact_root)
220	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kfact !! Factor to reduce Ks with depth (unitless)
221	!! DIM = nslm * nscm
222	!$OMP THREADPRIVATE(kfact)
223	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: zz !! Depth of nodes [znh in vertical_soil] transformed into (mm)
224	!$OMP THREADPRIVATE(zz)
225	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dz !! Internode thickness [dnh in vertical_soil] transformed into (mm)
226	!$OMP THREADPRIVATE(dz)
227	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dh !! Layer thickness [dlh in vertical_soil] transformed into (mm)
228	!$OMP THREADPRIVATE(dh)
229	INTEGER(i_std), SAVE :: itopmax !! Number of layers where the node is above 0.1m depth
230	!$OMP THREADPRIVATE(itopmax)
231	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mc_lin !! 50 Vol. Wat. Contents to linearize K and D, for each texture
232	!! @tex $(m^{3} m^{-3})$ @endtex
233	!! DIM = imin:imax * nscm
234	!$OMP THREADPRIVATE(mc_lin)
235	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: k_lin !! 50 values of unsaturated K, for each soil layer and texture
236	!! @tex $(mm d^{-1})$ @endtex
237	!! DIM = imin:imax * nslm * nscm
238	!$OMP THREADPRIVATE(k_lin)
239	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: d_lin !! 50 values of diffusivity D, for each soil layer and texture
240	!! @tex $(mm^2 d^{-1})$ @endtex
241	!! DIM = imin:imax * nslm * nscm
242	!$OMP THREADPRIVATE(d_lin)
243	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: a_lin !! 50 values of the slope in K=a*mc+b, for each soil layer and texture
244	!! @tex $(mm d^{-1})$ @endtex
245	!! DIM = imin:imax * nslm * nscm
246	!$OMP THREADPRIVATE(a_lin)
247	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: b_lin !! 50 values of y-intercept in K=a*mc+b, for each soil layer and texture
248	!! @tex $(m^{3} m^{-3})$ @endtex
249	!! DIM = imin:imax * nslm * nscm
250	!$OMP THREADPRIVATE(b_lin)
251
252	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: humtot !! Total Soil Moisture @tex $(kg m^{-2})$ @endtex
253	!$OMP THREADPRIVATE(humtot)
254	LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: resolv !! Mask of land points where to solve the diffusion equation
255	!! (true/false)
256	!$OMP THREADPRIVATE(resolv)
257
258	!! linarization coefficients of hydraulic conductivity K (hydrol_soil_coef)
259	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: k !! Hydraulic conductivity K for each soil layer
260	!! @tex $(mm d^{-1})$ @endtex
261	!! DIM = (:,nslm)
262	!$OMP THREADPRIVATE(k)
263	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kk_moy !! Mean hydraulic conductivity over soiltiles (mm/d)
264	!$OMP THREADPRIVATE(kk_moy)
265	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kk !! Hydraulic conductivity for each soiltiles (mm/d)
266	!$OMP THREADPRIVATE(kk)
267	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: a !! Slope in K=a*mc+b(:,nslm)
268	!! @tex $(mm d^{-1})$ @endtex
269	!! DIM = (:,nslm)
270	!$OMP THREADPRIVATE(a)
271	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: b !! y-intercept in K=a*mc+b
272	!! @tex $(m^{3} m^{-3})$ @endtex
273	!! DIM = (:,nslm)
274	!$OMP THREADPRIVATE(b)
275	!! linarization coefficients of hydraulic diffusivity D (hydrol_soil_coef)
276	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: d !! Diffusivity D for each soil layer
277	!! @tex $(mm^2 d^{-1})$ @endtex
278	!! DIM = (:,nslm)
279	!$OMP THREADPRIVATE(d)
280	!! matrix coefficients (hydrol_soil_tridiag and hydrol_soil_setup), see De Rosnay (1999), p155-157
281	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: e !! Left-hand tridiagonal matrix coefficients
282	!$OMP THREADPRIVATE(e)
283	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: f !! Left-hand tridiagonal matrix coefficients
284	!$OMP THREADPRIVATE(f)
285	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: g1 !! Left-hand tridiagonal matrix coefficients
286	!$OMP THREADPRIVATE(g1)
287
288	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ep !! Right-hand matrix coefficients
289	!$OMP THREADPRIVATE(ep)
290	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: fp !! Right-hand atrix coefficients
291	!$OMP THREADPRIVATE(fp)
292	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gp !! Right-hand atrix coefficients
293	!$OMP THREADPRIVATE(gp)
294	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: rhs !! Right-hand system
295	!$OMP THREADPRIVATE(rhs)
296	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: srhs !! Temporarily stored rhs
297	!$OMP THREADPRIVATE(srhs)
298	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: tmat !! Left-hand tridiagonal matrix
299	!$OMP THREADPRIVATE(tmat)
300	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: stmat !! Temporarily stored tmat
301	!$OMP THREADPRIVATE(stmat)
302	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: water2infilt !! Water to be infiltrated
303	!! @tex $(kg m^{-2})$ @endtex
304	!$OMP THREADPRIVATE(water2infilt)
305	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc !! Total moisture content per soiltile
306	!! @tex $(kg m^{-2})$ @endtex
307	!$OMP THREADPRIVATE(tmc)
308	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcr !! Total moisture constent at residual per soiltile
309	!! @tex $(kg m^{-2})$ @endtex
310	!$OMP THREADPRIVATE(tmcr)
311	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcs !! Total moisture constent at saturation per soiltile
312	!! @tex $(kg m^{-2})$ @endtex
313	!$OMP THREADPRIVATE(tmcs)
314	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter !! Total moisture in the litter per soiltile
315	!! @tex $(kg m^{-2})$ @endtex
316	!$OMP THREADPRIVATE(tmc_litter)
317	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_mea !! Total moisture in the litter over the grid
318	!! @tex $(kg m^{-2})$ @endtex
319	!$OMP THREADPRIVATE(tmc_litt_mea)
320	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_wilt !! Total moisture of litter at wilt point per soiltile
321	!! @tex $(kg m^{-2})$ @endtex
322	!$OMP THREADPRIVATE(tmc_litter_wilt)
323	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_field !! Total moisture of litter at field cap. per soiltile
324	!! @tex $(kg m^{-2})$ @endtex
325	!$OMP THREADPRIVATE(tmc_litter_field)
326	!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
327	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_res !! Total moisture of litter at residual moisture per soiltile
328	!! @tex $(kg m^{-2})$ @endtex
329	!$OMP THREADPRIVATE(tmc_litter_res)
330	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_sat !! Total moisture of litter at saturation per soiltile
331	!! @tex $(kg m^{-2})$ @endtex
332	!$OMP THREADPRIVATE(tmc_litter_sat)
333	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_awet !! Total moisture of litter at mc_awet per soiltile
334	!! @tex $(kg m^{-2})$ @endtex
335	!$OMP THREADPRIVATE(tmc_litter_awet)
336	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_adry !! Total moisture of litter at mc_adry per soiltile
337	!! @tex $(kg m^{-2})$ @endtex
338	!$OMP THREADPRIVATE(tmc_litter_adry)
339	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which
340	!! albedo is fixed constant
341	!! @tex $(kg m^{-2})$ @endtex
342	!$OMP THREADPRIVATE(tmc_litt_wet_mea)
343	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which
344	!! albedo is constant
345	!! @tex $(kg m^{-2})$ @endtex
346	!$OMP THREADPRIVATE(tmc_litt_dry_mea)
347	LOGICAL, SAVE :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
348	!$OMP THREADPRIVATE(tmc_init_updated)
349
350	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: v1 !! Temporary variable (:)
351	!$OMP THREADPRIVATE(v1)
352
353	!! par type de sol :
354	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ru_ns !! Surface runoff per soiltile
355	!! @tex $(kg m^{-2})$ @endtex
356	!$OMP THREADPRIVATE(ru_ns)
357	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dr_ns !! Drainage per soiltile
358	!! @tex $(kg m^{-2})$ @endtex
359	!$OMP THREADPRIVATE(dr_ns)
360	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tr_ns !! Transpiration per soiltile
361	!$OMP THREADPRIVATE(tr_ns)
362	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegetmax_soil !! (:,nvm,nstm) percentage of each veg. type on each soil
363	!! of each grid point
364	!$OMP THREADPRIVATE(vegetmax_soil)
365	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc !! Total volumetric water content at the calculation nodes
366	!! (eg : liquid + frozen)
367	!! @tex $(m^{3} m^{-3})$ @endtex
368	!$OMP THREADPRIVATE(mc)
369	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mcl !! Liquid water content
370	!! @tex $(m^{3} m^{-3})$ @endtex
371	!$OMP THREADPRIVATE(mcl)
372	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soilmoist !! (:,nslm) Mean of each soil layer's moisture
373	!! across soiltiles
374	!! @tex $(kg m^{-2})$ @endtex
375	!$OMP THREADPRIVATE(soilmoist)
376	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: soil_wet !! Soil wetness above mcw (0-1, unitless)
377	!$OMP THREADPRIVATE(soil_wet)
378	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soil_wet_litter !! Soil wetness aove mvw in the litter (0-1, unitless)
379	!$OMP THREADPRIVATE(soil_wet_litter)
380	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: qflux_ns !! Diffusive water fluxes between soil layers
381	!$OMP THREADPRIVATE(qflux_ns)
382	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: check_top_ns !! Diagnostic calculated in hydrol_diag_soil_flux
383	!! (water balance residu of top soil layer)
384	!$OMP THREADPRIVATE(check_top_ns)
385	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: frac_hydro_diag !!
386	!$OMP THREADPRIVATE(frac_hydro_diag)
387	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz_hydro !! Frozen fraction for each hydrological soil layer
388	!$OMP THREADPRIVATE(profil_froz_hydro)
389	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: profil_froz_hydro_ns !! As profil_froz_hydro per soiltile
390	!$OMP THREADPRIVATE(profil_froz_hydro_ns)
391	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: temp_hydro !! Temp profile on hydrological levels
392	!$OMP THREADPRIVATE(temp_hydro)
393	! INTEGER(i_std), SAVE :: printlev_loc !!Local printlev in hydrol module
394	!!$OMP THREADPRIVATE(printlev_loc)
395
396
397
398	CONTAINS
399
400	!! ================================================================================================================================
401	!! SUBROUTINE : hydrol_initialize
402	!!
403	!>\BRIEF Allocate module variables, read from restart file or initialize with default values
404	!!
405	!! DESCRIPTION :
406	!!
407	!! MAIN OUTPUT VARIABLE(S) :
408	!!
409	!! REFERENCE(S) :
410	!!
411	!! FLOWCHART : None
412	!! \n
413	!_ ================================================================================================================================
414
415	SUBROUTINE hydrol_initialize ( kjit, kjpindex, index, rest_id, &
416	njsc, soiltile, veget, veget_max, &
417	humrel, vegstress, drysoil_frac, &
418	shumdiag_perma, qsintveg, &
419	evap_bare_lim, snow, snow_age, snow_nobio, &
420	snow_nobio_age, snowrho, snowtemp, snowgrain, &
421	snowdz, snowheat, &
422	mc_layh, mcl_layh, tmc_layh)
423
424	!! 0. Variable and parameter declaration
425	!! 0.1 Input variables
426	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
427	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
428	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
429	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
430	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
431	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
432	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
433	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
434
435	!! 0.2 Output variables
436	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
437	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
438	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
439	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
440	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
441	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor for bare soil evaporation
442	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
443	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
444	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
445	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age !! Snow age on ice, lakes, ...
446	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowrho !! Snow density
447	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowtemp !! Snow temperature
448	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowgrain !! Snow grainsize
449	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowdz !! Snow layer thickness
450	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowheat !! Snow heat content
451	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
452	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
453	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: tmc_layh !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
454	REAL(r_std),DIMENSION (kjpindex) :: soilwetdummy !! Temporary variable never used
455
456
457	!! 0.4 Local variables
458	INTEGER(i_std) :: jsl
459
460	!_ ================================================================================================================================
461
462	CALL hydrol_init (kjit, kjpindex, index, rest_id, njsc, veget_max, soiltile, &
463	humrel, vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg, &
464	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
465	drysoil_frac, evap_bare_lim)
466
467	CALL hydrol_var_init (kjpindex, veget, veget_max, &
468	soiltile, njsc, mx_eau_var, shumdiag_perma, &
469	drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh)
470
471	!! Initialize hydrol_alma routine if the variables were not found in the restart file. This is done in the end of
472	!! hydrol_initialize so that all variables(humtot,..) that will be used are initialized.
473	IF (ALL(tot_watveg_beg(:)==val_exp) .OR. ALL(tot_watsoil_beg(:)==val_exp) .OR. ALL(snow_beg(:)==val_exp)) THEN
474	! The output variable soilwetdummy is not calculated at first call to hydrol_alma.
475	CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwetdummy)
476	END IF
477
478	!! Calculate itopmax indicating the number of layers where the node is above 0.1m depth
479	itopmax=1
480	DO jsl = 1, nslm
481	! znh : depth of nodes
482	IF (znh(jsl) <= 0.1) THEN
483	itopmax=jsl
484	END IF
485	END DO
486	IF (printlev>=3) WRITE(numout,*) "Number of layers where the node is above 0.1m depth: itopmax=",itopmax
487
488	END SUBROUTINE hydrol_initialize
489
490
491	!! ================================================================================================================================
492	!! SUBROUTINE : hydrol_main
493	!!
494	!>\BRIEF
495	!!
496	!! DESCRIPTION :
497	!! - called every time step
498	!! - initialization and finalization part are not done in here
499	!!
500	!! - 1 computes snow ==> explicitsnow
501	!! - 2 computes vegetations reservoirs ==> hydrol_vegupd
502	!! - 3 computes canopy ==> hydrol_canop
503	!! - 4 computes surface reservoir ==> hydrol_flood
504	!! - 5 computes soil hydrology ==> hydrol_soil
505	!!
506	!! IMPORTANT NOTICE : The water fluxes are used in their integrated form, over the time step
507	!! dt_sechiba, with a unit of kg m^{-2}.
508	!!
509	!! RECENT CHANGE(S) : None
510	!!
511	!! MAIN OUTPUT VARIABLE(S) :
512	!!
513	!! REFERENCE(S) :
514	!!
515	!! FLOWCHART : None
516	!! \n
517	!_ ================================================================================================================================
518
519	SUBROUTINE hydrol_main (kjit, kjpindex, &
520	& index, indexveg, indexsoil, indexlayer, indexnbdl, &
521	& temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
522	& qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, &
523	& tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
524	& humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, flood_frac, flood_res, &
525	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, reinf_slope, rest_id, hist_id, hist2_id,&
526	& stempdiag, &
527	& temp_air, pb, u, v, tq_cdrag, swnet, pgflux, &
528	& snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
529	& grndflux,gtemp,tot_bare_soil, &
530	& lambda_snow,cgrnd_snow,dgrnd_snow,temp_sol_add, &
531	& mc_layh, mcl_layh, tmc_layh, tmc_pft, drainage_pft, swc_pft, swc, ksave, e_frac)
532
533	!! 0. Variable and parameter declaration
534
535	!! 0.1 Input variables
536
537	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
538	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
539	INTEGER(i_std),INTENT (in) :: rest_id,hist_id !! _Restart_ file and _history_ file identifier
540	INTEGER(i_std),INTENT (in) :: hist2_id !! _history_ file 2 identifier
541	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
542	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg !! Indeces of the points on the 3D map for veg
543	INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil !! Indeces of the points on the 3D map for soil
544	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer !! Indeces of the points on the 3D map for soil layers
545	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexnbdl !! Indeces of the points on the 3D map for of diagnostic soil layers
546
547	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_rain !! Rain precipitation
548	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_snow !! Snow precipitation
549	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: returnflow !! Routed water which comes back into the soil (from the
550	!! bottom)
551	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinfiltration !! Routed water which comes back into the soil (at the
552	!! top)
553	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: irrigation !! Water from irrigation returning to soil moisture
554	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol_new !! New soil temperature
555
556	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
557	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio !! Fraction of ice, lakes, ...
558	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: totfrac_nobio !! Total fraction of ice+lakes+...
559	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: soilcap !! Soil capacity
560	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
561	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vevapwet !! Interception loss
562	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
563	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
564	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintmax !! Maximum water on vegetation for interception
565	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
566	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Slope coef
567	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot !! Soil Potential Evaporation
568	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot_penm !! Soil Potential Evaporation Correction
569	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: flood_frac !! flood fraction
570	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
571	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature
572	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
573	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient (-)
574	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
575	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net shortwave radiation
576	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pgflux !! Net energy into snowpack
577	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: gtemp !! First soil layer temperature
578	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
579	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lambda_snow !! Coefficient of the linear extrapolation of surface temperature
580	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: cgrnd_snow !! Integration coefficient for snow numerical scheme
581	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: dgrnd_snow !! Integration coefficient for snow numerical scheme
582	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksave !! Soil conductivity (mm/d) copy of k
583	REAL(r_std), DIMENSION(kjpindex,nvm,nbdl,nstm), INTENT(in) :: e_frac !! Fraction of water transpired supplied by individual layers (no units)
584
585	!! 0.2 Output variables
586
587	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
588	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
589	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag !! Relative soil moisture in each soil layer
590	!! with respect to (mcf-mcw)
591	!! (unitless; can be out of 0-1)
592	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out):: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
593	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter approximate conductivity
594	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
595	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_melt !! Total melt
596	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: floodout !! Flux out of floodplains
597	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: tmc_pft !! Total soil water per PFT (mm/m2)
598	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: drainage_pft !! Drainage per PFT (mm/m2)
599	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: swc_pft !! Relative Soil water content [tmcr:tmcs] per pft (-)
600	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: swc !! Soil water content (copy of mc), which is need for
601	!! the hydraulic architecture
602
603	!! 0.3 Modified variables
604
605	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg !! Water on vegetation due to interception
606	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
607	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel !! Relative humidity
608	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapnu !! Bare soil evaporation
609	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapsno !! Snow evaporation
610	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapflo !! Floodplain evaporation
611	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: flood_res !! flood reservoir estimate
612	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow !! Snow mass [kg/m^2]
613	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow_age !! Snow age
614	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
615	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
616	!! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
617	!! The water balance is limite to + or - 10^6 so that accumulation is not endless
618
619	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: runoff !! Complete surface runoff
620	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drainage !! Drainage
621	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density
622	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature
623	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowgrain !! Snow grainsize
624	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness
625	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowheat !! Snow heat content
626	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowliq !! Snow liquid content (m)
627	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: grndflux !! Net flux into soil W/m2
628	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mc_layh !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
629	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]
630	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: tmc_layh !! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
631	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_add !! additional surface temperature due to the melt of first layer
632	!! at the present time-step @tex ($K$) @endtex
633
634
635	!! 0.4 Local variables
636
637	INTEGER(i_std) :: jst !! Index of soil tiles (unitless, 1-3)
638	INTEGER(i_std) :: jsl !! Index of soil layers (unitless)
639	INTEGER(i_std) :: ji, jv
640	REAL(r_std),DIMENSION (kjpindex) :: soilwet !! A temporary diagnostic of soil wetness
641	REAL(r_std),DIMENSION (kjpindex) :: njsc_tmp !! Temporary REAL value for njsc to write it
642	REAL(r_std), DIMENSION (kjpindex) :: snowmelt !! Snow melt [mm/dt_sechiba]
643	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmc_top !! Moisture content in the itopmax upper layers, per tile
644	REAL(r_std), DIMENSION (kjpindex) :: humtot_top !! Moisture content in the itopmax upper layers, for diagnistics
645	REAL(r_std), DIMENSION(kjpindex) :: histvar !! Temporary variable when computations are needed
646	REAL(r_std), DIMENSION (kjpindex,nvm) :: frac_bare !! Fraction(of veget_max) of bare soil in each vegetation type
647	INTEGER(i_std), DIMENSION(kjpindex*imax) :: mc_lin_axis_index
648	REAL(r_std), DIMENSION(kjpindex) :: twbr !! Grid-cell mean of TWBR Total Water Budget Residu[kg/m2/dt]
649	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_nroot !! To ouput the grid-cell mean of nroot
650	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_dlh !! To ouput the soil layer thickness on all grid points [m]
651	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcs !! To ouput the grid-cell mean of mcs
652	REAL(r_std),DIMENSION (kjpindex) :: drain_upd !! Change in drainage due to decrease in vegtot
653	!! on mc [kg/m2/dt]
654	REAL(r_std),DIMENSION (kjpindex) :: runoff_upd !! Change in runoff due to decrease in vegtot
655	!! on water2infilt[kg/m2/dt]
656
657
658	!_ ================================================================================================================================
659
660	!! Initialize local printlev
661	!printlev_loc=get_printlev('hydrol')
662
663	!! 1. Update vegtot_old and recalculate vegtot
664	vegtot_old(:) = vegtot(:)
665
666	DO ji = 1, kjpindex
667	vegtot(ji) = SUM(veget_max(ji,:))
668	ENDDO
669
670	!! 3. Shared time step
671	IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
672
673	!
674	!! 3.1 Calculate snow processes with explicit method or bucket snow model
675	CALL explicitsnow_main(kjpindex, precip_rain, precip_snow, temp_air, pb, &
676	u, v, temp_sol_new, soilcap, pgflux, &
677	frac_nobio, totfrac_nobio,gtemp, &
678	lambda_snow, cgrnd_snow, dgrnd_snow, &
679	vevapsno, snow_age, snow_nobio_age,snow_nobio, snowrho, &
680	snowgrain, snowdz, snowtemp, snowheat, snow, &
681	temp_sol_add, &
682	snowliq, subsnownobio, grndflux, snowmelt, tot_melt, &
683	subsinksoil)
684
685	!
686	!! 3.2 computes vegetations reservoirs ==>hydrol_vegupd
687	! Modif temp vuichard
688	CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
689
690	!! Calculate kfact_root
691	!! An exponential factor is used to increase ks near the surface depending
692	!on the amount of roots in the soil
693	!! through a geometric average over the vegets
694	!! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al.
695	!2008, Eqs. 3-4
696	!! (Calibrated against Hapex-Sahel measurements)
697	!! Since rev 2916: veget_max/2 is used instead of veget
698	kfact_root(:,:,:) = un
699	DO jsl = 1, nslm
700	DO jv = 2, nvm
701	jst = pref_soil_veg(jv)
702	DO ji = 1, kjpindex
703	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
704	kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
705	& MAX((MAXVAL(ks_usda)/ks(njsc(ji)))*(- vegetmax_soil(ji,jv,jst)/2 (humcste(jv)*zz(jsl)/mille - un)/deux), &
706	un)
707	ENDIF
708	ENDDO
709	ENDDO
710	ENDDO
711
712	!
713	!! 3.3 computes canopy ==>hydrol_canop
714	CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
715
716	!
717	!! 3.4 computes surface reservoir ==>hydrol_flood
718	CALL hydrol_flood(kjpindex, vevapflo, flood_frac, flood_res, floodout)
719
720	!
721	!! 3.5 computes soil hydrology ==>hydrol_soil
722
723	CALL hydrol_soil(kjpindex, veget_max, soiltile, njsc, reinf_slope, &
724	transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
725	returnflow, reinfiltration, irrigation, &
726	tot_melt,evap_bare_lim, shumdiag, shumdiag_perma, &
727	k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,&
728	stempdiag,snow,snowdz, tot_bare_soil, u, v, tq_cdrag, &
729	mc_layh, mcl_layh, tmc_layh, swc, ksave, e_frac)
730
731	! The update fluxes come from hydrol_vegupd
732	drainage(:) = drainage(:) + drain_upd(:)
733	runoff(:) = runoff(:) + runoff_upd(:)
734
735	DO jv=1,nvm
736	tmc_pft(:,jv) = tmc(:,pref_soil_veg(jv))
737	drainage_pft(:,jv) = dr_ns(:,pref_soil_veg(jv))
738	swc_pft(:,jv) = ( tmc(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)) ) &
739	/ ( tmcs(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)))
740	ENDDO
741
742	!! 12.10 Copy mc to swc for use in sechiba_hydrol_arch, when we do not use
743	!! soil to root resistance
744	swc(:,:,:) = mc(:,:,:)
745	!! 4 write out file ==> hydrol_alma/histwrite(*)
746	!
747	! If we use the ALMA standards
748	CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
749
750
751	! Calcuate the moisture in the upper itopmax layers corresponding to 0.1m (humtot_top):
752	! For ORCHIDEE with nslm=11 and zmaxh=2, itopmax=6.
753	! We compute tmc_top as tmc but only for the first itopmax layers. Then we compute a humtot with this variable.
754	DO jst=1,nstm
755	DO ji=1,kjpindex
756	tmc_top(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
757	DO jsl = 2, itopmax
758	tmc_top(ji,jst) = tmc_top(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
759	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
760	ENDDO
761	ENDDO
762	ENDDO
763
764	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
765	humtot_top(:) = zero
766	DO jst=1,nstm
767	DO ji=1,kjpindex
768	humtot_top(ji) = humtot_top(ji) + soiltile(ji,jst) * tmc_top(ji,jst) * vegtot(ji)
769	ENDDO
770	ENDDO
771
772	! Calculate the Total Water Budget Residu (in kg/m2 over dt_sechiba)
773	! All the delstocks and fluxes below are averaged over the mesh
774	! snow_nobio included in delswe
775	! Does not include the routing reservoirs, although the flux to/from routing are integrated
776	DO ji=1,kjpindex
777	twbr(ji) = (delsoilmoist(ji) + delintercept(ji) + delswe(ji)) &
778	- ( precip_rain(ji) + precip_snow(ji) + irrigation(ji) + floodout(ji) &
779	+ returnflow(ji) + reinfiltration(ji) ) &
780	+ ( runoff(ji) + drainage(ji) + SUM(vevapwet(ji,:)) &
781	+ SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) )
782	ENDDO
783	! Transform unit from kg/m2/dt to kg/m2/s (or mm/s)
784	CALL xios_orchidee_send_field("twbr",twbr/dt_sechiba)
785	! Number of tiles undermcr at end of timestep
786	CALL xios_orchidee_send_field("undermcr",undermcr)
787
788	! Calculate land_nroot : grid-cell mean of nroot
789	! Do not treat PFT1 because it has no roots
790	land_nroot(:,:) = zero
791	DO jsl=1,nslm
792	DO jv=2,nvm
793	DO ji=1,kjpindex
794	IF ( vegtot(ji) > min_sechiba ) THEN
795	land_nroot(ji,jsl) = land_nroot(ji,jsl) + veget_max(ji,jv) * nroot(ji,jv,jsl) / vegtot(ji)
796	END IF
797	END DO
798	ENDDO
799	ENDDO
800	CALL xios_orchidee_send_field("nroot",land_nroot)
801
802	DO jsl=1,nslm
803	land_dlh(:,jsl)=dlh(jsl)
804	ENDDO
805	CALL xios_orchidee_send_field("dlh",land_dlh)
806
807	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
808	land_mcs(:,:) = zero
809	DO jsl=1,nslm
810	DO jst=1,nstm
811	DO ji=1,kjpindex
812	land_mcs(ji,jsl) = land_mcs(ji,jsl) + soiltile(ji,jst) * tmcs(ji,jst) * vegtot(ji)
813	ENDDO
814	ENDDO
815	ENDDO
816	CALL xios_orchidee_send_field("mcs",land_mcs/(zmaxh* mille)) ! in m3/m3
817	CALL xios_orchidee_send_field("water2infilt",water2infilt)
818	CALL xios_orchidee_send_field("mc",mc)
819	CALL xios_orchidee_send_field("kfact_root",kfact_root)
820	CALL xios_orchidee_send_field("rootsink",rootsink)
821	CALL xios_orchidee_send_field("vegetmax_soil",vegetmax_soil)
822	CALL xios_orchidee_send_field("evapnu_soil",ae_ns/dt_sechiba)
823	CALL xios_orchidee_send_field("drainage_soil",dr_ns/dt_sechiba)
824	CALL xios_orchidee_send_field("transpir_soil",tr_ns/dt_sechiba)
825	CALL xios_orchidee_send_field("runoff_soil",ru_ns/dt_sechiba)
826	CALL xios_orchidee_send_field("humrel",humrel)
827	CALL xios_orchidee_send_field("drainage",drainage/dt_sechiba) ! [kg m-2 s-1]
828	CALL xios_orchidee_send_field("runoff",runoff/dt_sechiba) ! [kg m-2 s-1]
829	CALL xios_orchidee_send_field("precisol",precisol/dt_sechiba)
830	CALL xios_orchidee_send_field("precip_rain",precip_rain/dt_sechiba)
831	CALL xios_orchidee_send_field("precip_snow",precip_snow/dt_sechiba)
832	CALL xios_orchidee_send_field("qsintmax",qsintmax)
833	CALL xios_orchidee_send_field("qsintveg",qsintveg)
834	CALL xios_orchidee_send_field("qsintveg_tot",SUM(qsintveg(:,:),dim=2))
835	histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
836	CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
837
838	IF ( do_floodplains ) THEN
839	CALL xios_orchidee_send_field("floodout",floodout/dt_sechiba)
840	END IF
841
842	CALL xios_orchidee_send_field("snowmelt",snowmelt/dt_sechiba)
843	CALL xios_orchidee_send_field("tot_melt",tot_melt/dt_sechiba)
844
845	CALL xios_orchidee_send_field("soilmoist",soilmoist)
846	CALL xios_orchidee_send_field("tmc",tmc)
847	CALL xios_orchidee_send_field("humtot",humtot)
848	CALL xios_orchidee_send_field("humtot_top",humtot_top)
849
850	CALL xios_orchidee_send_field("snowdz",snowdz)
851	CALL xios_orchidee_send_field("frac_bare",frac_bare)
852
853	CALL xios_orchidee_send_field("soilwet",soilwet)
854	CALL xios_orchidee_send_field("delsoilmoist",delsoilmoist)
855	CALL xios_orchidee_send_field("delswe",delswe)
856	CALL xios_orchidee_send_field("delintercept",delintercept)
857
858	IF (ok_freeze_cwrr) THEN
859	CALL xios_orchidee_send_field("profil_froz_hydro",profil_froz_hydro)
860	CALL xios_orchidee_send_field("temp_hydro",temp_hydro)
861	CALL xios_orchidee_send_field("kk_moy",kk_moy)
862	END IF
863	CALL xios_orchidee_send_field("profil_froz_hydro_ns", profil_froz_hydro_ns)
864
865	IF ( .NOT. almaoutput ) THEN
866	!! CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
867
868	DO jst=1,nstm
869	! var_name= "mc_1" ... "mc_3"
870	WRITE (var_name,"('moistc_',i1)") jst
871	CALL histwrite_p(hist_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
872
873	! var_name= "kfactroot_1" ... "kfactroot_3"
874	WRITE (var_name,"('kfactroot_',i1)") jst
875	CALL histwrite_p(hist_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
876
877	! var_name= "vegetsoil_1" ... "vegetsoil_3"
878	WRITE (var_name,"('vegetsoil_',i1)") jst
879	CALL histwrite_p(hist_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
880	ENDDO
881	CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
882	CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
883	CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
884	CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
885	CALL histwrite_p(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
886	! mrso is a perfect duplicate of humtot
887	CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
888	CALL histwrite_p(hist_id, 'mrso', kjit, humtot, kjpindex, index)
889	CALL histwrite_p(hist_id, 'mrsos', kjit, humtot_top, kjpindex, index)
890	njsc_tmp(:)=njsc(:)
891	CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
892	CALL histwrite_p(hist_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
893	! CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
894	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
895	CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
896	CALL histwrite_p(hist_id, 'mrros', kjit, runoff, kjpindex, index)
897	histvar(:)=(runoff(:)+drainage(:))
898	CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
899	CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
900	CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
901
902	histvar(:)=(precip_rain(:)-SUM(precisol(:,:),dim=2))
903	CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
904
905	CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
906	CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
907	CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
908	CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
909	CALL histwrite_p(hist_id, 'shumdiag_perma',kjit,shumdiag_perma,kjpindex*nbdl,indexnbdl)
910
911	IF ( do_floodplains ) THEN
912	CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
913	ENDIF
914	!
915	IF ( hist2_id > 0 ) THEN
916	DO jst=1,nstm
917	! var_name= "mc_1" ... "mc_3"
918	WRITE (var_name,"('moistc_',i1)") jst
919	CALL histwrite_p(hist2_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
920
921	! var_name= "kfactroot_1" ... "kfactroot_3"
922	WRITE (var_name,"('kfactroot_',i1)") jst
923	CALL histwrite_p(hist2_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
924
925	! var_name= "vegetsoil_1" ... "vegetsoil_3"
926	WRITE (var_name,"('vegetsoil_',i1)") jst
927	CALL histwrite_p(hist2_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
928	ENDDO
929	CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
930	CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
931	CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
932	CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
933	CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
934	! mrso is a perfect duplicate of humtot
935	CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
936	CALL histwrite_p(hist2_id, 'mrso', kjit, humtot, kjpindex, index)
937	CALL histwrite_p(hist2_id, 'mrsos', kjit, humtot_top, kjpindex, index)
938	njsc_tmp(:)=njsc(:)
939	CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
940	CALL histwrite_p(hist2_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
941	CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
942	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
943	CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
944	CALL histwrite_p(hist2_id, 'mrros', kjit, runoff, kjpindex, index)
945	histvar(:)=(runoff(:)+drainage(:))
946	CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
947
948	IF ( do_floodplains ) THEN
949	CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
950	ENDIF
951	CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
952	CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
953	CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
954	CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
955	CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
956	CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
957	ENDIF
958	ELSE
959	CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
960	CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
961	CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
962	CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
963	CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
964	CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
965	CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
966	CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
967	!
968	CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
969	CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
970	!
971	CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
972	CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
973	!
974	IF ( hist2_id > 0 ) THEN
975	CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
976	CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
977	CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
978	CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
979	CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
980	CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
981	CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
982	CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
983	!
984	CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
985	CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
986	!
987	CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
988	CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
989	!
990	ENDIF
991	ENDIF
992
993	IF (ok_freeze_cwrr) THEN
994	CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit,profil_froz_hydro , kjpindex*nslm, indexlayer)
995	DO jst=1,nstm
996	WRITE (var_name,"('profil_froz_hydro_',i1)") jst
997	CALL histwrite_p(hist_id, TRIM(var_name), kjit, profil_froz_hydro_ns(:,:,jst), kjpindex*nslm, indexlayer)
998	ENDDO
999	CALL histwrite_p(hist_id, 'temp_hydro', kjit,temp_hydro , kjpindex*nslm, indexlayer)
1000	CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
1001	ENDIF
1002
1003	IF (first_hydrol_main) THEN
1004	first_hydrol_main=.FALSE.
1005	ENDIF
1006	IF (printlev>=3) WRITE (numout,*) ' hydrol_main Done '
1007
1008	END SUBROUTINE hydrol_main
1009
1010
1011	!! ================================================================================================================================
1012	!! SUBROUTINE : hydrol_finalize
1013	!!
1014	!>\BRIEF
1015	!!
1016	!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrol to restart file
1017	!!
1018	!! MAIN OUTPUT VARIABLE(S) :
1019	!!
1020	!! REFERENCE(S) :
1021	!!
1022	!! FLOWCHART : None
1023	!! \n
1024	!_ ================================================================================================================================
1025
1026	SUBROUTINE hydrol_finalize( kjit, kjpindex, rest_id, vegstress, &
1027	qsintveg, humrel, snow, snow_age, snow_nobio, &
1028	snow_nobio_age, snowrho, snowtemp, snowdz, &
1029	snowheat, snowgrain, &
1030	drysoil_frac, evap_bare_lim)
1031
1032	!! 0. Variable and parameter declaration
1033	!! 0.1 Input variables
1034	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
1035	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
1036	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
1037	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1038	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
1039	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: humrel
1040	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
1041	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow_age !! Snow age
1042	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
1043	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age !! Snow age on ice, lakes, ...
1044	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho !! Snow density
1045	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature
1046	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowdz !! Snow layer thickness
1047	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowheat !! Snow heat content
1048	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowgrain !! Snow grainsize
1049	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: drysoil_frac !! function of litter wetness
1050	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: evap_bare_lim
1051
1052	!! 0.4 Local variables
1053	INTEGER(i_std) :: jst, jsl
1054
1055	!_ ================================================================================================================================
1056
1057
1058	IF (printlev>=3) WRITE (numout,*) 'Write restart file with HYDROLOGIC variables '
1059	CALL restput_p(rest_id, 'moistc', nbp_glo, nslm, nstm, kjit, mc, 'scatter', nbp_glo, index_g)
1060	CALL restput_p(rest_id, 'moistcl', nbp_glo, nslm, nstm, kjit, mcl, 'scatter', nbp_glo, index_g)
1061	CALL restput_p(rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, us, 'scatter', nbp_glo, index_g)
1062	CALL restput_p(rest_id, 'free_drain_coef', nbp_glo, nstm, 1, kjit, free_drain_coef, 'scatter', nbp_glo, index_g)
1063	CALL restput_p(rest_id, 'zwt_force', nbp_glo, nstm, 1, kjit, zwt_force, 'scatter', nbp_glo, index_g)
1064	CALL restput_p(rest_id, 'water2infilt', nbp_glo, nstm, 1, kjit, water2infilt, 'scatter', nbp_glo, index_g)
1065	CALL restput_p(rest_id, 'ae_ns', nbp_glo, nstm, 1, kjit, ae_ns, 'scatter', nbp_glo, index_g)
1066	CALL restput_p(rest_id, 'vegstress', nbp_glo, nvm, 1, kjit, vegstress, 'scatter', nbp_glo, index_g)
1067	CALL restput_p(rest_id, 'snow', nbp_glo, 1, 1, kjit, snow, 'scatter', nbp_glo, index_g)
1068	CALL restput_p(rest_id, 'snow_age', nbp_glo, 1, 1, kjit, snow_age, 'scatter', nbp_glo, index_g)
1069	CALL restput_p(rest_id, 'snow_nobio', nbp_glo, nnobio, 1, kjit, snow_nobio, 'scatter', nbp_glo, index_g)
1070	CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo, nnobio, 1, kjit, snow_nobio_age, 'scatter', nbp_glo, index_g)
1071	CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit, qsintveg, 'scatter', nbp_glo, index_g)
1072	CALL restput_p(rest_id, 'evap_bare_lim_ns', nbp_glo, nstm, 1, kjit, evap_bare_lim_ns, 'scatter', nbp_glo, index_g)
1073	CALL restput_p(rest_id, 'evap_bare_lim', nbp_glo, 1, 1, kjit, evap_bare_lim, 'scatter', nbp_glo, index_g)
1074	CALL restput_p(rest_id, 'resdist', nbp_glo, nstm, 1, kjit, resdist, 'scatter', nbp_glo, index_g)
1075	CALL restput_p(rest_id, 'vegtot_old', nbp_glo, 1, 1, kjit, vegtot_old, 'scatter', nbp_glo, index_g)
1076	CALL restput_p(rest_id, 'drysoil_frac', nbp_glo, 1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
1077	CALL restput_p(rest_id, 'humrel', nbp_glo, nvm, 1, kjit, humrel, 'scatter', nbp_glo, index_g)
1078
1079	CALL restput_p(rest_id, 'tot_watveg_beg', nbp_glo, 1, 1, kjit, tot_watveg_beg, 'scatter', nbp_glo, index_g)
1080	CALL restput_p(rest_id, 'tot_watsoil_beg', nbp_glo, 1, 1, kjit, tot_watsoil_beg, 'scatter', nbp_glo, index_g)
1081	CALL restput_p(rest_id, 'snow_beg', nbp_glo, 1, 1, kjit, snow_beg, 'scatter', nbp_glo, index_g)
1082
1083	! Write variables for explictsnow module to restart file
1084	CALL explicitsnow_finalize ( kjit, kjpindex, rest_id, snowrho, &
1085	snowtemp, snowdz, snowheat, snowgrain)
1086
1087	END SUBROUTINE hydrol_finalize
1088
1089
1090	!! ================================================================================================================================
1091	!! SUBROUTINE : hydrol_init
1092	!!
1093	!>\BRIEF Initializations and memory allocation
1094	!!
1095	!! DESCRIPTION :
1096	!! - 1 Some initializations
1097	!! - 2 make dynamic allocation with good dimension
1098	!! - 2.1 array allocation for soil textur
1099	!! - 2.2 Soil texture choice
1100	!! - 3 Other array allocation
1101	!! - 4 Open restart input file and read data for HYDROLOGIC process
1102	!! - 5 get restart values if none were found in the restart file
1103	!! - 6 Vegetation array
1104	!! - 7 set humrelv from us
1105	!!
1106	!! RECENT CHANGE(S) : None
1107	!!
1108	!! MAIN OUTPUT VARIABLE(S) :
1109	!!
1110	!! REFERENCE(S) :
1111	!!
1112	!! FLOWCHART : None
1113	!! \n
1114	!_ ================================================================================================================================
1115	!!_ hydrol_init
1116
1117	SUBROUTINE hydrol_init(kjit, kjpindex, index, rest_id, njsc, veget_max, soiltile, &
1118	humrel, vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg, &
1119	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
1120	drysoil_frac, evap_bare_lim)
1121
1122
1123	!! 0. Variable and parameter declaration
1124
1125	!! 0.1 Input variables
1126
1127	INTEGER(i_std), INTENT (in) :: kjit !! Time step number
1128	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
1129	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
1130	INTEGER(i_std), INTENT (in) :: rest_id !! _Restart_ file identifier
1131	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the
1132	!! grid cell (1-nscm, unitless)
1133	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Carte de vegetation max
1134	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
1135
1136	!! 0.2 Output variables
1137
1138	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Stress hydrique, relative humidity
1139	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1140	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
1141	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
1142	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio !! Snow on ice, lakes, ...
1143	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age !! Snow age on ice, lakes, ...
1144	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
1145	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowdz !! Snow depth
1146	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowgrain !! Snow grain size
1147	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowheat !! Snow heat content
1148	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowtemp !! Snow temperature
1149	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowrho !! Snow density
1150	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: drysoil_frac !! function of litter wetness
1151	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: evap_bare_lim
1152
1153	!! 0.4 Local variables
1154
1155	INTEGER(i_std) :: ier !! Error code
1156	INTEGER(i_std) :: ji !! Index of land grid cells (1)
1157	INTEGER(i_std) :: jv !! Index of PFTs (1)
1158	INTEGER(i_std) :: jst !! Index of soil tiles (1)
1159	INTEGER(i_std) :: jsl !! Index of soil layers (1)
1160	INTEGER(i_std) :: jsc !! Index of soil texture (1)
1161	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
1162	!! Switch to 2 tu turn fatal errors into warnings
1163	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: free_drain_max !! Temporary var for initialization of free_drain_coef
1164	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: zwt_default !! Temporary variable for initialization of zwt_force
1165	LOGICAL :: zforce !! To test if we force the WT in any of the soiltiles
1166
1167	!_ ================================================================================================================================
1168
1169	!! 1 Some initializations
1170	!
1171	!Config Key = DO_PONDS
1172	!Config Desc = Should we include ponds
1173	!Config Def = n
1174	!Config If =
1175	!Config Help = This parameters allows the user to ask the model
1176	!Config to take into account the ponds and return
1177	!Config the water into the soil moisture. If this is
1178	!Config activated, then there is no reinfiltration
1179	!Config computed inside the hydrol module.
1180	!Config Units = [FLAG]
1181	!
1182	doponds = .FALSE.
1183	CALL getin_p('DO_PONDS', doponds)
1184
1185	!Config Key = FROZ_FRAC_CORR
1186	!Config Desc = Coefficient for the frozen fraction correction
1187	!Config Def = 1.0
1188	!Config If = OK_FREEZE
1189	!Config Help =
1190	!Config Units = [-]
1191	!
1192	froz_frac_corr = 1.0
1193	CALL getin_p("FROZ_FRAC_CORR", froz_frac_corr)
1194
1195	!Config Key = MAX_FROZ_HYDRO
1196	!Config Desc = Coefficient for the frozen fraction correction
1197	!Config Def = 1.0
1198	!Config If = OK_FREEZE
1199	!Config Help =
1200	!Config Units = [-]
1201	max_froz_hydro = 1.0
1202	CALL getin_p("MAX_FROZ_HYDRO", max_froz_hydro)
1203
1204	!Config Key = SMTOT_CORR
1205	!Config Desc = Coefficient for the frozen fraction correction
1206	!Config Def = 2.0
1207	!Config If = OK_FREEZE
1208	!Config Help =
1209	!Config Units = [-]
1210	smtot_corr = 2.0
1211	CALL getin_p("SMTOT_CORR", smtot_corr)
1212
1213	!Config Key = DO_RSOIL
1214	!Config Desc = Should we reduce soil evaporation with a soil resistance
1215	!Config Def = n
1216	!Config If =
1217	!Config Help = This parameters allows the user to ask the model
1218	!Config to calculate a soil resistance to reduce the soil evaporation
1219	!Config Units = [FLAG]
1220	!
1221	do_rsoil = .FALSE.
1222	CALL getin_p('DO_RSOIL', do_rsoil)
1223
1224	!Config Key = OK_DYNROOT
1225	!Config Desc = Calculate dynamic root profile to optimize soil moisture usage
1226	!Config Def = n
1227	!Config If =
1228	!Config Help =
1229	!Config Units = [FLAG]
1230	ok_dynroot = .FALSE.
1231	CALL getin_p('OK_DYNROOT',ok_dynroot)
1232
1233	!! 2 make dynamic allocation with good dimension
1234
1235	!! 2.1 array allocation for soil texture
1236	! Some of these variables may already be allocated in sechiba_hydrol_arch
1237	! if hydraulic architecture is used to calculate plant water stress. If
1238	! so ier is not defined. Therefore the if-statement testing ier should be
1239	! within the .NOT. ALLOCATED if-statement.
1240	IF (.NOT. ALLOCATED(nvan)) THEN
1241	ALLOCATE (nvan(nscm),stat=ier)
1242	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable nvan','','')
1243	ENDIF
1244
1245	IF (.NOT. ALLOCATED(avan)) THEN
1246	ALLOCATE (avan(nscm),stat=ier)
1247	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable avan','','')
1248	ENDIF
1249
1250	IF (.NOT. ALLOCATED(mcr)) THEN
1251	ALLOCATE (mcr(nscm),stat=ier)
1252	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcr','','')
1253	ENDIF
1254
1255	IF (.NOT. ALLOCATED(mcs)) THEN
1256	ALLOCATE (mcs(nscm),stat=ier)
1257	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcs','','')
1258	ENDIF
1259
1260	ALLOCATE (ks(nscm),stat=ier)
1261	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable ks','','')
1262
1263	ALLOCATE (pcent(nscm),stat=ier)
1264	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable pcent','','')
1265
1266	ALLOCATE (mcf(nscm),stat=ier)
1267	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcf','','')
1268
1269	ALLOCATE (mcw(nscm),stat=ier)
1270	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mcw','','')
1271
1272	ALLOCATE (mc_awet(nscm),stat=ier)
1273	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mc_awet','','')
1274
1275	ALLOCATE (mc_adry(nscm),stat=ier)
1276	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Pb in allocate of variable mc_adry','','')
1277
1278	!!__2.2 Soil texture choose
1279
1280	SELECTCASE (nscm)
1281	CASE (3)
1282
1283	nvan(:) = nvan_fao(:)
1284	avan(:) = avan_fao(:)
1285	mcr(:) = mcr_fao(:)
1286	mcs(:) = mcs_fao(:)
1287	ks(:) = ks_fao(:)
1288	pcent(:) = pcent_fao(:)
1289	mcf(:) = mcf_fao(:)
1290	mcw(:) = mcw_fao(:)
1291	mc_awet(:) = mc_awet_fao(:)
1292	mc_adry(:) = mc_adry_fao(:)
1293	CASE (12)
1294
1295	nvan(:) = nvan_usda(:)
1296	avan(:) = avan_usda(:)
1297	mcr(:) = mcr_usda(:)
1298	mcs(:) = mcs_usda(:)
1299	ks(:) = ks_usda(:)
1300	pcent(:) = pcent_usda(:)
1301	mcf(:) = mcf_usda(:)
1302	mcw(:) = mcw_usda(:)
1303	mc_awet(:) = mc_awet_usda(:)
1304	mc_adry(:) = mc_adry_usda(:)
1305
1306	CASE DEFAULT
1307	WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler and usda according to the map'
1308	CALL ipslerr_p(3,'hydrol_init','Unsupported soil type classification. ',&
1309	'Choose between zobler and usda according to the map','')
1310	ENDSELECT
1311
1312	!! 2.3 Read in the run.def the parameters values defined by the user
1313
1314	!Config Key = CWRR_N_VANGENUCHTEN
1315	!Config Desc = Van genuchten coefficient n
1316	!Config If =
1317	!Config Def = 1.89, 1.56, 1.31
1318	!Config Help = This parameter will be constant over the entire
1319	!Config simulated domain, thus independent from soil
1320	!Config texture.
1321	!Config Units = [-]
1322	CALL getin_p("CWRR_N_VANGENUCHTEN",nvan)
1323
1324	!! Check parameter value (correct range)
1325	IF ( ANY(nvan(:) <= zero) ) THEN
1326	CALL ipslerr_p(error_level, "hydrol_init.", &
1327	& "Wrong parameter value for CWRR_N_VANGENUCHTEN.", &
1328	& "This parameter should be positive. ", &
1329	& "Please, check parameter value in run.def. ")
1330	END IF
1331
1332
1333	!Config Key = CWRR_A_VANGENUCHTEN
1334	!Config Desc = Van genuchten coefficient a
1335	!Config If =
1336	!Config Def = 0.0075, 0.0036, 0.0019
1337	!Config Help = This parameter will be constant over the entire
1338	!Config simulated domain, thus independent from soil
1339	!Config texture.
1340	!Config Units = [1/mm]
1341	CALL getin_p("CWRR_A_VANGENUCHTEN",avan)
1342
1343	!! Check parameter value (correct range)
1344	IF ( ANY(avan(:) <= zero) ) THEN
1345	CALL ipslerr_p(error_level, "hydrol_init.", &
1346	& "Wrong parameter value for CWRR_A_VANGENUCHTEN.", &
1347	& "This parameter should be positive. ", &
1348	& "Please, check parameter value in run.def. ")
1349	END IF
1350
1351
1352	!Config Key = VWC_RESIDUAL
1353	!Config Desc = Residual soil water content
1354	!Config If =
1355	!Config Def = 0.065, 0.078, 0.095
1356	!Config Help = This parameter will be constant over the entire
1357	!Config simulated domain, thus independent from soil
1358	!Config texture.
1359	!Config Units = [m3/m3]
1360	CALL getin_p("VWC_RESIDUAL",mcr)
1361
1362	!! Check parameter value (correct range)
1363	IF ( ANY(mcr(:) < zero) .OR. ANY(mcr(:) > 1.) ) THEN
1364	CALL ipslerr_p(error_level, "hydrol_init.", &
1365	& "Wrong parameter value for VWC_RESIDUAL.", &
1366	& "This parameter is ranged between 0 and 1. ", &
1367	& "Please, check parameter value in run.def. ")
1368	END IF
1369
1370
1371	!Config Key = VWC_SAT
1372	!Config Desc = Saturated soil water content
1373	!Config If =
1374	!Config Def = 0.41, 0.43, 0.41
1375	!Config Help = This parameter will be constant over the entire
1376	!Config simulated domain, thus independent from soil
1377	!Config texture.
1378	!Config Units = [m3/m3]
1379	CALL getin_p("VWC_SAT",mcs)
1380
1381	!! Check parameter value (correct range)
1382	IF ( ANY(mcs(:) < zero) .OR. ANY(mcs(:) > 1.) .OR. ANY(mcs(:) <= mcr(:)) ) THEN
1383	CALL ipslerr_p(error_level, "hydrol_init.", &
1384	& "Wrong parameter value for VWC_SAT.", &
1385	& "This parameter should be greater than VWC_RESIDUAL and less than 1. ", &
1386	& "Please, check parameter value in run.def. ")
1387	END IF
1388
1389
1390	!Config Key = CWRR_KS
1391	!Config Desc = Hydraulic conductivity Saturation
1392	!Config If =
1393	!Config Def = 1060.8, 249.6, 62.4
1394	!Config Help = This parameter will be constant over the entire
1395	!Config simulated domain, thus independent from soil
1396	!Config texture.
1397	!Config Units = [mm/d]
1398	CALL getin_p("CWRR_KS",ks)
1399
1400	!! Check parameter value (correct range)
1401	IF ( ANY(ks(:) <= zero) ) THEN
1402	CALL ipslerr_p(error_level, "hydrol_init.", &
1403	& "Wrong parameter value for CWRR_KS.", &
1404	& "This parameter should be positive. ", &
1405	& "Please, check parameter value in run.def. ")
1406	END IF
1407
1408
1409	!Config Key = WETNESS_TRANSPIR_MAX
1410	!Config Desc = Soil moisture above which transpir is max
1411	!Config If =
1412	!Config Def = 0.5, 0.5, 0.5
1413	!Config Help = This parameter is independent from soil texture for
1414	!Config the time being.
1415	!Config Units = [-]
1416	CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
1417
1418	!! Check parameter value (correct range)
1419	IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
1420	CALL ipslerr_p(error_level, "hydrol_init.", &
1421	& "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
1422	& "This parameter should be positive and less or equals than 1. ", &
1423	& "Please, check parameter value in run.def. ")
1424	END IF
1425
1426
1427	!Config Key = VWC_FC
1428	!Config Desc = Volumetric water content field capacity
1429	!Config If =
1430	!Config Def = 0.32, 0.32, 0.32
1431	!Config Help = This parameter is independent from soil texture for
1432	!Config the time being.
1433	!Config Units = [m3/m3]
1434	CALL getin_p("VWC_FC",mcf)
1435
1436	!! Check parameter value (correct range)
1437	IF ( ANY(mcf(:) > mcs(:)) ) THEN
1438	CALL ipslerr_p(error_level, "hydrol_init.", &
1439	& "Wrong parameter value for VWC_FC.", &
1440	& "This parameter should be less than VWC_SAT. ", &
1441	& "Please, check parameter value in run.def. ")
1442	END IF
1443
1444
1445	!Config Key = VWC_WP
1446	!Config Desc = Volumetric water content Wilting pt
1447	!Config If =
1448	!Config Def = 0.10, 0.10, 0.10
1449	!Config Help = This parameter is independent from soil texture for
1450	!Config the time being.
1451	!Config Units = [m3/m3]
1452	CALL getin_p("VWC_WP",mcw)
1453
1454	!! Check parameter value (correct range)
1455	IF ( ANY(mcw(:) > mcf(:)) .OR. ANY(mcw(:) < mcr(:)) ) THEN
1456	CALL ipslerr_p(error_level, "hydrol_init.", &
1457	& "Wrong parameter value for VWC_WP.", &
1458	& "This parameter should be greater or equal than VWC_RESIDUAL and less or equal than VWC_SAT.", &
1459	& "Please, check parameter value in run.def. ")
1460	END IF
1461
1462
1463	!Config Key = VWC_MIN_FOR_WET_ALB
1464	!Config Desc = Vol. wat. cont. above which albedo is cst
1465	!Config If =
1466	!Config Def = 0.25, 0.25, 0.25
1467	!Config Help = This parameter is independent from soil texture for
1468	!Config the time being.
1469	!Config Units = [m3/m3]
1470	CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
1471
1472	!! Check parameter value (correct range)
1473	IF ( ANY(mc_awet(:) < 0) ) THEN
1474	CALL ipslerr_p(error_level, "hydrol_init.", &
1475	& "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
1476	& "This parameter should be positive. ", &
1477	& "Please, check parameter value in run.def. ")
1478	END IF
1479
1480
1481	!Config Key = VWC_MAX_FOR_DRY_ALB
1482	!Config Desc = Vol. wat. cont. below which albedo is cst
1483	!Config If =
1484	!Config Def = 0.1, 0.1, 0.1
1485	!Config Help = This parameter is independent from soil texture for
1486	!Config the time being.
1487	!Config Units = [m3/m3]
1488	CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
1489
1490	!! Check parameter value (correct range)
1491	IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
1492	CALL ipslerr_p(error_level, "hydrol_init.", &
1493	& "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
1494	& "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
1495	& "Please, check parameter value in run.def. ")
1496	END IF
1497
1498
1499	!! 3 Other array allocation
1500
1501
1502	ALLOCATE (mask_veget(kjpindex,nvm),stat=ier)
1503	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_veget','','')
1504
1505	ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier)
1506	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_soiltile','','')
1507
1508	ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier)
1509	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humrelv','','')
1510
1511	ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier)
1512	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegstressv','','')
1513
1514	ALLOCATE (us(kjpindex,nvm,nstm,nslm),stat=ier)
1515	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable us','','')
1516
1517	ALLOCATE (precisol(kjpindex,nvm),stat=ier)
1518	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol','','')
1519
1520	ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier)
1521	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol_nc','','')
1522
1523	ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier)
1524	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_coef','','')
1525
1526	ALLOCATE (zwt_force(kjpindex,nstm),stat=ier)
1527	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_force','','')
1528
1529	ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier)
1530	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_bare_ns','','')
1531
1532	ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
1533	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable water2infilt','','')
1534
1535	ALLOCATE (ae_ns(kjpindex,nstm),stat=ier)
1536	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ae_ns','','')
1537
1538	ALLOCATE (evap_bare_lim_ns(kjpindex,nstm),stat=ier)
1539	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable evap_bare_lim_ns','','')
1540
1541	ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier)
1542	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rootsink','','')
1543
1544	ALLOCATE (subsnowveg(kjpindex),stat=ier)
1545	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnowveg','','')
1546
1547	ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier)
1548	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnownobio','','')
1549
1550	ALLOCATE (icemelt(kjpindex),stat=ier)
1551	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable icemelt','','')
1552
1553	ALLOCATE (subsinksoil(kjpindex),stat=ier)
1554	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsinksoil','','')
1555
1556	ALLOCATE (mx_eau_var(kjpindex),stat=ier)
1557	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mx_eau_var','','')
1558
1559	ALLOCATE (vegtot(kjpindex),stat=ier)
1560	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot','','')
1561
1562	ALLOCATE (vegtot_old(kjpindex),stat=ier)
1563	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot_old','','')
1564
1565	ALLOCATE (resdist(kjpindex,nstm),stat=ier)
1566	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resdist','','')
1567
1568	ALLOCATE (humtot(kjpindex),stat=ier)
1569	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot','','')
1570
1571	ALLOCATE (resolv(kjpindex),stat=ier)
1572	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resolv','','')
1573
1574	ALLOCATE (k(kjpindex,nslm),stat=ier)
1575	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k','','')
1576
1577	IF (ok_freeze_cwrr) THEN
1578	ALLOCATE (kk_moy(kjpindex,nslm),stat=ier)
1579	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk_moy','','')
1580	kk_moy(:,:) = 276.48
1581
1582	ALLOCATE (kk(kjpindex,nslm,nstm),stat=ier)
1583	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk','','')
1584	kk(:,:,:) = 276.48
1585	ENDIF
1586
1587	ALLOCATE (a(kjpindex,nslm),stat=ier)
1588	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a','','')
1589
1590	ALLOCATE (b(kjpindex,nslm),stat=ier)
1591	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b','','')
1592
1593	ALLOCATE (d(kjpindex,nslm),stat=ier)
1594	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d','','')
1595
1596	ALLOCATE (e(kjpindex,nslm),stat=ier)
1597	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable e','','')
1598
1599	ALLOCATE (f(kjpindex,nslm),stat=ier)
1600	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable f','','')
1601
1602	ALLOCATE (g1(kjpindex,nslm),stat=ier)
1603	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable g1','','')
1604
1605	ALLOCATE (ep(kjpindex,nslm),stat=ier)
1606	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ep','','')
1607
1608	ALLOCATE (fp(kjpindex,nslm),stat=ier)
1609	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable fp','','')
1610
1611	ALLOCATE (gp(kjpindex,nslm),stat=ier)
1612	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable gp','','')
1613
1614	ALLOCATE (rhs(kjpindex,nslm),stat=ier)
1615	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rhs','','')
1616
1617	ALLOCATE (srhs(kjpindex,nslm),stat=ier)
1618	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable srhs','','')
1619
1620	ALLOCATE (tmc(kjpindex,nstm),stat=ier)
1621	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc','','')
1622
1623	ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
1624	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcs','','')
1625
1626	ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
1627	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcr','','')
1628
1629	ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
1630	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter','','')
1631
1632	ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
1633	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_mea','','')
1634
1635	ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
1636	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_res','','')
1637
1638	ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
1639	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_wilt','','')
1640
1641	ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
1642	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_field','','')
1643
1644	ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
1645	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_sat','','')
1646
1647	ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
1648	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_awet','','')
1649
1650	ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
1651	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_adry','','')
1652
1653	ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
1654	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_wet_mea','','')
1655
1656	ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
1657	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_dry_mea','','')
1658
1659	ALLOCATE (v1(kjpindex,nstm),stat=ier)
1660	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable v1','','')
1661
1662	ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
1663	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ru_ns','','')
1664	ru_ns(:,:) = zero
1665
1666	ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
1667	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dr_ns','','')
1668	dr_ns(:,:) = zero
1669
1670	ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
1671	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tr_ns','','')
1672
1673	ALLOCATE (vegetmax_soil(kjpindex,nvm,nstm),stat=ier)
1674	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegetmax_soil','','')
1675
1676	ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
1677	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc','','')
1678
1679	ALLOCATE (mcl(kjpindex, nslm, nstm),stat=ier)
1680	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcl','','')
1681
1682	IF (ok_freeze_cwrr) THEN
1683	ALLOCATE (profil_froz_hydro(kjpindex, nslm),stat=ier)
1684	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydrol','','')
1685	profil_froz_hydro(:,:) = zero
1686
1687	ALLOCATE (temp_hydro(kjpindex, nslm),stat=ier)
1688	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable temp_hydro','','')
1689	temp_hydro(:,:) = 280.
1690	ENDIF
1691
1692	ALLOCATE (profil_froz_hydro_ns(kjpindex, nslm, nstm),stat=ier)
1693	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydro_ns','','')
1694	profil_froz_hydro_ns(:,:,:) = zero
1695
1696	ALLOCATE (frac_hydro_diag(nslm, nbdl),stat=ier)
1697	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_hydro_diag','','')
1698
1699	ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
1700	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
1701
1702	ALLOCATE (soil_wet(kjpindex,nslm,nstm),stat=ier)
1703	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet','','')
1704
1705	ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
1706	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_litter','','')
1707
1708	ALLOCATE (qflux_ns(kjpindex,nslm,nstm),stat=ier)
1709	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux_ns','','')
1710
1711	ALLOCATE (check_top_ns(kjpindex,nstm),stat=ier)
1712	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable check_top_ns','','')
1713
1714	ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
1715	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmat','','')
1716
1717	ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
1718	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable stmat','','')
1719
1720	ALLOCATE (nroot(kjpindex,nvm,nslm),stat=ier)
1721	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nroot','','')
1722
1723	ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
1724	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact_root','','')
1725
1726	ALLOCATE (kfact(nslm, nscm),stat=ier)
1727	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact','','')
1728
1729	ALLOCATE (zz(nslm),stat=ier)
1730	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zz','','')
1731
1732	ALLOCATE (dz(nslm),stat=ier)
1733	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dz','','')
1734
1735	ALLOCATE (dh(nslm),stat=ier)
1736	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dh','','')
1737
1738	ALLOCATE (mc_lin(imin:imax, nscm),stat=ier)
1739	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_lin','','')
1740
1741	ALLOCATE (k_lin(imin:imax, nslm, nscm),stat=ier)
1742	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k_lin','','')
1743
1744	ALLOCATE (d_lin(imin:imax, nslm, nscm),stat=ier)
1745	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d_lin','','')
1746
1747	ALLOCATE (a_lin(imin:imax, nslm, nscm),stat=ier)
1748	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a_lin','','')
1749
1750	ALLOCATE (b_lin(imin:imax, nslm, nscm),stat=ier)
1751	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b_lin','','')
1752
1753	ALLOCATE (undermcr(kjpindex),stat=ier)
1754	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable undermcr','','')
1755
1756	ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
1757	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watveg_beg','','')
1758
1759	ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
1760	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watvag_end','','')
1761
1762	ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
1763	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_beg','','')
1764
1765	ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
1766	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_end','','')
1767
1768	ALLOCATE (delsoilmoist(kjpindex),stat=ier)
1769	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delsoilmoist','','')
1770
1771	ALLOCATE (delintercept(kjpindex),stat=ier)
1772	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delintercept','','')
1773
1774	ALLOCATE (delswe(kjpindex),stat=ier)
1775	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delswe','','')
1776
1777	ALLOCATE (snow_beg(kjpindex),stat=ier)
1778	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_beg','','')
1779
1780	ALLOCATE (snow_end(kjpindex),stat=ier)
1781	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_end','','')
1782
1783	!! 4 Open restart input file and read data for HYDROLOGIC process
1784	IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
1785
1786	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
1787	CALL restget_p (rest_id, 'moistc', nbp_glo, nslm , nstm, kjit, .TRUE., mc, "gather", nbp_glo, index_g)
1788
1789	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
1790	CALL restget_p (rest_id, 'moistcl', nbp_glo, nslm , nstm, kjit, .TRUE., mcl, "gather", nbp_glo, index_g)
1791
1792	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
1793	CALL ioconf_setatt_p('LONG_NAME','us')
1794	CALL restget_p (rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, .TRUE., us, "gather", nbp_glo, index_g)
1795	!
1796	var_name= 'free_drain_coef'
1797	IF (is_root_prc) THEN
1798	CALL ioconf_setatt_p('UNITS', '-')
1799	CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
1800	ENDIF
1801	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
1802	!
1803	var_name= 'zwt_force'
1804	IF (is_root_prc) THEN
1805	CALL ioconf_setatt_p('UNITS', 'm')
1806	CALL ioconf_setatt_p('LONG_NAME','Prescribed water table depth')
1807	ENDIF
1808	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., zwt_force, "gather", nbp_glo, index_g)
1809	!
1810	var_name= 'water2infilt'
1811	IF (is_root_prc) THEN
1812	CALL ioconf_setatt_p('UNITS', '-')
1813	CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
1814	ENDIF
1815	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
1816	!
1817	var_name= 'ae_ns'
1818	IF (is_root_prc) THEN
1819	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1820	CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
1821	ENDIF
1822	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
1823	!
1824	var_name= 'snow'
1825	IF (is_root_prc) THEN
1826	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1827	CALL ioconf_setatt_p('LONG_NAME','Snow mass')
1828	ENDIF
1829	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
1830	!
1831	var_name= 'snow_age'
1832	IF (is_root_prc) THEN
1833	CALL ioconf_setatt_p('UNITS', 'd')
1834	CALL ioconf_setatt_p('LONG_NAME','Snow age')
1835	ENDIF
1836	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
1837	!
1838	var_name= 'snow_nobio'
1839	IF (is_root_prc) THEN
1840	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1841	CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
1842	ENDIF
1843	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
1844	!
1845	var_name= 'snow_nobio_age'
1846	IF (is_root_prc) THEN
1847	CALL ioconf_setatt_p('UNITS', 'd')
1848	CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
1849	ENDIF
1850	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
1851	!
1852	var_name= 'qsintveg'
1853	IF (is_root_prc) THEN
1854	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1855	CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
1856	ENDIF
1857	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
1858
1859	var_name= 'evap_bare_lim_ns'
1860	IF (is_root_prc) THEN
1861	CALL ioconf_setatt_p('UNITS', '?')
1862	CALL ioconf_setatt_p('LONG_NAME','?')
1863	ENDIF
1864	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., evap_bare_lim_ns, "gather", nbp_glo, index_g)
1865	CALL setvar_p (evap_bare_lim_ns, val_exp, 'NO_KEYWORD', 0.0)
1866
1867	var_name= 'resdist'
1868	IF (is_root_prc) THEN
1869	CALL ioconf_setatt_p('UNITS', '-')
1870	CALL ioconf_setatt_p('LONG_NAME','soiltile values from previous time-step')
1871	ENDIF
1872	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
1873
1874	var_name = 'veget_old'
1875	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
1876	CALL ioconf_setatt_p('LONG_NAME','vegtot from previous time-step')
1877	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_old, "gather", nbp_glo, index_g)
1878
1879	! Read drysoil_frac. It will be initalized later in hydrol_var_init if the varaible is not find in restart file.
1880	IF (is_root_prc) THEN
1881	CALL ioconf_setatt_p('UNITS', '')
1882	CALL ioconf_setatt_p('LONG_NAME','Function of litter wetness')
1883	ENDIF
1884	CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1 , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
1885
1886
1887	!! 5 get restart values if none were found in the restart file
1888	!
1889	!Config Key = HYDROL_MOISTURE_CONTENT
1890	!Config Desc = Soil moisture on each soil tile and levels
1891	!Config If =
1892	!Config Def = 0.3
1893	!Config Help = The initial value of mc if its value is not found
1894	!Config in the restart file. This should only be used if the model is
1895	!Config started without a restart file.
1896	!Config Units = [m3/m3]
1897	!
1898	CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
1899
1900	! Initialize mcl as mc if it is not found in the restart file
1901	IF ( ALL(mcl(:,:,:)==val_exp) ) THEN
1902	mcl(:,:,:) = mc(:,:,:)
1903	END IF
1904
1905
1906	!Config Key = US_INIT
1907	!Config Desc = US_NVM_NSTM_NSLM
1908	!Config If =
1909	!Config Def = 0.0
1910	!Config Help = The initial value of us (relative moisture) if its value is not found
1911	!Config in the restart file. This should only be used if the model is
1912	!Config started without a restart file.
1913	!Config Units = [-]
1914	!
1915	DO jsl=1,nslm
1916	CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
1917	ENDDO
1918	!
1919	!Config Key = ZWT_FORCE
1920	!Config Desc = Prescribed water depth, dimension nstm
1921	!Config If =
1922	!Config Def = undef undef undef
1923	!Config Help = The initial value of zwt_force if its value is not found
1924	!Config in the restart file. undef corresponds to a case whith no forced WT.
1925	!Config This should only be used if the model is started without a restart file.
1926	!Config Units = [m]
1927
1928	ALLOCATE (zwt_default(nstm),stat=ier)
1929	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_default','','')
1930	zwt_default(:) = undef_sechiba
1931	CALL setvar_p (zwt_force, val_exp, 'ZWT_FORCE', zwt_default )
1932
1933	zforce = .FALSE.
1934	DO jst=1,nstm
1935	IF (zwt_force(1,jst) <= zmaxh) zforce = .TRUE. ! AD16*** check if OK with vertical_soil
1936	ENDDO
1937	!
1938	!Config Key = FREE_DRAIN_COEF
1939	!Config Desc = Coefficient for free drainage at bottom, dimension nstm
1940	!Config If =
1941	!Config Def = 1.0 1.0 1.0
1942	!Config Help = The initial value of free drainage coefficient if its value is not found
1943	!Config in the restart file. This should only be used if the model is
1944	!Config started without a restart file.
1945	!Config Units = [-]
1946
1947	ALLOCATE (free_drain_max(nstm),stat=ier)
1948	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init',&
1949	'Problem in allocate of variable free_drain_max','','')
1950	free_drain_max(:)=1.0
1951
1952	CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
1953	IF (printlev>=2) WRITE (numout,*) ' hydrol_init => free_drain_coef = ', &
1954	free_drain_coef(1,:)
1955	DEALLOCATE(free_drain_max)
1956
1957	!
1958	!Config Key = WATER_TO_INFILT
1959	!Config Desc = Water to be infiltrated on top of the soil
1960	!Config If =
1961	!Config Def = 0.0
1962	!Config Help = The initial value of free drainage if its value is not found
1963	!Config in the restart file. This should only be used if the model is
1964	!Config started without a restart file.
1965	!Config Units = [mm]
1966	!
1967	CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
1968	!
1969	!Config Key = EVAPNU_SOIL
1970	!Config Desc = Bare soil evap on each soil if not found in restart
1971	!Config If =
1972	!Config Def = 0.0
1973	!Config Help = The initial value of bare soils evap if its value is not found
1974	!Config in the restart file. This should only be used if the model is
1975	!Config started without a restart file.
1976	!Config Units = [mm]
1977	!
1978	CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
1979	!
1980	!Config Key = HYDROL_SNOW
1981	!Config Desc = Initial snow mass if not found in restart
1982	!Config If = OK_SECHIBA
1983	!Config Def = 0.0
1984	!Config Help = The initial value of snow mass if its value is not found
1985	!Config in the restart file. This should only be used if the model is
1986	!Config started without a restart file.
1987	!Config Units =
1988	!
1989	CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
1990	!
1991	!Config Key = HYDROL_SNOWAGE
1992	!Config Desc = Initial snow age if not found in restart
1993	!Config If = OK_SECHIBA
1994	!Config Def = 0.0
1995	!Config Help = The initial value of snow age if its value is not found
1996	!Config in the restart file. This should only be used if the model is
1997	!Config started without a restart file.
1998	!Config Units = ***
1999	!
2000	CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
2001	!
2002	!Config Key = HYDROL_SNOW_NOBIO
2003	!Config Desc = Initial snow amount on ice, lakes, etc. if not found in restart
2004	!Config If = OK_SECHIBA
2005	!Config Def = 0.0
2006	!Config Help = The initial value of snow if its value is not found
2007	!Config in the restart file. This should only be used if the model is
2008	!Config started without a restart file.
2009	!Config Units = [mm]
2010	!
2011	CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
2012	!
2013	!Config Key = HYDROL_SNOW_NOBIO_AGE
2014	!Config Desc = Initial snow age on ice, lakes, etc. if not found in restart
2015	!Config If = OK_SECHIBA
2016	!Config Def = 0.0
2017	!Config Help = The initial value of snow age if its value is not found
2018	!Config in the restart file. This should only be used if the model is
2019	!Config started without a restart file.
2020	!Config Units = ***
2021	!
2022	CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
2023	!
2024	!Config Key = HYDROL_QSV
2025	!Config Desc = Initial water on canopy if not found in restart
2026	!Config If = OK_SECHIBA
2027	!Config Def = 0.0
2028	!Config Help = The initial value of moisture on canopy if its value
2029	!Config is not found in the restart file. This should only be used if
2030	!Config the model is started without a restart file.
2031	!Config Units = [mm]
2032	!
2033	CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
2034
2035	!! 6 Vegetation array
2036	!
2037	! If resdist is not in restart file, initialize with soiltile
2038	IF ( MINVAL(resdist) .EQ. MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
2039	resdist(:,:) = soiltile(:,:)
2040	ENDIF
2041
2042	!
2043	! Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
2044	!
2045	IF ( ALL(vegtot_old(:) == val_exp) ) THEN
2046	! vegtot_old was not found in restart file
2047	DO ji = 1, kjpindex
2048	vegtot_old(ji) = SUM(veget_max(ji,:))
2049	ENDDO
2050	ENDIF
2051
2052	! In the initialization phase, vegtot must take the value from the previous time-step.
2053	! This is because hydrol_main is done before veget_max is updated at the end of the time step.
2054	vegtot(:) = vegtot_old(:)
2055
2056	!
2057	! compute the masks for veget
2058
2059	mask_veget(:,:) = 0
2060	mask_soiltile(:,:) = 0
2061
2062	DO jst=1,nstm
2063	DO ji = 1, kjpindex
2064	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
2065	mask_soiltile(ji,jst) = 1
2066	ENDIF
2067	END DO
2068	ENDDO
2069
2070	DO jv = 1, nvm
2071	DO ji = 1, kjpindex
2072	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
2073	mask_veget(ji,jv) = 1
2074	ENDIF
2075	END DO
2076	END DO
2077
2078	humrelv(:,:,:) = SUM(us,dim=4)
2079
2080
2081	!! 7a. Set vegstress
2082
2083	var_name= 'vegstress'
2084	IF (is_root_prc) THEN
2085	CALL ioconf_setatt_p('UNITS', '-')
2086	CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
2087	ENDIF
2088	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
2089
2090	vegstressv(:,:,:) = humrelv(:,:,:)
2091	! Calculate vegstress if it is not found in restart file
2092	IF (ALL(vegstress(:,:)==val_exp)) THEN
2093	DO jv=1,nvm
2094	DO ji=1,kjpindex
2095	vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,pref_soil_veg(jv))
2096	END DO
2097	END DO
2098	END IF
2099	!! 7b. Set humrel
2100	! Read humrel from restart file
2101	var_name= 'humrel'
2102	IF (is_root_prc) THEN
2103	CALL ioconf_setatt_p('UNITS', '')
2104	CALL ioconf_setatt_p('LONG_NAME','Relative humidity')
2105	ENDIF
2106	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
2107
2108	! Calculate humrel if it is not found in restart file
2109	IF (ALL(humrel(:,:)==val_exp)) THEN
2110	! set humrel from humrelv, assuming equi-repartition for the first time step
2111	humrel(:,:) = zero
2112	DO jv=1,nvm
2113	DO ji=1,kjpindex
2114	humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,pref_soil_veg(jv))
2115	END DO
2116	END DO
2117	END IF
2118
2119	! Read evap_bare_lim from restart file
2120	var_name= 'evap_bare_lim'
2121	IF (is_root_prc) THEN
2122	CALL ioconf_setatt_p('UNITS', '')
2123	CALL ioconf_setatt_p('LONG_NAME','Limitation factor for bare soil evaporation')
2124	ENDIF
2125	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evap_bare_lim, "gather", nbp_glo, index_g)
2126
2127	! Calculate evap_bare_lim if it was not found in the restart file.
2128	IF ( ALL(evap_bare_lim(:) == val_exp) ) THEN
2129	DO ji = 1, kjpindex
2130	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
2131	ENDDO
2132	END IF
2133
2134
2135	! Read from restart file
2136	! The variables tot_watsoil_beg, tot_watsoil_beg and snwo_beg will be initialized in the end of
2137	! hydrol_initialize if they were not found in the restart file.
2138
2139	var_name= 'tot_watveg_beg'
2140	IF (is_root_prc) THEN
2141	CALL ioconf_setatt_p('UNITS', '?')
2142	CALL ioconf_setatt_p('LONG_NAME','?')
2143	ENDIF
2144	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watveg_beg, "gather", nbp_glo, index_g)
2145
2146	var_name= 'tot_watsoil_beg'
2147	IF (is_root_prc) THEN
2148	CALL ioconf_setatt_p('UNITS', '?')
2149	CALL ioconf_setatt_p('LONG_NAME','?')
2150	ENDIF
2151	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watsoil_beg, "gather", nbp_glo, index_g)
2152
2153	var_name= 'snow_beg'
2154	IF (is_root_prc) THEN
2155	CALL ioconf_setatt_p('UNITS', '?')
2156	CALL ioconf_setatt_p('LONG_NAME','?')
2157	ENDIF
2158	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., snow_beg, "gather", nbp_glo, index_g)
2159
2160
2161	! Initialize variables for explictsnow module by reading restart file
2162	CALL explicitsnow_initialize( kjit, kjpindex, rest_id, snowrho, &
2163	snowtemp, snowdz, snowheat, snowgrain)
2164
2165
2166	IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
2167
2168	END SUBROUTINE hydrol_init
2169
2170
2171	!! ================================================================================================================================
2172	!! SUBROUTINE : hydrol_clear
2173	!!
2174	!>\BRIEF Deallocate arrays
2175	!!
2176	!_ ================================================================================================================================
2177	!_ hydrol_clear
2178
2179	SUBROUTINE hydrol_clear()
2180
2181	! Allocation for soiltile related parameters
2182	IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
2183	IF ( ALLOCATED (avan)) DEALLOCATE (avan)
2184	IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
2185	IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
2186	IF ( ALLOCATED (ks)) DEALLOCATE (ks)
2187	IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
2188	IF ( ALLOCATED (mcf)) DEALLOCATE (mcf)
2189	IF ( ALLOCATED (mcw)) DEALLOCATE (mcw)
2190	IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
2191	IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
2192	! Other arrays
2193	IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
2194	IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
2195	IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
2196	IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
2197	IF (ALLOCATED (us)) DEALLOCATE (us)
2198	IF (ALLOCATED (precisol)) DEALLOCATE (precisol)
2199	IF (ALLOCATED (precisol_ns)) DEALLOCATE (precisol_ns)
2200	IF (ALLOCATED (free_drain_coef)) DEALLOCATE (free_drain_coef)
2201	IF (ALLOCATED (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
2202	IF (ALLOCATED (water2infilt)) DEALLOCATE (water2infilt)
2203	IF (ALLOCATED (ae_ns)) DEALLOCATE (ae_ns)
2204	IF (ALLOCATED (evap_bare_lim_ns)) DEALLOCATE (evap_bare_lim_ns)
2205	IF (ALLOCATED (rootsink)) DEALLOCATE (rootsink)
2206	IF (ALLOCATED (subsnowveg)) DEALLOCATE (subsnowveg)
2207	IF (ALLOCATED (subsnownobio)) DEALLOCATE (subsnownobio)
2208	IF (ALLOCATED (icemelt)) DEALLOCATE (icemelt)
2209	IF (ALLOCATED (subsinksoil)) DEALLOCATE (subsinksoil)
2210	IF (ALLOCATED (mx_eau_var)) DEALLOCATE (mx_eau_var)
2211	IF (ALLOCATED (vegtot)) DEALLOCATE (vegtot)
2212	IF (ALLOCATED (vegtot_old)) DEALLOCATE (vegtot_old)
2213	IF (ALLOCATED (resdist)) DEALLOCATE (resdist)
2214	IF (ALLOCATED (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
2215	IF (ALLOCATED (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
2216	IF (ALLOCATED (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
2217	IF (ALLOCATED (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
2218	IF (ALLOCATED (delsoilmoist)) DEALLOCATE (delsoilmoist)
2219	IF (ALLOCATED (delintercept)) DEALLOCATE (delintercept)
2220	IF (ALLOCATED (snow_beg)) DEALLOCATE (snow_beg)
2221	IF (ALLOCATED (snow_end)) DEALLOCATE (snow_end)
2222	IF (ALLOCATED (delswe)) DEALLOCATE (delswe)
2223	IF (ALLOCATED (undermcr)) DEALLOCATE (undermcr)
2224	IF (ALLOCATED (v1)) DEALLOCATE (v1)
2225	IF (ALLOCATED (humtot)) DEALLOCATE (humtot)
2226	IF (ALLOCATED (resolv)) DEALLOCATE (resolv)
2227	IF (ALLOCATED (k)) DEALLOCATE (k)
2228	IF (ALLOCATED (kk)) DEALLOCATE (kk)
2229	IF (ALLOCATED (kk_moy)) DEALLOCATE (kk_moy)
2230	IF (ALLOCATED (a)) DEALLOCATE (a)
2231	IF (ALLOCATED (b)) DEALLOCATE (b)
2232	IF (ALLOCATED (d)) DEALLOCATE (d)
2233	IF (ALLOCATED (e)) DEALLOCATE (e)
2234	IF (ALLOCATED (f)) DEALLOCATE (f)
2235	IF (ALLOCATED (g1)) DEALLOCATE (g1)
2236	IF (ALLOCATED (ep)) DEALLOCATE (ep)
2237	IF (ALLOCATED (fp)) DEALLOCATE (fp)
2238	IF (ALLOCATED (gp)) DEALLOCATE (gp)
2239	IF (ALLOCATED (rhs)) DEALLOCATE (rhs)
2240	IF (ALLOCATED (srhs)) DEALLOCATE (srhs)
2241	IF (ALLOCATED (tmc)) DEALLOCATE (tmc)
2242	IF (ALLOCATED (tmcs)) DEALLOCATE (tmcs)
2243	IF (ALLOCATED (tmcr)) DEALLOCATE (tmcr)
2244	IF (ALLOCATED (tmc_litter)) DEALLOCATE (tmc_litter)
2245	IF (ALLOCATED (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
2246	IF (ALLOCATED (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
2247	IF (ALLOCATED (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
2248	IF (ALLOCATED (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
2249	IF (ALLOCATED (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
2250	IF (ALLOCATED (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
2251	IF (ALLOCATED (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
2252	IF (ALLOCATED (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
2253	IF (ALLOCATED (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
2254	IF (ALLOCATED (ru_ns)) DEALLOCATE (ru_ns)
2255	IF (ALLOCATED (dr_ns)) DEALLOCATE (dr_ns)
2256	IF (ALLOCATED (tr_ns)) DEALLOCATE (tr_ns)
2257	IF (ALLOCATED (vegetmax_soil)) DEALLOCATE (vegetmax_soil)
2258	IF (ALLOCATED (mc)) DEALLOCATE (mc)
2259	IF (ALLOCATED (soilmoist)) DEALLOCATE (soilmoist)
2260	IF (ALLOCATED (soil_wet)) DEALLOCATE (soil_wet)
2261	IF (ALLOCATED (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
2262	IF (ALLOCATED (qflux_ns)) DEALLOCATE (qflux_ns)
2263	IF (ALLOCATED (tmat)) DEALLOCATE (tmat)
2264	IF (ALLOCATED (stmat)) DEALLOCATE (stmat)
2265	IF (ALLOCATED (nroot)) DEALLOCATE (nroot)
2266	IF (ALLOCATED (kfact_root)) DEALLOCATE (kfact_root)
2267	IF (ALLOCATED (kfact)) DEALLOCATE (kfact)
2268	IF (ALLOCATED (zz)) DEALLOCATE (zz)
2269	IF (ALLOCATED (dz)) DEALLOCATE (dz)
2270	IF (ALLOCATED (dh)) DEALLOCATE (dh)
2271	IF (ALLOCATED (mc_lin)) DEALLOCATE (mc_lin)
2272	IF (ALLOCATED (k_lin)) DEALLOCATE (k_lin)
2273	IF (ALLOCATED (d_lin)) DEALLOCATE (d_lin)
2274	IF (ALLOCATED (a_lin)) DEALLOCATE (a_lin)
2275	IF (ALLOCATED (b_lin)) DEALLOCATE (b_lin)
2276	IF (ALLOCATED (frac_hydro_diag)) DEALLOCATE (frac_hydro_diag)
2277
2278
2279	END SUBROUTINE hydrol_clear
2280
2281	!! ================================================================================================================================
2282	!! SUBROUTINE : hydrol_tmc_update
2283	!!
2284	!>\BRIEF This routine updates the soil moisture profiles when the vegetation fraction have changed.
2285	!!
2286	!! DESCRIPTION :
2287	!!
2288	!! This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
2289	!!
2290	!!
2291	!!
2292	!!
2293	!! RECENT CHANGE(S) : Adaptation to excluding nobio from soiltile(1)
2294	!!
2295	!! MAIN OUTPUT VARIABLE(S) :
2296	!!
2297	!! REFERENCE(S) :
2298	!!
2299	!! FLOWCHART : None
2300	!! \n
2301	!_ ================================================================================================================================
2302	!_ hydrol_tmc_update
2303	SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
2304
2305	!! 0.1 Input variables
2306	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
2307	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! max fraction of vegetation type
2308	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile (0-1, unitless)
2309
2310	!! 0.2 Output variables
2311	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
2312	!! on mc [kg/m2/dt]
2313	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
2314	!! on water2infilt[kg/m2/dt]
2315
2316	!! 0.3 Modified variables
2317	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Amount of water in the canopy interception
2318
2319	!! 0.4 Local variables
2320	INTEGER(i_std) :: ji, jv, jst,jsl
2321	LOGICAL :: soil_upd !! True if soiltile changed since last time step
2322	LOGICAL :: vegtot_upd !! True if vegtot changed since last time step
2323	REAL(r_std), DIMENSION(kjpindex,nstm) :: vmr !! Change in soiltile (within vegtot)
2324	REAL(r_std), DIMENSION(kjpindex) :: vmr_sum
2325	REAL(r_std), DIMENSION(kjpindex) :: delvegtot
2326	REAL(r_std), DIMENSION(kjpindex,nslm) :: mc_dilu !! Total loss of moisture content
2327	REAL(r_std), DIMENSION(kjpindex) :: infil_dilu !! Total loss for water2infilt
2328	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_old !! tmc before calculations
2329	REAL(r_std), DIMENSION(kjpindex,nstm) :: water2infilt_old!! water2infilt before calculations
2330	REAL(r_std), DIMENSION (kjpindex,nvm) :: qsintveg_old !! qsintveg before calculations
2331	REAL(r_std), DIMENSION(kjpindex) :: test
2332	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mcaux !! serves to hold the chnage in mc when vegtot decreases
2333
2334
2335	!! 1. If a PFT has disapperead as result from a veget_max change,
2336	!! then add canopy water to surface water.
2337	! Other adaptations of qsintveg are delt by the normal functioning of hydrol_canop
2338
2339	DO ji=1,kjpindex
2340	IF (vegtot_old(ji) .GT.min_sechiba) THEN
2341	DO jv=1,nvm
2342	IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
2343	jst=pref_soil_veg(jv) ! soil tile index
2344	water2infilt(ji,jst) = water2infilt(ji,jst) + qsintveg(ji,jv)/(resdist(ji,jst)*vegtot_old(ji))
2345	qsintveg(ji,jv) = zero
2346	ENDIF
2347	ENDDO
2348	ENDIF
2349	ENDDO
2350
2351	!! 2. We now deal with the changes of soiltile and corresponding soil moistures
2352	!! Because sum(soiltile)=1 whatever vegtot, we need to distinguish two cases:
2353	!! - when vegtot changes (meaning that the nobio fraction changes too),
2354	!! - and when vegtot does not changes (a priori the most frequent case)
2355
2356	vegtot_upd = SUM(ABS((vegtot(:)-vegtot_old(:)))) .GT. zero ! True if at least one land point with a vegtot change
2357	runoff_upd(:) = zero
2358	drain_upd(:) = zero
2359	IF (vegtot_upd) THEN
2360	! We find here the processing specific to the chnages of nobio fraction and vegtot
2361
2362	delvegtot(:) = vegtot(:) - vegtot_old(:)
2363
2364	DO jst=1,nstm
2365	DO ji=1,kjpindex
2366
2367	IF (delvegtot(ji) .GT. min_sechiba) THEN
2368
2369	!! 2.1. If vegtot increases (nobio decreases), then the mc in each soiltile is decreased
2370	!! assuming the same proportions for each soiltile, and each soil layer
2371
2372	mc(ji,:,jst) = mc(ji,:,jst) * vegtot_old(ji)/vegtot(ji) ! vegtot cannot be zero as > vegtot_old
2373	water2infilt(ji,jst) = water2infilt(ji,jst) * vegtot_old(ji)/vegtot(ji)
2374
2375	ELSE
2376
2377	!! 2.2 If vegtot decreases (nobio increases), then the mc in each soiltile should increase,
2378	!! but should not exceed mcs
2379	!! For simplicity, we choose to send the corresponding water volume to drainage
2380	!! We do the same for water2infilt but send the excess to surface runoff
2381
2382	IF (vegtot(ji) .GT.min_sechiba) THEN
2383	mcaux(ji,:,jst) = mc(ji,:,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji) ! mcaux is the delta mc
2384	ELSE ! we just have nobio in the grid-cell
2385	mcaux(ji,:,jst) = mc(ji,:,jst)
2386	ENDIF
2387
2388	drain_upd(ji) = drain_upd(ji) + dz(2) * ( trois*mcaux(ji,1,jst) + mcaux(ji,2,jst) )/huit
2389	DO jsl = 2,nslm-1
2390	drain_upd(ji) = drain_upd(ji) + dz(jsl) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl-1,jst))/huit &
2391	+ dz(jsl+1) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl+1,jst))/huit
2392	ENDDO
2393	drain_upd(ji) = drain_upd(ji) + dz(nslm) * (trois*mcaux(ji,nslm,jst) + mcaux(ji,nslm-1,jst))/huit
2394
2395	IF (vegtot(ji) .GT.min_sechiba) THEN
2396	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji)
2397	ELSE ! we just have nobio in the grid-cell
2398	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst)
2399	ENDIF
2400
2401	ENDIF
2402
2403	ENDDO
2404	ENDDO
2405
2406	ENDIF
2407
2408	!! 3. At the end of step 2, we are back to a case where vegtot changes are treated, so we can use soiltile
2409	!! as a fraction of vegtot to process the mc transfers between soil tiles due to the changes of vegetation map
2410
2411	!! 3.1 Check if soiltiles changed since last time step
2412	soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
2413	IF (printlev>=3) WRITE (numout,*) 'soil_upd ', soil_upd
2414
2415	IF (soil_upd) THEN
2416
2417	!! 3.2 Define the change in soiltile
2418	! resdist is the previous values of soiltiles, previous timestep,
2419	! so before new map
2420	vmr(:,:) = soiltile(:,:) - resdist(:,:)
2421
2422	! Total area loss by the three soil tiles
2423	DO ji=1,kjpindex
2424	vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
2425	ENDDO
2426
2427	!! 3.3 Shrinking soil tiles
2428	!! 3.3.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
2429	mc_dilu(:,:)=zero
2430	DO jst=1,nstm
2431	DO jsl = 1, nslm
2432	DO ji=1,kjpindex
2433	IF ( vmr(ji,jst) < zero ) THEN
2434	mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * &
2435	vmr(ji,jst) / vmr_sum(ji)
2436	ENDIF
2437	ENDDO
2438	ENDDO
2439	ENDDO
2440
2441	!! 3.3.2 Total loss of water2inft from the shrinking soil tiles
2442	infil_dilu(:)=zero
2443	DO jst=1,nstm
2444	DO ji=1,kjpindex
2445	IF ( vmr(ji,jst) < zero ) THEN
2446	infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * &
2447	vmr(ji,jst) / vmr_sum(ji)
2448	ENDIF
2449	ENDDO
2450	ENDDO
2451
2452	!! 3.4 Each gaining soil tile gets moisture proportionally
2453	!! to both the total loss and its areal increase
2454
2455	! As the original mc from each soil tile are in [mcr,mcs] and
2456	! we do weighted avrage, the new mc are in [mcr,mcs]
2457	! The case where the soiltile is created (soiltile_old=0) works
2458	! as the other cases
2459
2460	! 3.4.1 Update mc(kjpindex,nslm,nstm) !m3/m3
2461	DO jst=1,nstm
2462	DO jsl = 1, nslm
2463	DO ji=1,kjpindex
2464	IF ( vmr(ji,jst) > zero ) THEN
2465	mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
2466	! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
2467	ENDIF
2468	ENDDO
2469	ENDDO
2470	ENDDO
2471
2472	! 3.4.2 Update water2inft
2473	DO jst=1,nstm
2474	DO ji=1,kjpindex
2475	IF ( vmr(ji,jst) > zero ) THEN !donc soiltile>0
2476	water2infilt(ji,jst) = ( water2infilt(ji,jst) * &
2477	resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / &
2478	soiltile(ji,jst)
2479	ENDIF !donc resdist>0
2480	ENDDO
2481	ENDDO
2482
2483	! 3.4.3 Case where soiltile < min_sechiba
2484	DO jst=1,nstm
2485	DO ji=1,kjpindex
2486	IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
2487	water2infilt(ji,jst) = zero
2488	mc(ji,:,jst) = zero
2489	ENDIF
2490	ENDDO
2491	ENDDO
2492
2493	ENDIF ! soil_upd
2494
2495	!! 4. Update tmc and humtot
2496
2497	DO jst=1,nstm
2498	DO ji=1,kjpindex
2499	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
2500	DO jsl = 2,nslm-1
2501	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
2502	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
2503	ENDDO
2504	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
2505	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
2506	! WARNING tmc is increased by includes water2infilt(ji,jst)
2507	ENDDO
2508	ENDDO
2509
2510	humtot(:) = zero
2511	DO jst=1,nstm
2512	DO ji=1,kjpindex
2513	humtot(ji) = humtot(ji) + vegtot(ji) * soiltile(ji,jst) * tmc(ji,jst) ! average over grid-cell
2514	ENDDO
2515	ENDDO
2516
2517	!! Now that the work is done, update resdist
2518	resdist(:,:) = soiltile(:,:)
2519
2520	IF (printlev>=3) WRITE (numout,*) ' hydrol_tmc_update done '
2521
2522	END SUBROUTINE hydrol_tmc_update
2523
2524	!! ================================================================================================================================
2525	!! SUBROUTINE : hydrol_var_init
2526	!!
2527	!>\BRIEF This routine initializes hydrologic parameters to define K and D, and diagnostic hydrologic variables.
2528	!!
2529	!! DESCRIPTION :
2530	!! - 1 compute the depths
2531	!! - 2 compute the profile for roots
2532	!! - 3 compute the profile for ksat, a and n Van Genuchten parameter
2533	!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
2534	!! - 5 water reservoirs initialisation
2535	!!
2536	!! RECENT CHANGE(S) : None
2537	!!
2538	!! MAIN OUTPUT VARIABLE(S) :
2539	!!
2540	!! REFERENCE(S) :
2541	!!
2542	!! FLOWCHART : None
2543	!! \n
2544	!_ ================================================================================================================================
2545	!_ hydrol_var_init
2546
2547	SUBROUTINE hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, &
2548	mx_eau_var, shumdiag_perma, &
2549	drysoil_frac, qsintveg, mc_layh, mcl_layh, tmc_layh)
2550
2551	! interface description
2552
2553	!! 0. Variable and parameter declaration
2554
2555	!! 0.1 Input variables
2556
2557	! input scalar
2558	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size (number of grid cells) (1)
2559	! input fields
2560	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! PFT fractions within grid-cells (1; 1)
2561	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Effective fraction of vegetation by PFT (1; 1)
2562	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
2563	!! in the grid cell (1-nscm, unitless)
2564	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
2565
2566	!! 0.2 Output variables
2567
2568	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mx_eau_var !! Maximum water content of the soil
2569	!! @tex $(kg m^{-2})$ @endtex
2570	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma!! Percent of porosity filled with water (mc/mcs)
2571	!! used for the thermal computations
2572	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: drysoil_frac !! function of litter humidity
2573	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mc_layh !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
2574	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mcl_layh !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
2575	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: tmc_layh !! Total soil moisture content for each layer in hydrol(liquid+ice) [mm]
2576
2577	!! 0.3 Modified variables
2578	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on vegetation due to interception
2579	!! @tex $(kg m^{-2})$ @endtex
2580
2581	!! 0.4 Local variables
2582
2583	INTEGER(i_std) :: ji, jv !! Grid-cell and PFT indices (1)
2584	INTEGER(i_std) :: jst, jsc, jsl !! Soiltile, Soil Texture, and Soil layer indices (1)
2585	INTEGER(i_std) :: i, jd !! Index (1)
2586	REAL(r_std) :: m !! m=1-1/n (unitless)
2587	REAL(r_std) :: frac !! Relative linearized VWC (unitless)
2588	REAL(r_std) :: avan_mod !! VG parameter a modified from exponantial profile
2589	!! @tex $(mm^{-1})$ @endtex
2590	REAL(r_std) :: nvan_mod !! VG parameter n modified from exponantial profile
2591	!! (unitless)
2592	REAL(r_std), DIMENSION(nslm,nscm) :: afact, nfact !! Multiplicative factor for decay of a and n with depth
2593	!! (unitless)
2594	! parameters for "soil densification" with depth
2595	REAL(r_std) :: dp_comp !! Depth at which the 'compacted' value of ksat
2596	!! is reached (m)
2597	REAL(r_std) :: f_ks !! Exponential factor for decay of ksat with depth
2598	!! @tex $(m^{-1})$ @endtex
2599	! Fixed parameters from fitted relationships
2600	REAL(r_std) :: n0 !! fitted value for relation log((n-n0)/(n_ref-n0)) =
2601	!! nk_rel * log(k/k_ref)
2602	!! (unitless)
2603	REAL(r_std) :: nk_rel !! fitted value for relation log((n-n0)/(n_ref-n0)) =
2604	!! nk_rel * log(k/k_ref)
2605	!! (unitless)
2606	REAL(r_std) :: a0 !! fitted value for relation log((a-a0)/(a_ref-a0)) =
2607	!! ak_rel * log(k/k_ref)
2608	!! @tex $(mm^{-1})$ @endtex
2609	REAL(r_std) :: ak_rel !! fitted value for relation log((a-a0)/(a_ref-a0)) =
2610	!! ak_rel * log(k/k_ref)
2611	!! (unitless)
2612	REAL(r_std) :: kfact_max !! Maximum factor for Ks decay with depth (unitless)
2613	REAL(r_std) :: k_tmp, tmc_litter_ratio
2614	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
2615	!! Switch to 2 tu turn fatal errors into warnings
2616	REAL(r_std), DIMENSION (kjpindex,nslm,nstm) :: tmc_layh_s !! total soil moisture content for each layer in hydrol and for each soiltile (mm)
2617	INTEGER(i_std) :: jiref !! To identify the mc_lins where k_lin and d_lin
2618	!! need special treatment
2619
2620	!_ ================================================================================================================================
2621
2622
2623	!
2624	!Config Key = CWRR_NKS_N0
2625	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
2626	!Config Def = 0.95
2627	!Config If =
2628	!Config Help =
2629	!Config Units = [-]
2630	n0 = 0.95
2631	CALL getin_p("CWRR_NKS_N0",n0)
2632
2633	!! Check parameter value (correct range)
2634	IF ( n0 < zero ) THEN
2635	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2636	& "Wrong parameter value for CWRR_NKS_N0.", &
2637	& "This parameter should be non-negative. ", &
2638	& "Please, check parameter value in run.def. ")
2639	END IF
2640
2641
2642	!Config Key = CWRR_NKS_POWER
2643	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
2644	!Config Def = 0.34
2645	!Config If =
2646	!Config Help =
2647	!Config Units = [-]
2648	nk_rel = 0.34
2649	CALL getin_p("CWRR_NKS_POWER",nk_rel)
2650
2651	!! Check parameter value (correct range)
2652	IF ( nk_rel < zero ) THEN
2653	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2654	& "Wrong parameter value for CWRR_NKS_POWER.", &
2655	& "This parameter should be non-negative. ", &
2656	& "Please, check parameter value in run.def. ")
2657	END IF
2658
2659
2660	!Config Key = CWRR_AKS_A0
2661	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
2662	!Config Def = 0.00012
2663	!Config If =
2664	!Config Help =
2665	!Config Units = [1/mm]
2666	a0 = 0.00012
2667	CALL getin_p("CWRR_AKS_A0",a0)
2668
2669	!! Check parameter value (correct range)
2670	IF ( a0 < zero ) THEN
2671	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2672	& "Wrong parameter value for CWRR_AKS_A0.", &
2673	& "This parameter should be non-negative. ", &
2674	& "Please, check parameter value in run.def. ")
2675	END IF
2676
2677
2678	!Config Key = CWRR_AKS_POWER
2679	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
2680	!Config Def = 0.53
2681	!Config If =
2682	!Config Help =
2683	!Config Units = [-]
2684	ak_rel = 0.53
2685	CALL getin_p("CWRR_AKS_POWER",ak_rel)
2686
2687	!! Check parameter value (correct range)
2688	IF ( nk_rel < zero ) THEN
2689	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2690	& "Wrong parameter value for CWRR_AKS_POWER.", &
2691	& "This parameter should be non-negative. ", &
2692	& "Please, check parameter value in run.def. ")
2693	END IF
2694
2695
2696	!Config Key = KFACT_DECAY_RATE
2697	!Config Desc = Factor for Ks decay with depth
2698	!Config Def = 2.0
2699	!Config If =
2700	!Config Help =
2701	!Config Units = [1/m]
2702	f_ks = 2.0
2703	CALL getin_p ("KFACT_DECAY_RATE", f_ks)
2704
2705	!! Check parameter value (correct range)
2706	IF ( f_ks < zero ) THEN
2707	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2708	& "Wrong parameter value for KFACT_DECAY_RATE.", &
2709	& "This parameter should be positive. ", &
2710	& "Please, check parameter value in run.def. ")
2711	END IF
2712
2713
2714	!Config Key = KFACT_STARTING_DEPTH
2715	!Config Desc = Depth for compacted value of Ks
2716	!Config Def = 0.3
2717	!Config If =
2718	!Config Help =
2719	!Config Units = [m]
2720	dp_comp = 0.3
2721	CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
2722
2723	!! Check parameter value (correct range)
2724	IF ( dp_comp <= zero ) THEN
2725	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2726	& "Wrong parameter value for KFACT_STARTING_DEPTH.", &
2727	& "This parameter should be positive. ", &
2728	& "Please, check parameter value in run.def. ")
2729	END IF
2730
2731
2732	!Config Key = KFACT_MAX
2733	!Config Desc = Maximum Factor for Ks increase due to vegetation
2734	!Config Def = 10.0
2735	!Config If =
2736	!Config Help =
2737	!Config Units = [-]
2738	kfact_max = 10.0
2739	CALL getin_p ("KFACT_MAX", kfact_max)
2740
2741	!! Check parameter value (correct range)
2742	IF ( kfact_max < 10. ) THEN
2743	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2744	& "Wrong parameter value for KFACT_MAX.", &
2745	& "This parameter should be greater than 10. ", &
2746	& "Please, check parameter value in run.def. ")
2747	END IF
2748
2749
2750	!-
2751	!! 1. Create local variables in mm for the vertical depths
2752	!! Vertical depth variables (znh, dnh, dlh) are stored in module vertical_soil_var in m.
2753	DO jsl=1,nslm
2754	zz(jsl) = znh(jsl)*mille
2755	dz(jsl) = dnh(jsl)*mille
2756	dh(jsl) = dlh(jsl)*mille
2757	ENDDO
2758
2759	!-
2760	!! 2. Compute the root density profile if not ok_dynroot
2761	!! For the case with ok_dynroot, the calculations are done at each time step in hydrol_soil
2762	IF (.NOT. ok_dynroot) THEN
2763	DO ji=1, kjpindex
2764	!-
2765	!! The three following equations concerning nroot computation are derived from the integrals
2766	!! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158).
2767	!! The occasional absence of minus sign before humcste parameter is correct.
2768	DO jv = 1,nvm
2769	DO jsl = 2, nslm-1
2770	nroot(ji,jv,jsl) = (EXP(-humcste(jv)zz(jsl)/mille)) &
2771	& (EXP(humcste(jv)*dz(jsl)/mille/deux) - &
2772	& EXP(-humcste(jv)*dz(jsl+1)/mille/deux))/ &
2773	& (EXP(-humcste(jv)*dz(2)/mille/deux) &
2774	& -EXP(-humcste(jv)*zz(nslm)/mille))
2775	ENDDO
2776	nroot(ji,jv,1) = zero
2777	nroot(ji,jv,nslm) = (EXP(humcste(jv)dz(nslm)/mille/deux) -un) &
2778	& EXP(-humcste(jv)*zz(nslm)/mille) / &
2779	& (EXP(-humcste(jv)*dz(2)/mille/deux) &
2780	& -EXP(-humcste(jv)*zz(nslm)/mille))
2781	ENDDO
2782	ENDDO
2783	ENDIF
2784
2785	!-
2786	!! 3 Compute the profile for ksat, a and n
2787	!-
2788
2789	! For every soil texture
2790	DO jsc = 1, nscm
2791	DO jsl=1,nslm
2792	! PhD thesis of d'Orgeval, 2006, p81, Eq. 4.38; d'Orgeval et al. 2008, Eq. 2
2793	! Calibrated against Hapex-Sahel measurements
2794	kfact(jsl,jsc) = MIN(MAX(EXP(- f_ks * (zz(jsl)/mille - dp_comp)), un/kfact_max),un)
2795	! PhD thesis of d'Orgeval, 2006, p81, Eqs. 4.39; 4.42, and Fig 4.14
2796
2797	nfact(jsl,jsc) = ( kfact(jsl,jsc) )**nk_rel
2798	afact(jsl,jsc) = ( kfact(jsl,jsc) )**ak_rel
2799	ENDDO
2800	ENDDO
2801
2802	! For every soil texture
2803	DO jsc = 1, nscm
2804	!-
2805	!! 4 compute the linearized values of k, a, b and d
2806	!-
2807	! Calculate the matrix coef for Dublin model (de Rosnay, 1999; p149)
2808	! piece-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
2809	! and diffusivity d_lin in each interval of mc, called mc_lin,
2810	! between imin, for residual mcr, and imax for saturation mcs.
2811
2812	! We define 51 bounds for 50 bins of mc between mcr and mcs
2813	mc_lin(imin,jsc)=mcr(jsc)
2814	mc_lin(imax,jsc)=mcs(jsc)
2815	DO ji= imin+1, imax-1 ! ji=2,50
2816	mc_lin(ji,jsc) = mcr(jsc) + (ji-imin)*(mcs(jsc)-mcr(jsc))/(imax-imin)
2817	ENDDO
2818
2819	DO jsl = 1, nslm
2820	! From PhD thesis of d'Orgeval, 2006, p81, Eq. 4.42
2821	nvan_mod = n0 + (nvan(jsc)-n0) * nfact(jsl,jsc)
2822	avan_mod = a0 + (avan(jsc)-a0) * afact(jsl,jsc)
2823	m = un - un / nvan_mod
2824	! We apply Van Genuchten equation for K(theta) based on Ks(z)=ks(jsc) * kfact(jsl,jsc)
2825	DO ji = imax,imin,-1
2826	frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
2827	k_lin(ji,jsl,jsc) = ks(jsc) * kfact(jsl,jsc) * (frac*0.5) ( un - ( un - frac (un/m)) m )**2
2828	ENDDO
2829
2830	! k_lin should not be zero, nor too small
2831	! We track jiref, the bin under which mc is too small and we may get zero k_lin
2832	ji=imax-1
2833	DO WHILE ((k_lin(ji,jsl,jsc) > 1.e-32) .and. (ji>0))
2834	jiref=ji
2835	ji=ji-1
2836	ENDDO
2837	DO ji=jiref-1,imin,-1
2838	k_lin(ji,jsl,jsc)=k_lin(ji+1,jsl,jsc)/10.
2839	ENDDO
2840
2841	DO ji = imin,imax-1 ! ji=1,50
2842	! We deduce a_lin and b_lin based on continuity between segments k_lin = a_lin*mc-lin+b_lin
2843	a_lin(ji,jsl,jsc) = (k_lin(ji+1,jsl,jsc)-k_lin(ji,jsl,jsc)) / (mc_lin(ji+1,jsc)-mc_lin(ji,jsc))
2844	b_lin(ji,jsl,jsc) = k_lin(ji,jsl,jsc) - a_lin(ji,jsl,jsc)*mc_lin(ji,jsc)
2845
2846	! We calculate the d_lin for each mc bin, from Van Genuchten equation for D(theta)
2847	! d_lin is constant and taken as the arithmetic mean between the values at the bounds of each bin
2848	IF (ji.NE.imin .AND. ji.NE.imax-1) THEN
2849	frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
2850	d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_modmnvan_mod)) * &
2851	( (frac*(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) &
2852	( frac(-un/m) -un ) (-m)
2853	frac=MIN(un,(mc_lin(ji+1,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
2854	d_lin(ji+1,jsl,jsc) =(k_lin(ji+1,jsl,jsc) / (avan_modmnvan_mod))*&
2855	( (frac*(-un/m))/(mc_lin(ji+1,jsc)-mcr(jsc)) ) &
2856	( frac(-un/m) -un ) (-m)
2857	d_lin(ji,jsl,jsc) = undemi * (d_lin(ji,jsl,jsc)+d_lin(ji+1,jsl,jsc))
2858	ELSE IF(ji.EQ.imax-1) THEN
2859	d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_modmnvan_mod)) * &
2860	( (frac*(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) &
2861	( frac(-un/m) -un ) (-m)
2862	ENDIF
2863	ENDDO
2864
2865	! Special case for ji=imin
2866	d_lin(imin,jsl,jsc) = d_lin(imin+1,jsl,jsc)/1000.
2867
2868	! We adjust d_lin where k_lin was previously adjusted otherwise we might get non-monotonous variations
2869	! We don't want d_lin = zero
2870	DO ji=jiref-1,imin,-1
2871	d_lin(ji,jsl,jsc)=d_lin(ji+1,jsl,jsc)/10.
2872	ENDDO
2873
2874	ENDDO
2875	ENDDO
2876
2877
2878	!! 5 Water reservoir initialisation
2879	!
2880	!!$ DO jst = 1,nstm
2881	!!$ DO ji = 1, kjpindex
2882	!!$ mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
2883	!!$ & zmaxhmillemcs(njsc(ji))
2884	!!$ END DO
2885	!!$ END DO
2886
2887	mx_eau_var(:) = zero
2888	mx_eau_var(:) = zmaxhmillemcs(njsc(:))
2889
2890	DO ji = 1,kjpindex
2891	IF (vegtot(ji) .LE. zero) THEN
2892	mx_eau_var(ji) = mx_eau_nobio*zmaxh
2893	! Aurelien: what does vegtot=0 mean? is it like frac_nobio=1? But if 0<frac_nobio<1 ???
2894	ENDIF
2895
2896	END DO
2897
2898	! Compute the litter humidity, shumdiag and fry
2899	shumdiag_perma(:,:) = zero
2900	humtot(:) = zero
2901	tmc(:,:) = zero
2902
2903	! Loop on soiltiles to compute the variables (ji,jst)
2904	DO jst=1,nstm
2905	DO ji = 1, kjpindex
2906	tmcs(ji,jst)=zmaxh* mille*mcs(njsc(ji))
2907	tmcr(ji,jst)=zmaxh* mille*mcr(njsc(ji))
2908	ENDDO
2909	ENDDO
2910
2911	! The total soil moisture for each soiltile:
2912	DO jst=1,nstm
2913	DO ji=1,kjpindex
2914	tmc(ji,jst)= dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
2915	END DO
2916	ENDDO
2917
2918	DO jst=1,nstm
2919	DO jsl=2,nslm-1
2920	DO ji=1,kjpindex
2921	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
2922	& + dz(jsl+1)(troismc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
2923	END DO
2924	END DO
2925	ENDDO
2926
2927	DO jst=1,nstm
2928	DO ji=1,kjpindex
2929	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
2930	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
2931	ENDDO
2932	END DO
2933
2934	!JG: hydrol_tmc_update should not be called in the initialization phase. Call of hydrol_tmc_update makes the model restart differenlty.
2935	! ! If veget has been updated before restart (with LAND USE or DGVM),
2936	! ! tmc and mc must be modified with respect to humtot conservation.
2937	! CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg)
2938
2939	! The litter variables:
2940	! level 1
2941	DO jst=1,nstm
2942	DO ji=1,kjpindex
2943	tmc_litter(ji,jst) = dz(2) * (trois*mc(ji,1,jst)+mc(ji,2,jst))/huit
2944	tmc_litter_wilt(ji,jst) = dz(2) * mcw(njsc(ji)) / deux
2945	tmc_litter_res(ji,jst) = dz(2) * mcr(njsc(ji)) / deux
2946	tmc_litter_field(ji,jst) = dz(2) * mcf(njsc(ji)) / deux
2947	tmc_litter_sat(ji,jst) = dz(2) * mcs(njsc(ji)) / deux
2948	tmc_litter_awet(ji,jst) = dz(2) * mc_awet(njsc(ji)) / deux
2949	tmc_litter_adry(ji,jst) = dz(2) * mc_adry(njsc(ji)) / deux
2950	ENDDO
2951	END DO
2952	! sum from level 2 to 4
2953	DO jst=1,nstm
2954	DO jsl=2,4
2955	DO ji=1,kjpindex
2956	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
2957	& ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
2958	& + dz(jsl+1)(troismc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
2959	tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
2960	&(dz(jsl)+ dz(jsl+1))*&
2961	& mcw(njsc(ji))/deux
2962	tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
2963	&(dz(jsl)+ dz(jsl+1))*&
2964	& mcr(njsc(ji))/deux
2965	tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
2966	&(dz(jsl)+ dz(jsl+1))* &
2967	& mcs(njsc(ji))/deux
2968	tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
2969	& (dz(jsl)+ dz(jsl+1))* &
2970	& mcf(njsc(ji))/deux
2971	tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
2972	&(dz(jsl)+ dz(jsl+1))* &
2973	& mc_awet(njsc(ji))/deux
2974	tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
2975	& (dz(jsl)+ dz(jsl+1))* &
2976	& mc_adry(njsc(ji))/deux
2977	END DO
2978	END DO
2979	END DO
2980
2981	! Soil wetness profiles (W-Ww)/(Ws-Ww)
2982	DO jst=1,nstm
2983	DO ji=1,kjpindex
2984	soil_wet(ji,1,jst) = MIN(un, MAX(zero,&
2985	&(troismc(ji,1,jst) + mc(ji,2,jst) - quatremcw(njsc(ji)))&
2986	& /(quatre*(mcs(njsc(ji))-mcw(njsc(ji)))) ))
2987	! here we set that humrelv=0 in PFT1
2988	humrelv(ji,1,jst) = zero
2989	ENDDO
2990	END DO
2991
2992	DO jst=1,nstm
2993	DO jsl=2,nslm-1
2994	DO ji=1,kjpindex
2995	soil_wet(ji,jsl,jst) = MIN(un, MAX(zero,&
2996	& (trois*mc(ji,jsl,jst) + &
2997	& mc(ji,jsl-1,jst) *(dz(jsl)/(dz(jsl)+dz(jsl+1))) &
2998	& + mc(ji,jsl+1,jst)*(dz(jsl+1)/(dz(jsl)+dz(jsl+1))) &
2999	& - quatremcw(njsc(ji))) / (quatre(mcs(njsc(ji))-mcw(njsc(ji)))) ))
3000	END DO
3001	END DO
3002	END DO
3003
3004	DO jst=1,nstm
3005	DO ji=1,kjpindex
3006	soil_wet(ji,nslm,jst) = MIN(un, MAX(zero,&
3007	& (trois*mc(ji,nslm,jst) &
3008	& + mc(ji,nslm-1,jst)-quatremcw(njsc(ji)))/(quatre(mcs(njsc(ji))-mcw(njsc(ji)))) ))
3009	ENDDO
3010	END DO
3011
3012	! Calculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
3013	CALL hydrol_calculate_frac_hydro_diag
3014
3015	! Calculate shumdiag_perma (at diagnostic levels)
3016	! Use resdist instead of soiltile because we here need to have
3017	! shumdiag_perma at the value from previous time step.
3018	! Here, soilmoist is only used as a temporary variable to calculate shumdiag_perma
3019	! (based on resdist=soiltile from previous timestep, but normally equal to soiltile)
3020	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3021	soilmoist(:,:) = zero
3022	DO jst=1,nstm
3023	DO ji=1,kjpindex
3024	soilmoist(ji,1) = soilmoist(ji,1) + resdist(ji,jst) * &
3025	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
3026	DO jsl = 2,nslm-1
3027	soilmoist(ji,jsl) = soilmoist(ji,jsl) + resdist(ji,jst) * &
3028	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
3029	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
3030	END DO
3031	soilmoist(ji,nslm) = soilmoist(ji,nslm) + resdist(ji,jst) * &
3032	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3033	ENDDO
3034	ENDDO
3035	DO ji=1,kjpindex
3036	soilmoist(ji,:) = soilmoist(ji,:) * vegtot_old(ji) ! grid cell average
3037	ENDDO
3038
3039	! -- shumdiag_perma for restart
3040	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3041	DO jd=1,nbdl
3042	DO ji=1,kjpindex
3043	DO jsl = 1, nslm
3044	shumdiag_perma(ji,jd) = soilmoist(ji,jsl)*frac_hydro_diag(jsl,jd) &
3045	/(dh(jsl)*mcs(njsc(ji)))
3046	ENDDO
3047	shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero)
3048	ENDDO
3049	ENDDO
3050
3051	! Calculate drysoil_frac if it was not found in the restart file
3052	! For simplicity, we set drysoil_frac to 0.5 in this case
3053	IF (ALL(drysoil_frac(:) == val_exp)) THEN
3054	DO ji=1,kjpindex
3055	drysoil_frac(ji) = 0.5
3056	END DO
3057	END IF
3058
3059	!! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
3060	!! thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh)
3061	!! needed in thermosoil for the heat capacity.
3062	! These values are only used in thermosoil_init in absence of a restart file
3063	! For this case, we calculate them based on mc and mcl from the restart files,
3064	! and vegtot and soiltile which correspond to the new vegetation map
3065	! This creates a little inconsistency (since mc corresponds to the previous vegetation map)
3066	! but it's not important since it's just when we start from scratch
3067	!! The multiplication by vegtot creates grid-cell average values *** to be checked for consistency with thermosoil
3068	mc_layh(:,:) = zero
3069	mcl_layh(:,:) = zero
3070	tmc_layh(:,:) = zero
3071	DO jst=1,nstm
3072	DO ji=1,kjpindex
3073	DO jsl=1,nslm
3074	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
3075	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
3076	ENDDO
3077	tmc_layh_s(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
3078	DO jsl = 2,nslm-1
3079	tmc_layh_s(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
3080	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
3081	ENDDO
3082	tmc_layh_s(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3083	DO jsl = 1,nslm
3084	tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_s(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
3085	ENDDO
3086	END DO
3087	END DO
3088
3089	IF (printlev>=3) WRITE (numout,*) ' hydrol_var_init done '
3090
3091	END SUBROUTINE hydrol_var_init
3092
3093
3094
3095	!! ================================================================================================================================
3096	!! SUBROUTINE : hydrol_canop
3097	!!
3098	!>\BRIEF This routine computes canopy processes.
3099	!!
3100	!! DESCRIPTION :
3101	!! - 1 evaporation off the continents
3102	!! - 1.1 The interception loss is take off the canopy.
3103	!! - 1.2 precip_rain is shared for each vegetation type
3104	!! - 1.3 Limits the effect and sum what receives soil
3105	!! - 1.4 swap qsintveg to the new value
3106	!!
3107	!! RECENT CHANGE(S) : None
3108	!!
3109	!! MAIN OUTPUT VARIABLE(S) :
3110	!!
3111	!! REFERENCE(S) :
3112	!!
3113	!! FLOWCHART : None
3114	!! \n
3115	!_ ================================================================================================================================
3116	!_ hydrol_canop
3117
3118	SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
3119	& qsintveg,precisol,tot_melt)
3120
3121	!
3122	! interface description
3123	!
3124
3125	!! 0. Variable and parameter declaration
3126
3127	!! 0.1 Input variables
3128
3129	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
3130	! input fields
3131	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
3132	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: vevapwet !! Interception loss
3133	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max !! max fraction of vegetation type
3134	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget !! Fraction of vegetation type
3135	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: qsintmax !! Maximum water on vegetation for interception
3136	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: tot_melt !! Total melt
3137
3138	!! 0.2 Output variables
3139
3140	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: precisol !! Water fallen onto the ground (throughfall)
3141
3142	!! 0.3 Modified variables
3143
3144	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg !! Water on vegetation due to interception
3145
3146	!! 0.4 Local variables
3147
3148	INTEGER(i_std) :: ji, jv
3149	REAL(r_std), DIMENSION (kjpindex,nvm) :: zqsintvegnew
3150
3151	!_ ================================================================================================================================
3152
3153	! boucle sur les points continentaux
3154	! calcul de qsintveg au pas de temps suivant
3155	! par ajout du flux interception loss
3156	! calcule par enerbil en fonction
3157	! des calculs faits dans diffuco
3158	! calcul de ce qui tombe sur le sol
3159	! avec accumulation dans precisol
3160	! essayer d'harmoniser le traitement du sol nu
3161	! avec celui des differents types de vegetation
3162	! fait si on impose qsintmax ( ,1) = 0.0
3163	!
3164	! loop for continental subdomain
3165	!
3166	!
3167	!! 1 evaporation off the continents
3168	!
3169	!! 1.1 The interception loss is take off the canopy.
3170	DO jv=2,nvm
3171	qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
3172	END DO
3173
3174	! It is raining :
3175	!! 1.2 precip_rain is shared for each vegetation type
3176	!
3177	qsintveg(:,1) = zero
3178	DO jv=2,nvm
3179	qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
3180	END DO
3181
3182	!
3183	!! 1.3 Limits the effect and sum what receives soil
3184	!
3185	precisol(:,1)=veget_max(:,1)*precip_rain(:)
3186	DO jv=2,nvm
3187	DO ji = 1, kjpindex
3188	zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv))
3189	precisol(ji,jv) = (veget(ji,jv)throughfall_by_pft(jv)precip_rain(ji)) + &
3190	qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
3191	(veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
3192	ENDDO
3193	END DO
3194	!
3195	DO jv=1,nvm
3196	DO ji = 1, kjpindex
3197	IF (vegtot(ji).GT.min_sechiba) THEN
3198	precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
3199	ENDIF
3200	ENDDO
3201	END DO
3202	!
3203	!
3204	!! 1.4 swap qsintveg to the new value
3205	!
3206	DO jv=2,nvm
3207	qsintveg(:,jv) = zqsintvegnew (:,jv)
3208	END DO
3209
3210	IF (printlev>=3) WRITE (numout,*) ' hydrol_canop done '
3211
3212	END SUBROUTINE hydrol_canop
3213
3214
3215	!! ================================================================================================================================
3216	!! SUBROUTINE : hydrol_vegupd
3217	!!
3218	!>\BRIEF Vegetation update
3219	!!
3220	!! DESCRIPTION :
3221	!! The vegetation cover has changed and we need to adapt the reservoir distribution
3222	!! and the distribution of plants on different soil types.
3223	!! You may note that this occurs after evaporation and so on have been computed. It is
3224	!! not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
3225	!! evaporation. If this is not the case it should have been caught above.
3226	!!
3227	!! - 1 Update of vegetation is it needed?
3228	!! - 2 calculate water mass that we have to redistribute
3229	!! - 3 put it into reservoir of plant whose surface area has grown
3230	!! - 4 Soil tile gestion
3231	!! - 5 update the corresponding masks
3232	!!
3233	!! RECENT CHANGE(S) : None
3234	!!
3235	!! MAIN OUTPUT VARIABLE(S) :
3236	!!
3237	!! REFERENCE(S) :
3238	!!
3239	!! FLOWCHART : None
3240	!! \n
3241	!_ ================================================================================================================================
3242	!_ hydrol_vegupd
3243
3244	SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
3245
3246
3247	!! 0. Variable and parameter declaration
3248
3249	!! 0.1 Input variables
3250
3251	! input scalar
3252	INTEGER(i_std), INTENT(in) :: kjpindex
3253	! input fields
3254	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget !! New vegetation map
3255	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type
3256	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3257
3258	!! 0.2 Output variables
3259	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: frac_bare !! Fraction(of veget_max) of bare soil
3260	!! in each vegetation type
3261	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
3262	!! on mc [kg/m2/dt]
3263	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
3264	!! on water2infilt[kg/m2/dt]
3265
3266
3267	!! 0.3 Modified variables
3268
3269	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on old vegetation
3270
3271	!! 0.4 Local variables
3272
3273	INTEGER(i_std) :: ji,jv,jst
3274
3275	!_ ================================================================================================================================
3276
3277	!! 1 If veget has been updated at last time step (with LAND USE or DGVM),
3278	!! tmc and mc must be modified with respect to humtot conservation.
3279	CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
3280
3281	! Compute the masks for veget
3282
3283	mask_veget(:,:) = 0
3284	mask_soiltile(:,:) = 0
3285
3286	DO jst=1,nstm
3287	DO ji = 1, kjpindex
3288	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
3289	mask_soiltile(ji,jst) = 1
3290	ENDIF
3291	END DO
3292	ENDDO
3293
3294	DO jv = 1, nvm
3295	DO ji = 1, kjpindex
3296	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
3297	mask_veget(ji,jv) = 1
3298	ENDIF
3299	END DO
3300	END DO
3301
3302	! Compute vegetmax_soil
3303	vegetmax_soil(:,:,:) = zero
3304	DO jv = 1, nvm
3305	jst = pref_soil_veg(jv)
3306	DO ji=1,kjpindex
3307	! for veget distribution used in sechiba via humrel
3308	IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
3309	vegetmax_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
3310	ENDIF
3311	ENDDO
3312	ENDDO
3313
3314	! Calculate frac_bare (previosly done in slowproc_veget)
3315	DO ji =1, kjpindex
3316	IF( veget_max(ji,1) .GT. min_sechiba ) THEN
3317	frac_bare(ji,1) = un
3318	ELSE
3319	frac_bare(ji,1) = zero
3320	ENDIF
3321	ENDDO
3322	DO jv = 2, nvm
3323	DO ji =1, kjpindex
3324	IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
3325	frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
3326	ELSE
3327	frac_bare(ji,jv) = zero
3328	ENDIF
3329	ENDDO
3330	ENDDO
3331
3332	! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes
3333	! suivantes et le calcul de frac_bare:
3334	frac_bare_ns(:,:) = zero
3335	DO jst = 1, nstm
3336	DO jv = 1, nvm
3337	DO ji =1, kjpindex
3338	IF(vegtot(ji) .GT. min_sechiba) THEN
3339	frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + vegetmax_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
3340	ENDIF
3341	END DO
3342	ENDDO
3343	END DO
3344
3345	IF (printlev>=3) WRITE (numout,*) ' hydrol_vegupd done '
3346
3347	END SUBROUTINE hydrol_vegupd
3348
3349
3350	!! ================================================================================================================================
3351	!! SUBROUTINE : hydrol_flood
3352	!!
3353	!>\BRIEF This routine computes the evolution of the surface reservoir (floodplain).
3354	!!
3355	!! DESCRIPTION :
3356	!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
3357	!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
3358	!! - 3 Discriminate between precip over land and over floodplain
3359	!!
3360	!! RECENT CHANGE(S) : None
3361	!!
3362	!! MAIN OUTPUT VARIABLE(S) :
3363	!!
3364	!! REFERENCE(S) :
3365	!!
3366	!! FLOWCHART : None
3367	!! \n
3368	!_ ================================================================================================================================
3369	!_ hydrol_flood
3370
3371	SUBROUTINE hydrol_flood (kjpindex, vevapflo, flood_frac, flood_res, floodout)
3372
3373	!! 0. Variable and parameter declaration
3374
3375	!! 0.1 Input variables
3376
3377	! input scalar
3378	INTEGER(i_std), INTENT(in) :: kjpindex !!
3379	! input fields
3380	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flood_frac !! Fraction of floodplains in grid box
3381
3382	!! 0.2 Output variables
3383
3384	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: floodout !! Flux to take out from floodplains
3385
3386	!! 0.3 Modified variables
3387
3388	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: flood_res !! Floodplains reservoir estimate
3389	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapflo !! Evaporation over floodplains
3390
3391	!! 0.4 Local variables
3392
3393	INTEGER(i_std) :: ji, jv !! Indices
3394	REAL(r_std), DIMENSION (kjpindex) :: temp !!
3395
3396	!_ ================================================================================================================================
3397	!-
3398	!! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
3399	!-
3400	DO ji = 1,kjpindex
3401	temp(ji) = MIN(flood_res(ji), vevapflo(ji))
3402	ENDDO
3403	DO ji = 1,kjpindex
3404	flood_res(ji) = flood_res(ji) - temp(ji)
3405	subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
3406	vevapflo(ji) = temp(ji)
3407	ENDDO
3408
3409	!-
3410	!! 2 Compute the total flux from floodplain floodout (transfered to routing)
3411	!-
3412	DO ji = 1,kjpindex
3413	floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
3414	ENDDO
3415
3416	!-
3417	!! 3 Discriminate between precip over land and over floodplain
3418	!-
3419	DO jv=1, nvm
3420	DO ji = 1,kjpindex
3421	precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
3422	ENDDO
3423	ENDDO
3424
3425	IF (printlev>=3) WRITE (numout,*) ' hydrol_flood done'
3426
3427	END SUBROUTINE hydrol_flood
3428
3429
3430	!! ================================================================================================================================
3431	!! SUBROUTINE : hydrol_soil
3432	!!
3433	!>\BRIEF This routine computes soil processes with CWRR scheme (Richards equation solved by finite differences).
3434	!! Note that the water fluxes are in kg/m2/dt_sechiba.
3435	!!
3436	!! DESCRIPTION :
3437	!! 0. Initialisation, and split 2d variables to 3d variables, per soil tile
3438	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
3439	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
3440	!! 1.1 Reduces water2infilt and water2extract to their difference
3441	!! 1.2 To remove water2extract (including bare soilevaporation) from top layer
3442	!! 1.3 Infiltration
3443	!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
3444	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
3445	!! This will act on mcl (liquid water content) only
3446	!! 2.1 K and D are recomputed after infiltration
3447	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
3448	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
3449	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
3450	!! 2.5 Defining where diffusion is solved : everywhere
3451	!! 2.6 We define the system of linear equations for mcl redistribution
3452	!! 2.7 Solves diffusion equations
3453	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
3454	!! 2.9 For water conservation check during redistribution, we calculate the total liquid SM
3455	!! at the end of the routine tridiag, and we compare the difference with the flux...
3456	!! 3. AFTER DIFFUSION/REDISTRIBUTION
3457	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
3458	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
3459	!! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
3460	!! 3.3 Negative runoff is reported to drainage
3461	!! 3.4 Optional block to force saturation below zwt_force
3462	!! 3.5 Diagnosing the effective water table depth
3463	!! 3.6 Diagnose under_mcr to adapt water stress calculation below
3464	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
3465	!! 4.1 Total soil moisture content (water2infilt added below)
3466	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
3467	!! 5. Optional check of the water balance of soil column (if check_cwrr)
3468	!! 5.1 Computation of the vertical water fluxes
3469	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
3470	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
3471	!! 6.2 We need to turn off evaporation when is_under_mcr
3472	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in thermosoil
3473	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
3474	!! -- ENDING THE MAIN LOOP ON SOILTILES
3475	!! 7. Summing 3d variables into 2d variables
3476	!! 8. XIOS export of local variables, including water conservation checks
3477	!! 9. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
3478	!! The principle is to run a dummy integration of the water redistribution scheme
3479	!! to check if the SM profile can sustain a potential evaporation.
3480	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
3481	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
3482	!! 10. evap_bar_lim is the grid-cell scale beta
3483	!!
3484	!! RECENT CHANGE(S) : 2016 by A. Ducharne
3485	!! 2017 by A. S. LansÃž, implementing the soil to root
3486	!! resistance developed for ORCHIDEE by Emilie Joetzjer. Ref: Williams et al.,
3487	!! 2001(TreePhys) and Duursma et al., 2012 (GMD)
3488	!!
3489	!! MAIN OUTPUT VARIABLE(S) :
3490	!!
3491	!! REFERENCE(S) :
3492	!!
3493	!! FLOWCHART : None
3494	!! \n
3495	!_ ================================================================================================================================
3496	!_ hydrol_soil
3497
3498	SUBROUTINE hydrol_soil (kjpindex, veget_max, soiltile, njsc, reinf_slope, &
3499	& transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
3500	& returnflow, reinfiltration, irrigation, &
3501	& tot_melt, evap_bare_lim, shumdiag, shumdiag_perma,&
3502	& k_litt, litterhumdiag, humrel,vegstress, drysoil_frac, &
3503	& stempdiag,snow, &
3504	& snowdz, tot_bare_soil, u, v, tq_cdrag, mc_layh, mcl_layh, tmc_layh, &
3505	& swc, ksave, e_frac)
3506	!
3507	! interface description
3508
3509	!! 0. Variable and parameter declaration
3510
3511	!! 0.1 Input variables
3512
3513	INTEGER(i_std), INTENT(in) :: kjpindex
3514	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Map of max vegetation types [-]
3515	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
3516	!! in the grid cell (1-nscm, unitless)
3517	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3518	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: transpir !! Transpiration
3519	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3520	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Fraction of surface runoff that reinfiltrates
3521	!! (unitless, [0-1])
3522	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the soil from the bottom
3523	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3524	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
3525	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3526	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Irrigation
3527	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3528	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !! Potential evaporation
3529	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3530	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot_penm !! Potential evaporation "Penman" (Milly's correction)
3531	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3532	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !! Total melt from snow and ice
3533	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3534	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
3535	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: snow !! Snow mass
3536	!! @tex $(kg m^{-2})$ @endtex
3537	REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in) :: snowdz !! Snow depth (m)
3538	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
3539	!! (unitless, [0-1])
3540	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
3541	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient (-)
3542	REAL(r_std), DIMENSION(kjpindex,nvm,nbdl,nstm),INTENT(in):: e_frac !! Fraction of water transpired supplied by individual layers (no units)
3543
3544	!! 0.2 Output variables
3545
3546	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! Surface runoff
3547	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3548	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
3549	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3550	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
3551	!! on each soil column (unitless, [0-1])
3552	REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag !! Relative soil moisture in each diag soil layer
3553	!! with respect to (mcf-mcw) (unitless, [0-1])
3554	REAL(r_std), DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs)
3555	!! in each diag soil layer (for the thermal computations)
3556	!! (unitless, [0-1])
3557	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: k_litt !! Litter approximated hydraulic conductivity
3558	!! @tex $(mm d^{-1})$ @endtex
3559	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! Mean of soil_wet_litter across soil tiles
3560	!! (unitless, [0-1])
3561	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation
3562	!! growth) (unitless, [0-1])
3563	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of the litter humidity
3564	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric water content (liquid + ice) for each soil layer
3565	!! averaged over the mesh (for thermosoil)
3566	!! @tex $(m^{3} m^{-3})$ @endtex
3567	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric liquid water content for each soil layer
3568	!! averaged over the mesh (for thermosoil)
3569	!! @tex $(m^{3} m^{-3})$ @endtex
3570	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: tmc_layh !! Soil moisture (liquid + ice) for soil each layer
3571	!! averaged over the mesh (for thermosoil)
3572	!! @tex $(m^{3} m^{-3})$ @endtex
3573
3574	!! 0.3 Modified variables
3575
3576	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !! Bare soil evaporation
3577	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3578	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel !! Relative humidity (0-1, dimensionless)
3579	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: swc !! Soilwater content (a copy of mc)
3580	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksave !! Soil conductivity (a copy of k for each soil type)
3581
3582	!! 0.4 Local variables
3583
3584	INTEGER(i_std) :: ji, jv, jsl, jst, ivm !! Indices
3585	REAL(r_std), PARAMETER :: frac_mcs = 0.66 !! Temporary depth
3586	REAL(r_std), DIMENSION(kjpindex) :: temp !! Temporary value for fluxes
3587	REAL(r_std), DIMENSION(kjpindex) :: tmcold !! Total SM at beginning of hydrol_soil (kg/m2)
3588	REAL(r_std), DIMENSION(kjpindex) :: tmcint !! Ancillary total SM (kg/m2)
3589	REAL(r_std), DIMENSION(kjpindex,nslm) :: mcint !! To save mc values for future use
3590	REAL(r_std), DIMENSION(kjpindex,nslm) :: mclint !! To save mcl values for future use
3591	LOGICAL, DIMENSION(kjpindex,nstm) :: is_under_mcr !! Identifies under residual soil moisture points
3592	LOGICAL, DIMENSION(kjpindex) :: is_over_mcs !! Identifies over saturated soil moisture points
3593	REAL(r_std), DIMENSION(kjpindex) :: deltahum,diff !!
3594	LOGICAL(r_std), DIMENSION(kjpindex) :: test !!
3595	REAL(r_std), DIMENSION(kjpindex) :: water2extract !! Water flux to be extracted at the soil surface
3596	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3597	REAL(r_std), DIMENSION(kjpindex) :: returnflow_soil !! Water from the routing back to the bottom of
3598	!! the soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3599	REAL(r_std), DIMENSION(kjpindex) :: reinfiltration_soil !! Water from the routing back to the top of the
3600	!! soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3601	REAL(r_std), DIMENSION(kjpindex) :: irrigation_soil !! Water from irrigation returning to soil moisture
3602	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3603	REAL(r_std), DIMENSION(kjpindex) :: flux_infilt !! Water to infiltrate
3604	!! @tex $(kg m^{-2})$ @endtex
3605	REAL(r_std), DIMENSION(kjpindex) :: flux_bottom !! Flux at bottom of the soil column
3606	!! @tex $(kg m^{-2})$ @endtex
3607	REAL(r_std), DIMENSION(kjpindex) :: flux_top !! Flux at top of the soil column (for bare soil evap)
3608	!! @tex $(kg m^{-2})$ @endtex
3609	REAL(r_std), DIMENSION (kjpindex,nstm) :: qinfilt_ns !! Effective infiltration flux per soil tile
3610	!! @tex $(kg m^{-2})$ @endtex
3611	REAL(r_std), DIMENSION (kjpindex) :: qinfilt !! Effective infiltration flux
3612	!! @tex $(kg m^{-2})$ @endtex
3613	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_infilt_ns !! Surface runoff from hydrol_soil_infilt per soil tile
3614	!! @tex $(kg m^{-2})$ @endtex
3615	REAL(r_std), DIMENSION (kjpindex) :: ru_infilt !! Surface runoff from hydrol_soil_infilt
3616	!! @tex $(kg m^{-2})$ @endtex
3617	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr_ns !! Surface runoff produced to correct excess per soil tile
3618	!! @tex $(kg m^{-2})$ @endtex
3619	REAL(r_std), DIMENSION (kjpindex) :: ru_corr !! Surface runoff produced to correct excess
3620	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3621	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr2_ns !! Correction of negative surface runoff per soil tile
3622	!! @tex $(kg m^{-2})$ @endtex
3623	REAL(r_std), DIMENSION (kjpindex) :: ru_corr2 !! Correction of negative surface runoff
3624	!! @tex $(kg m^{-2})$ @endtex
3625	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corr_ns !! Drainage produced to correct excess
3626	!! @tex $(kg m^{-2})$ @endtex
3627	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corrnum_ns !! Drainage produced to correct numerical errors in tridiag
3628	!! @tex $(kg m^{-2})$ @endtex
3629	REAL(r_std), DIMENSION (kjpindex) :: dr_corr !! Drainage produced to correct excess
3630	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3631	REAL(r_std), DIMENSION (kjpindex) :: dr_corrnum !! Drainage produced to correct numerical errors in tridiag
3632	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3633	REAL(r_std), DIMENSION (kjpindex,nslm) :: dmc !! Delta mc when forcing saturation (zwt_force)
3634	!! @tex $(m^{3} m^{-3})$ @endtex
3635	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_force_ns !! Delta drainage when forcing saturation (zwt_force)
3636	!! per soil tile @tex $(kg m^{-2})$ @endtex
3637	REAL(r_std), DIMENSION (kjpindex) :: dr_force !! Delta drainage when forcing saturation (zwt_force)
3638	!! @tex $(kg m^{-2})$ @endtex
3639	REAL(r_std), DIMENSION (kjpindex,nstm) :: wtd_ns !! Effective water table depth (m)
3640	REAL(r_std), DIMENSION (kjpindex) :: wtd !! Mean water table depth in the grid-cell (m)
3641	REAL(r_std), DIMENSION (kjpindex,nslm,nstm) :: tmc_layh_ns !! Soil moisture content forin each soil layer
3642	!! and each soiltile
3643	!! @tex $(kg m^{-2})$ @endtex
3644
3645	! For the calculation of soil_wet and us/humrel/vegstress
3646	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm !! Soil moisture of each layer
3647	!! @tex $(kg m^{-2})$ @endtex
3648	REAL(r_std), DIMENSION (kjpindex,nslm) :: smw !! Soil moisture of each layer at wilting point
3649	!! @tex $(kg m^{-2})$ @endtex
3650	REAL(r_std), DIMENSION (kjpindex,nslm) :: smf !! Soil moisture of each layer at field capacity
3651	!! @tex $(kg m^{-2})$ @endtex
3652	REAL(r_std), DIMENSION (kjpindex,nslm) :: sms !! Soil moisture of each layer at saturation
3653	!! @tex $(kg m^{-2})$ @endtex
3654	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm_nostress !! Soil moisture of each layer at which us reaches 1
3655	!! @tex $(kg m^{-2})$ @endtex
3656	! For water conservation checks (in mm/dtstep unless otherwise mentioned)
3657	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_infilt_ns !! Water conservation diagnostic at routine scale
3658	REAL(r_std), DIMENSION (kjpindex,nstm) :: check1_ns !! Water conservation diagnostic at routine scale
3659	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_tr_ns !! Water conservation diagnostic at routine scale
3660	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_over_ns !! Water conservation diagnostic at routine scale
3661	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_under_ns !! Water conservation diagnostic at routine scale
3662	REAL(r_std), DIMENSION(kjpindex) :: tmci !! Total soil moisture at beginning of routine (kg/m2)
3663	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! Total soil moisture at end of routine (kg/m2)
3664	REAL(r_std), DIMENSION(kjpindex) :: diag_tr !! Transpiration flux
3665	REAL(r_std), DIMENSION (kjpindex) :: check_infilt !! Water conservation diagnostic at routine scale
3666	REAL(r_std), DIMENSION (kjpindex) :: check1 !! Water conservation diagnostic at routine scale
3667	REAL(r_std), DIMENSION (kjpindex) :: check_tr !! Water conservation diagnostic at routine scale
3668	REAL(r_std), DIMENSION (kjpindex) :: check_over !! Water conservation diagnostic at routine scale
3669	REAL(r_std), DIMENSION (kjpindex) :: check_under !! Water conservation diagnostic at routine scale
3670	! Diagnostic of the vertical soil water fluxes
3671	REAL(r_std), DIMENSION (kjpindex,nslm) :: qflux !! Local upward flux into soil layer
3672	!! from lower interface
3673	!! @tex $(kg m^{-2})$ @endtex
3674	REAL(r_std), DIMENSION (kjpindex) :: check_top !! Water budget residu in top soil layer
3675	!! @tex $(kg m^{-2})$ @endtex
3676
3677
3678	! Variables for calculation of a soil resistance, option do_rsoil (following the formulation of Sellers et al 1992, implemented in Oleson et al. 2008)
3679	REAL(r_std) :: speed !! magnitude of wind speed required for Aerodynamic resistance
3680	REAL(r_std) :: ra !! diagnosed aerodynamic resistance
3681	REAL(r_std), DIMENSION(kjpindex) :: mc_rel !! first layer relative soil moisture, required for rsoil
3682	REAL(r_std), DIMENSION(kjpindex) :: evap_soil !! soil evaporation from Oleson et al 2008
3683	REAL(r_std), DIMENSION(kjpindex,nstm) :: r_soil_ns !! soil resistance from Oleson et al 2008
3684	REAL(r_std), DIMENSION(kjpindex) :: r_soil !! soil resistance from Oleson et al 2008
3685	REAL(r_std), DIMENSION(kjpindex) :: tmcs_litter !! Saturated soil moisture in the 4 "litter" soil layers
3686	REAL(r_std), DIMENSION (nslm) :: nroot_tmp !! Temporary variable to calculate the nroot
3687
3688	!_ ================================================================================================================================
3689
3690	!! 0.1 Arrays with DIMENSION(kjpindex)
3691
3692	returnflow_soil(:) = zero
3693	reinfiltration_soil(:) = zero
3694	irrigation_soil(:) = zero
3695	qflux_ns(:,:,:) = zero
3696	mc_layh(:,:) = zero ! for thermosoil
3697	mcl_layh(:,:) = zero ! for thermosoil
3698	tmc_layh(:,:) = zero ! for thermosoil
3699	tmc_layh_ns(:,:,:) = zero
3700	IF (ok_freeze_cwrr) THEN
3701	kk(:,:,:)=zero
3702	kk_moy(:,:)=zero
3703	ENDIF
3704	undermcr(:) = zero ! needs to be initialized outside from jst loop
3705
3706	IF (ok_freeze_cwrr) THEN
3707
3708	! 0.1 Calculate the temperature and fozen fraction at the hydrological levels
3709
3710	! AD16*** This subroutine could probably be simplified massively given
3711	! that hydro and T share the same vertical discretization
3712	! Here stempdiag is in from thermosoil and temp_hydro is out
3713	CALL hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
3714
3715	! Calculates profil_froz_hydro_ns as a function of temp_hydro, and mc if ok_thermodynamical_freezing
3716	! These values will be kept till the end of the prognostic loop
3717	DO jst=1,nstm
3718	CALL hydrol_soil_froz(kjpindex,jst,njsc)
3719	ENDDO
3720
3721	ELSE
3722
3723	profil_froz_hydro_ns(:,:,:) = zero
3724
3725	ENDIF
3726
3727	!! 0.2 Split 2d variables to 3d variables, per soil tile
3728	! Here, the evaporative fluxes are distributed over the soiltiles as a function of the
3729	! corresponding control factors; they are normalized to vegtot
3730	! At step 7, the reverse transformation is used for the fluxes produced in hydrol_soil
3731	! flux_cell(ji)=sum(flux_ns(ji,jst)soiltile(ji,jst)vegtot(ji))
3732
3733	IF(ok_hydrol_arch)THEN
3734
3735	CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir,humrel, evap_bare_lim, tot_bare_soil, e_frac)
3736
3737	ELSE
3738
3739	CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil)
3740
3741	ENDIF ! (ok_hydrol_arch)
3742
3743
3744	!! 0.3 Common variables related to routing, with all return flow applied to the soil surface
3745	! The fluxes coming from the routing are uniformly splitted into the soiltiles,
3746	! but are normalized to vegtot like the above fluxes:
3747	! flux_ns(ji,jst)=flux_cell(ji)/vegtot(ji)
3748	! It is the case for : irrigation_soil(ji) and reinfiltration_soil(ji) cf below
3749	! It is also the case for subsinksoil(ji), which is divided by (1-tot_frac_nobio) at creation in hydrol_snow
3750	! AD16*** The transformation in 0.2 and 0.3 is likely to induce conservation problems
3751	! when tot_frac_nobio NE 0, since sum(soiltile) NE vegtot in this case
3752
3753	DO ji=1,kjpindex
3754	IF(vegtot(ji).GT.min_sechiba) THEN
3755	! returnflow_soil is assumed to enter from the bottom, but it is not possible with CWRR
3756	returnflow_soil(ji) = zero
3757	reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
3758	irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
3759	ELSE
3760	returnflow_soil(ji) = zero
3761	reinfiltration_soil(ji) = zero
3762	irrigation_soil(ji) = zero
3763	ENDIF
3764	ENDDO
3765
3766	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
3767	!! The called subroutines work on arrays with DIMENSION(kjpindex),
3768	!! recursively used for each soiltile jst
3769
3770	DO jst = 1,nstm
3771
3772	is_under_mcr(:,jst) = .FALSE.
3773	is_over_mcs(:) = .FALSE.
3774
3775	!! 0.4. Keep initial values for future check-up
3776
3777	! Total moisture content (including water2infilt) is saved for balance checks at the end
3778	! In hydrol_tmc_update, tmc is increased by water2infilt(ji,jst), but mc is not modified !
3779	tmcold(:) = tmc(:,jst)
3780
3781	! The value of mc is kept in mcint (nstm dimension removed), in case needed for water balance checks
3782	DO jsl = 1, nslm
3783	DO ji = 1, kjpindex
3784	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
3785	ENDDO
3786	ENDDO
3787	!
3788	! Initial total moisture content : tmcint does not include water2infilt, contrarily to tmcold
3789	DO ji = 1, kjpindex
3790	tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit
3791	ENDDO
3792	DO jsl = 2,nslm-1
3793	DO ji = 1, kjpindex
3794	tmcint(ji) = tmcint(ji) + dz(jsl) &
3795	& * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
3796	& + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
3797	ENDDO
3798	ENDDO
3799	DO ji = 1, kjpindex
3800	tmcint(ji) = tmcint(ji) + dz(nslm) &
3801	& * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
3802	ENDDO
3803
3804	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
3805	!! Input = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) + precisol_ns(ji,jst)
3806	!! - negative evaporation fluxes (MIN(ae_ns(ji,jst),zero)+ MIN(subsinksoil(ji),zero))
3807	!! Output = MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) = positive evaporation flux = water2extract
3808	! In practice, negative subsinksoil(ji) is not possible
3809
3810	!! 1.1 Reduces water2infilt and water2extract to their difference
3811
3812	! Compares water2infilt and water2extract to keep only difference
3813	! Here, temp is used as a temporary variable to store the min of water to infiltrate vs evaporate
3814	DO ji = 1, kjpindex
3815	temp(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
3816	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst), &
3817	MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) )
3818	ENDDO
3819
3820	! The water to infiltrate at the soil surface is either 0, or the difference to what has to be evaporated
3821	! - the initial water2infilt (right hand side) results from qsintveg changes with vegetation updates
3822	! - irrigation_soil is the input flux to the soil surface from irrigation
3823	! - reinfiltration_soil is the input flux to the soil surface from routing 'including returnflow)
3824	! - eventually, water2infilt holds all fluxes to the soil surface except precisol (reduced by water2extract)
3825	DO ji = 1, kjpindex
3826	water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
3827	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst) &
3828	- temp(ji)
3829	ENDDO
3830
3831	! The water to evaporate from the sol surface is either the difference to what has to be infiltrated, or 0
3832	! - subsinksoil is the residual from sublimation is the snowpack is not sufficient
3833	! - how are the negative values of ae_ns taken into account ???
3834	DO ji = 1, kjpindex
3835	water2extract(ji) = MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) - temp(ji)
3836	ENDDO
3837
3838	! Here we acknowledge that subsinksoil is part of ae_ns, but ae_ns is not used further
3839	ae_ns(:,jst) = ae_ns(:,jst) + subsinksoil(:)
3840
3841	!! 1.2 To remove water2extract (including bare soil) from top layer
3842	flux_top(:) = water2extract(:)
3843
3844	!! 1.3 Infiltration
3845
3846	!! Definition of flux_infilt
3847	DO ji = 1, kjpindex
3848	! Initialise the flux to be infiltrated
3849	flux_infilt(ji) = water2infilt(ji,jst)
3850	ENDDO
3851
3852	!! K and D are computed for the profile of mc before infiltration
3853	!! They depend on the fraction of soil ice, given by profil_froz_hydro_ns
3854	CALL hydrol_soil_coef(kjpindex,jst,njsc)
3855
3856	!! Infiltration and surface runoff are computed
3857	!! Infiltration stems from comparing liquid water2infilt to initial total mc (liquid+ice)
3858	!! The conductivity comes from hydrol_soil_coef and relates to the liquid phase only
3859	! This seems consistent with ok_freeze
3860	CALL hydrol_soil_infilt(kjpindex, jst, njsc, flux_infilt, qinfilt_ns, ru_infilt_ns, &
3861	check_infilt_ns)
3862	ru_ns(:,jst) = ru_infilt_ns(:,jst)
3863
3864	!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
3865	! Evrything here is liquid
3866	! RK: water2infilt is both a volume for future reinfiltration (in mm) and a correction term for surface runoff (in mm/dt_sechiba)
3867	IF ( .NOT. doponds ) THEN ! this is the general case...
3868	DO ji = 1, kjpindex
3869	water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
3870	ENDDO
3871	ELSE
3872	DO ji = 1, kjpindex
3873	water2infilt(ji,jst) = zero
3874	ENDDO
3875	ENDIF
3876	!
3877	DO ji = 1, kjpindex
3878	ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
3879	END DO
3880
3881	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
3882	!! This will act on mcl only
3883
3884	!! 2.1 K and D are recomputed after infiltration
3885	!! They depend on the fraction of soil ice, still given by profil_froz_hydro_ns
3886	CALL hydrol_soil_coef(kjpindex,jst,njsc)
3887
3888	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
3889	!! This process will further act on mcl only, based on a, b, d from hydrol_soil_coef
3890	CALL hydrol_soil_setup(kjpindex,jst)
3891
3892	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
3893	DO jsl = 1, nslm
3894	DO ji =1, kjpindex
3895	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
3896	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
3897	! we always have mcl<=mc
3898	! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then mcl<mcr
3899	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
3900	ENDDO
3901	ENDDO
3902
3903	! The value of mcl is kept in mclint (nstm dimension removed), used in the flux computation after diffusion
3904	DO jsl = 1, nslm
3905	DO ji = 1, kjpindex
3906	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
3907	ENDDO
3908	ENDDO
3909
3910	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
3911	! (on mcl only, since the diffusion only modifies mcl)
3912	tmci(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
3913	DO jsl = 2,nslm-1
3914	tmci(:) = tmci(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
3915	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
3916	ENDDO
3917	tmci(:) = tmci(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
3918
3919	!! 2.5 Defining where diffusion is solved : everywhere
3920	!! Since mc>mcs is not possible after infiltration, and we accept that mc<mcr
3921	!! (corrected later by shutting off all evaporative fluxes in this case)
3922	! Nothing is done if resolv=F
3923	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
3924
3925	!! 2.6 We define the system of linear equations for mcl redistribution,
3926	!! based on the matrix coefficients from hydrol_soil_setup
3927	!! following the PhD thesis of de Rosnay (1999), p155-157
3928	!! The bare soil evaporation (subtracted from infiltration) is used directly as flux_top
3929	! rhs for right-hand side term; fp for f'; gp for g'; ep for e'; with flux=0 !
3930
3931	!- First layer
3932	DO ji = 1, kjpindex
3933	tmat(ji,1,1) = zero
3934	tmat(ji,1,2) = f(ji,1)
3935	tmat(ji,1,3) = g1(ji,1)
3936	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
3937	& - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) - rootsink(ji,1,jst)
3938	ENDDO
3939	!- soil body
3940	DO jsl=2, nslm-1
3941	DO ji = 1, kjpindex
3942	tmat(ji,jsl,1) = e(ji,jsl)
3943	tmat(ji,jsl,2) = f(ji,jsl)
3944	tmat(ji,jsl,3) = g1(ji,jsl)
3945	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
3946	& + gp(ji,jsl) * mcl(ji,jsl+1,jst) &
3947	& + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux &
3948	& - rootsink(ji,jsl,jst)
3949	ENDDO
3950	ENDDO
3951	!- Last layer, including drainage
3952	DO ji = 1, kjpindex
3953	jsl=nslm
3954	tmat(ji,jsl,1) = e(ji,jsl)
3955	tmat(ji,jsl,2) = f(ji,jsl)
3956	tmat(ji,jsl,3) = zero
3957	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
3958	& + (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
3959	& - rootsink(ji,jsl,jst)
3960	ENDDO
3961	!- Store the equations in case needed again
3962	DO jsl=1,nslm
3963	DO ji = 1, kjpindex
3964	srhs(ji,jsl) = rhs(ji,jsl)
3965	stmat(ji,jsl,1) = tmat(ji,jsl,1)
3966	stmat(ji,jsl,2) = tmat(ji,jsl,2)
3967	stmat(ji,jsl,3) = tmat(ji,jsl,3)
3968	ENDDO
3969	ENDDO
3970
3971	!! 2.7 Solves diffusion equations, but only in grid-cells where resolv is true, i.e. everywhere (cf 2.2)
3972	!! The result is an updated mcl profile
3973
3974	CALL hydrol_soil_tridiag(kjpindex,jst)
3975
3976	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
3977	! dr_ns in mm/dt_sechiba, from k in mm/d
3978	! This should be done where resolv=T, like tridiag (drainage is part of the linear system !)
3979	DO ji = 1, kjpindex
3980	IF (resolv(ji)) THEN
3981	dr_ns(ji,jst) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst) * (dt_sechiba/one_day)
3982	ELSE
3983	dr_ns(ji,jst) = zero
3984	ENDIF
3985	ENDDO
3986
3987	!! 2.9 For water conservation check during redistribution AND CORRECTION,
3988	!! we calculate the total liquid SM at the end of the routine tridiag
3989	tmcf(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
3990	DO jsl = 2,nslm-1
3991	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
3992	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
3993	ENDDO
3994	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
3995
3996	!! And we compare the difference with the flux...
3997	! Normally, tcmf=tmci-flux_top(ji)-transpir-dr_ns
3998	DO ji=1,kjpindex
3999	diag_tr(ji)=SUM(rootsink(ji,:,jst))
4000	ENDDO
4001	! Here, check_tr_ns holds the inaccuracy during the redistribution phase
4002	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:))
4003
4004	!! We solve here the numerical errors that happen when the soil is close to saturation
4005	!! and drainage very high, and which lead to negative check_tr_ns: the soil dries more
4006	!! than what is demanded by the fluxes, so we need to increase the fluxes.
4007	!! This is done by increasing the drainage.
4008	!! There are also instances of positive check_tr_ns, larger when the drainage is high
4009	!! They are similarly corrected by a decrease of dr_ns, in the limit of keeping a positive drainage.
4010	DO ji=1,kjpindex
4011	IF ( check_tr_ns(ji,jst) .LT. zero ) THEN
4012	dr_corrnum_ns(ji,jst) = -check_tr_ns(ji,jst)
4013	ELSE
4014	dr_corrnum_ns(ji,jst) = -MIN(dr_ns(ji,jst),check_tr_ns(ji,jst))
4015	ENDIF
4016	dr_ns(ji,jst) = dr_ns(ji,jst) + dr_corrnum_ns(ji,jst) ! dr_ns increases/decrease if check_tr negative/positive
4017	ENDDO
4018	!! For water conservation check during redistribution
4019	IF (check_cwrr) THEN
4020	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:))
4021	ENDIF
4022
4023	!! 3. AFTER DIFFUSION/REDISTRIBUTION
4024
4025	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
4026	! The frozen fraction is constant, so that any water flux to/from a layer changes
4027	! both mcl and the ice amount. The assumption behind this is that water entering/leaving
4028	! a soil layer immediately freezes/melts with the proportion profil_froz_hydro_ns/(1-profil_...)
4029	DO jsl = 1, nslm
4030	DO ji =1, kjpindex
4031	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
4032	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
4033	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
4034	ENDDO
4035	ENDDO
4036
4037	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
4038	! Oversaturation results from numerical inaccuracies and can be frequent if free_drain_coef=0
4039	! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
4040	! The former routine hydrol_soil_smooth_over_mcs, which keeps most of the excess in the soiltile
4041	! after smoothing, first downward then upward, is kept in the module but not used here
4042	dr_corr_ns(:,jst) = zero
4043	ru_corr_ns(:,jst) = zero
4044	call hydrol_soil_smooth_over_mcs2(kjpindex, jst, njsc, is_over_mcs, ru_corr_ns, check_over_ns)
4045
4046	! In absence of freezing, if F is large enough, the correction of oversaturation is sent to drainage
4047	DO ji = 1, kjpindex
4048	IF ((free_drain_coef(ji,jst) .GE. 0.5) .AND. (.NOT. ok_freeze_cwrr) ) THEN
4049	dr_corr_ns(ji,jst) = ru_corr_ns(ji,jst)
4050	ru_corr_ns(ji,jst) = zero
4051	ENDIF
4052	ENDDO
4053	dr_ns(:,jst) = dr_ns(:,jst) + dr_corr_ns(:,jst)
4054	ru_ns(:,jst) = ru_ns(:,jst) + ru_corr_ns(:,jst)
4055
4056	!! 3.3 Negative runoff is reported to drainage
4057	! Since we computed ru_ns directly from hydrol_soil_infilt, ru_ns should not be negative
4058
4059	ru_corr2_ns(:,jst) = zero
4060	DO ji = 1, kjpindex
4061	IF (ru_ns(ji,jst) .LT. zero) THEN
4062	IF (printlev>=3) WRITE (numout,*) 'NEGATIVE RU_NS: runoff and drainage before correction',&
4063	ru_ns(ji,jst),dr_ns(ji,jst)
4064	dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
4065	ru_corr2_ns(ji,jst) = -ru_ns(ji,jst)
4066	ru_ns(ji,jst)= 0.
4067	END IF
4068	ENDDO
4069
4070	!! 3.4 Optional block to force saturation below zwt_force
4071	! We test if zwt_force(1,jst) <= zmaxh, to avoid steps 1 and 2 if unnecessary
4072
4073	IF (zwt_force(1,jst) <= zmaxh) THEN
4074
4075	!! We force the nodes below zwt_force to be saturated
4076	! As above, we compare mc to mcs
4077	DO jsl = 1,nslm
4078	DO ji = 1, kjpindex
4079	dmc(ji,jsl) = zero
4080	IF ( ( zz(jsl) >= zwt_force(ji,jst)*mille ) ) THEN
4081	dmc(ji,jsl) = mcs(njsc(ji)) - mc(ji,jsl,jst) ! addition to reach mcs (m3/m3) = positive value
4082	mc(ji,jsl,jst) = mcs(njsc(ji))
4083	ENDIF
4084	ENDDO
4085	ENDDO
4086
4087	!! To ensure conservation, this needs to be balanced by a negative change in drainage (in kg/m2/dt)
4088	DO ji = 1, kjpindex
4089	dr_force_ns(ji,jst) = dz(2) * ( trois*dmc(ji,1) + dmc(ji,2) )/huit ! top layer = initialization
4090	ENDDO
4091	DO jsl = 2,nslm-1 ! intermediate layers
4092	DO ji = 1, kjpindex
4093	dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(jsl) &
4094	& * (trois*dmc(ji,jsl)+dmc(ji,jsl-1))/huit &
4095	& + dz(jsl+1) * (trois*dmc(ji,jsl)+dmc(ji,jsl+1))/huit
4096	ENDDO
4097	ENDDO
4098	DO ji = 1, kjpindex
4099	dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(nslm) & ! bottom layer
4100	& * (trois * dmc(ji,nslm) + dmc(ji,nslm-1))/huit
4101	dr_ns(ji,jst) = dr_ns(ji,jst) - dr_force_ns(ji,jst) ! dr_force_ns is positive and dr_ns must be reduced
4102	END DO
4103
4104	ELSE
4105
4106	dr_force_ns(:,jst) = zero
4107
4108	ENDIF
4109
4110	!! 3.5 Diagnosing the effective water table depth:
4111	!! Defined as as the smallest jsl value when mc(jsl) is no more at saturation (mcs), starting from the bottom
4112	! If there is a part of the soil which is saturated but underlain with unsaturated nodes,
4113	! this is not considered as a water table
4114	DO ji = 1, kjpindex
4115	wtd_ns(ji,jst) = undef_sechiba ! in meters
4116	jsl=nslm
4117	DO WHILE ( (mc(ji,jsl,jst) .EQ. mcs(njsc(ji))) .AND. (jsl > 1) )
4118	wtd_ns(ji,jst) = zz(jsl)/mille ! in meters
4119	jsl=jsl-1
4120	ENDDO
4121	ENDDO
4122
4123	!! 3.6 Diagnose under_mcr to adapt water stress calculation below
4124	! This routine does not change tmc but decides where we should turn off ET to prevent further mc decrease
4125	! Like above, the tests are made on total mc, compared to mcr
4126	CALL hydrol_soil_smooth_under_mcr(kjpindex, jst, njsc, is_under_mcr, check_under_ns)
4127
4128	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
4129
4130	!! 4.1 Total soil moisture content (water2infilt added below)
4131	DO ji = 1, kjpindex
4132	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
4133	ENDDO
4134	DO jsl = 2,nslm-1
4135	DO ji = 1, kjpindex
4136	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
4137	& * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
4138	& + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
4139	ENDDO
4140	ENDDO
4141	DO ji = 1, kjpindex
4142	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
4143	& * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
4144	END DO
4145
4146	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
4147	!! and in case we would like to export it (xios)
4148	DO jsl = 1, nslm
4149	DO ji =1, kjpindex
4150	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
4151	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
4152	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4153	ENDDO
4154	ENDDO
4155
4156	!! 5. Optional check of the water balance of soil column (if check_cwrr)
4157
4158	IF (check_cwrr) THEN
4159	!! 5.1 Computation of the vertical water fluxes and water balance of the top layer
4160	CALL hydrol_diag_soil_flux(kjpindex,jst,mclint,flux_top)
4161	ENDIF
4162
4163	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
4164	! Starting here, mc and mcl should not change anymore
4165
4166	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
4167	!! (based on mc)
4168
4169	!! In output, tmc includes water2infilt(ji,jst)
4170	DO ji=1,kjpindex
4171	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
4172	END DO
4173
4174	! The litter is the 4 top levels of the soil
4175	! Compute various field of soil moisture for the litter (used for stomate and for albedo)
4176	DO ji=1,kjpindex
4177	tmc_litter(ji,jst) = dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
4178	END DO
4179	! sum from level 1 to 4
4180	DO jsl=2,4
4181	DO ji=1,kjpindex
4182	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
4183	& ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
4184	& + dz(jsl+1)(troismc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
4185	END DO
4186	END DO
4187
4188	! Subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcf-tmcw)
4189	DO ji=1,kjpindex
4190	soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
4191	& (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
4192	& (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
4193	END DO
4194
4195	! Preliminary calculation of various soil moistures (for each layer, in kg/m2)
4196	sm(:,1) = dz(2) * (trois*mcl(:,1,jst) + mcl(:,2,jst))/huit
4197	smw(:,1) = dz(2) * (quatre*mcw(njsc(:)))/huit
4198	smf(:,1) = dz(2) * (quatre*mcf(njsc(:)))/huit
4199	sms(:,1) = dz(2) * (quatre*mcs(njsc(:)))/huit
4200	DO jsl = 2,nslm-1
4201	sm(:,jsl) = dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4202	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4203	smw(:,jsl) = dz(jsl) * ( quatre*mcw(njsc(:)) )/huit &
4204	+ dz(jsl+1) * ( quatre*mcw(njsc(:)) )/huit
4205	smf(:,jsl) = dz(jsl) * ( quatre*mcf(njsc(:)) )/huit &
4206	+ dz(jsl+1) * ( quatre*mcf(njsc(:)) )/huit
4207	sms(:,jsl) = dz(jsl) * ( quatre*mcs(njsc(:)) )/huit &
4208	+ dz(jsl+1) * ( quatre*mcs(njsc(:)) )/huit
4209	ENDDO
4210	sm(:,nslm) = dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4211	smw(:,nslm) = dz(nslm) * (quatre*mcw(njsc(:)))/huit
4212	smf(:,nslm) = dz(nslm) * (quatre*mcf(njsc(:)))/huit
4213	sms(:,nslm) = dz(nslm) * (quatre*mcs(njsc(:)))/huit
4214	! sm_nostress = soil moisture of each layer at which us reaches 1, here at the middle of [smw,smf]
4215	DO jsl = 1,nslm
4216	sm_nostress(:,jsl) = smw(:,jsl) + pcent(njsc(:)) * (smf(:,jsl)-smw(:,jsl))
4217	END DO
4218
4219	! Saturated litter soil moisture for rsoil
4220	tmcs_litter(:) = zero
4221	DO jsl = 1,4
4222	tmcs_litter(:) = tmcs_litter(:) + sms(:,jsl)
4223	END DO
4224
4225	! Soil wetness profiles (W-Ww)/(Ws-Ww)
4226	! soil_wet is the ratio of available soil moisture to max available soil moisture
4227	! (ie soil moisture at saturation minus soil moisture at wilting point).
4228	! soil wet is a water stress for stomate, to control C decomposition
4229	DO jsl=1,nslm
4230	DO ji=1,kjpindex
4231	soil_wet(ji,jsl,jst) = MIN(un, MAX(zero, &
4232	(sm(ji,jsl)-smw(ji,jsl))/(sms(ji,jsl)-smw(ji,jsl)) ))
4233	END DO
4234	END DO
4235
4236	! Compute us and the new humrelv to use in sechiba (with loops on the vegetation types)
4237	! This is the water stress for transpiration (diffuco) and photosynthesis (diffuco)
4238	! humrel is never used in stomate
4239
4240	! -- PFT1
4241	humrelv(:,1,jst) = zero
4242	! -- Top layer
4243	DO jv = 2,nvm
4244	DO ji=1,kjpindex
4245	!- Here we make the assumption that roots do not take water from the 1st layer.
4246	us(ji,jv,jst,1) = zero
4247	humrelv(ji,jv,jst) = zero ! initialisation of the sum
4248	END DO
4249	ENDDO
4250
4251	!! Dynamic nroot to optimize water use: the root profile used to weight the water stress function
4252	!! of each soil layer is updated at each time step in order to match the soil water profile
4253	!! (the soil water content of each layer available for transpiration)
4254	IF (ok_dynroot) THEN
4255	DO jv = 1, nvm
4256	IF ( is_tree(jv) ) THEN
4257	DO ji = 1, kjpindex
4258	nroot_tmp(:) = zero
4259	DO jsl = 2, nslm
4260	nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) )
4261	ENDDO
4262	IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN
4263	nroot(ji,jv,:) = nroot_tmp(:)/SUM(nroot_tmp(:))
4264	ELSE
4265	nroot(ji,jv,:) = zero
4266	END IF
4267	ENDDO
4268	ELSE
4269	! Specific case for grasses where we only consider the first 1m of soil.
4270	DO ji = 1, kjpindex
4271	nroot_tmp(:) = zero
4272	DO jsl = 2, nslm
4273	IF (znt(jsl) .LT. un) THEN
4274	nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) )
4275	END IF
4276	ENDDO
4277
4278	IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN
4279	DO jsl = 2,nslm
4280	IF (znt(jsl) .LT. un) THEN
4281	nroot(ji,jv,jsl) = nroot_tmp(jsl)/SUM(nroot_tmp(:))
4282	ELSE
4283	nroot(ji,jv,jsl) = zero
4284	END IF
4285	ENDDO
4286	nroot(ji,jv,1) = zero
4287	END IF
4288	ENDDO
4289	END IF
4290	ENDDO
4291	ENDIF
4292
4293	! -- Intermediate and bottom layers
4294	DO jsl = 2,nslm
4295	DO jv = 2, nvm
4296	DO ji=1,kjpindex
4297	! AD16*** Although plants can only withdraw liquid water, we compute here the water stress
4298	! based on mc and the corresponding thresholds mcs, pcent, or potentially mcw and mcf
4299	! This is consistent with assuming that ice is uniformly distributed within the poral space
4300	! In such a case, freezing makes mcl and the "liquid" porosity smaller than the "total" values
4301	! And it is the same for all the moisture thresholds, which are proportional to porosity.
4302	! Since the stress is based on relative moisture, it could thus be independent from the porosity
4303	! at first order, thus independent from freezing.
4304	IF(new_watstress) THEN
4305	IF((sm(ji,jsl)-smw(ji,jsl)) .GT. min_sechiba) THEN
4306	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
4307	(EXP(- alpha_watstress * &
4308	( (smf(ji,jsl) - smw(ji,jsl)) / ( sm_nostress(ji,jsl) - smw(ji,jsl)) ) * &
4309	( (sm_nostress(ji,jsl) - sm(ji,jsl)) / ( sm(ji,jsl) - smw(ji,jsl)) ) ) ) ))&
4310	* nroot(ji,jv,jsl)
4311	ELSE
4312	us(ji,jv,jst,jsl) = 0.
4313	ENDIF
4314	ELSE
4315	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
4316	(sm(ji,jsl)-smw(ji,jsl))/(sm_nostress(ji,jsl)-smw(ji,jsl)) )) * nroot(ji,jv,jsl)
4317	ENDIF
4318	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)
4319	END DO
4320	END DO
4321	ENDDO
4322
4323	!! vegstressv is the water stress for phenology in stomate
4324	!! It varies linearly from zero at wilting point to 1 at field capacity
4325	vegstressv(:,:,jst) = zero
4326	DO jv = 2, nvm
4327	DO ji=1,kjpindex
4328	DO jsl=1,nslm
4329	vegstressv(ji,jv,jst) = vegstressv(ji,jv,jst) + &
4330	MIN(un, MAX(zero, (sm(ji,jsl)-smw(ji,jsl))/(smf(ji,jsl)-smw(ji,jsl)) )) &
4331	* nroot(ji,jv,jsl)
4332	END DO
4333	END DO
4334	END DO
4335
4336
4337	! -- If the PFT is absent, the corresponding humrelv and vegstressv = 0
4338	DO jv = 2, nvm
4339	DO ji = 1, kjpindex
4340	IF (vegetmax_soil(ji,jv,jst) .LT. min_sechiba) THEN
4341	humrelv(ji,jv,jst) = zero
4342	vegstressv(ji,jv,jst) = zero
4343	us(ji,jv,jst,:) = zero
4344	ENDIF
4345	END DO
4346	END DO
4347
4348	!! 6.2 We need to turn off evaporation when is_under_mcr
4349	!! We set us, humrelv and vegstressv to zero in this case
4350	!! WARNING: It's different from having locally us=0 in the soil layers(s) where mc<mcr
4351	!! This part is crucial to preserve water conservation
4352	DO jsl = 1,nslm
4353	DO jv = 2, nvm
4354	WHERE (is_under_mcr(:,jst))
4355	us(:,jv,jst,jsl) = zero
4356	ENDWHERE
4357	ENDDO
4358	ENDDO
4359	DO jv = 2, nvm
4360	WHERE (is_under_mcr(:,jst))
4361	humrelv(:,jv,jst) = zero
4362	ENDWHERE
4363	ENDDO
4364
4365	! For consistency in stomate, we also set moderwilt and soil_wet to zero in this case.
4366	! They are used later for shumdiag and shumdiag_perma
4367	DO jsl = 1,nslm
4368	WHERE (is_under_mcr(:,jst))
4369	soil_wet(:,jsl,jst) = zero
4370	ENDWHERE
4371	ENDDO
4372
4373	! Counting the nb of under_mcr occurences in each grid-cell
4374	WHERE (is_under_mcr(:,jst))
4375	undermcr = undermcr + un
4376	ENDWHERE
4377
4378	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
4379	!! thermosoil for the thermal conductivity. Calculate also total soil moisture content(tmc_layh)
4380	!! needed in thermosoil for the heat capacity.
4381	!! The multiplication by vegtot creates grid-cell average values
4382	! *** To be checked for consistency with the use of nobio properties in thermosoil
4383	DO ji=1,kjpindex
4384	DO jsl=1,nslm
4385	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
4386	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
4387	ENDDO
4388	tmc_layh_ns(ji,1,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
4389	DO jsl = 2,nslm-1
4390	tmc_layh_ns(ji,jsl,jst) = dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
4391	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
4392	ENDDO
4393	tmc_layh_ns(ji,nslm,jst) = dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
4394	DO jsl = 1,nslm
4395	tmc_layh(ji,jsl) = tmc_layh(ji,jsl) + tmc_layh_ns(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
4396	ENDDO
4397	END DO
4398
4399	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
4400	! (no call of hydrol_soil_coef since 2.1)
4401	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4402	IF (ok_freeze_cwrr) THEN
4403	DO ji = 1, kjpindex
4404	kk_moy(ji,:) = kk_moy(ji,:) + soiltile(ji,jst) * k(ji,:) * vegtot(ji)
4405	kk(ji,:,jst) = k(ji,:)
4406	ENDDO
4407	ENDIF
4408
4409	IF (printlev>=3) WRITE (numout,*) ' prognostic/diagnostic part of hydrol_soil done for jst =', jst
4410
4411	END DO ! end of loop on soiltile
4412
4413	!! -- ENDING THE MAIN LOOP ON SOILTILES
4414
4415	!! 7. Summing 3d variables into 2d variables
4416	CALL hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
4417	& evapot, vevapnu, returnflow, reinfiltration, irrigation, &
4418	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
4419
4420	! Means of wtd, runoff and drainage corrections, across soiltiles
4421	wtd(:) = zero
4422	ru_corr(:) = zero
4423	ru_corr2(:) = zero
4424	dr_corr(:) = zero
4425	dr_corrnum(:) = zero
4426	dr_force(:) = zero
4427	DO jst = 1, nstm
4428	DO ji = 1, kjpindex
4429	wtd(ji) = wtd(ji) + soiltile(ji,jst) * wtd_ns(ji,jst) ! average over vegtot only
4430	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4431	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4432	ru_corr(ji) = ru_corr(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr_ns(ji,jst)
4433	ru_corr2(ji) = ru_corr2(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr2_ns(ji,jst)
4434	dr_corr(ji) = dr_corr(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corr_ns(ji,jst)
4435	dr_corrnum(ji) = dr_corrnum(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corrnum_ns(ji,jst)
4436	dr_force(ji) = dr_force(ji) - vegtot(ji) * soiltile(ji,jst) * dr_force_ns(ji,jst)
4437	! the sign is OK to get a negative drainage flux
4438	ENDIF
4439	ENDDO
4440	ENDDO
4441
4442	! Means local variables, including water conservation checks
4443	ru_infilt(:)=0.
4444	qinfilt(:)=0.
4445	check_infilt(:)=0.
4446	check_tr(:)=0.
4447	check_over(:)=0.
4448	check_under(:)=0.
4449	qflux(:,:)=0
4450	check_top(:)=0.
4451
4452	DO jst = 1, nstm
4453	DO ji = 1, kjpindex
4454	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4455	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4456	ru_infilt(ji) = ru_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * ru_infilt_ns(ji,jst)
4457	qinfilt(ji) = qinfilt(ji) + vegtot(ji) * soiltile(ji,jst) * qinfilt_ns(ji,jst)
4458	ENDIF
4459	ENDDO
4460	ENDDO
4461
4462	IF (check_cwrr) THEN
4463	DO jst = 1, nstm
4464	DO ji = 1, kjpindex
4465	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4466	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4467	check_infilt(ji) = check_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * check_infilt_ns(ji,jst)
4468	check_tr(ji) = check_tr(ji) + vegtot(ji) * soiltile(ji,jst) * check_tr_ns(ji,jst)
4469	check_over(ji) = check_over(ji) + vegtot(ji) * soiltile(ji,jst) * check_over_ns(ji,jst)
4470	check_under(ji) = check_under(ji) + vegtot(ji) * soiltile(ji,jst) * check_under_ns(ji,jst)
4471	!
4472	qflux(ji,:) = qflux(ji,:) + vegtot(ji) * soiltile(ji,jst) * qflux_ns(ji,:,jst)
4473	check_top(ji) = check_top(ji) + vegtot(ji) * soiltile(ji,jst) * check_top_ns(ji,jst)
4474	ENDIF
4475	ENDDO
4476	ENDDO
4477	END IF
4478	!! 8. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
4479	!! The principle is to run a dummy integration of the water redistribution scheme
4480	!! to check if the SM profile can sustain a potential evaporation.
4481	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
4482	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
4483
4484	! evap_bare_lim = beta factor for bare soil evaporation
4485	evap_bare_lim(:) = zero
4486	evap_bare_lim_ns(:,:) = zero
4487
4488	! Loop on soil tiles
4489	DO jst = 1,nstm
4490
4491	!! 8.1 Save actual mc, mcl, and tmc for restoring at the end of the time step
4492	!! and calculate tmcint corresponding to mc without water2infilt
4493	DO jsl = 1, nslm
4494	DO ji = 1, kjpindex
4495	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
4496	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
4497	ENDDO
4498	ENDDO
4499
4500	DO ji = 1, kjpindex
4501	temp(ji) = tmc(ji,jst)
4502	tmcint(ji) = temp(ji) - water2infilt(ji,jst) ! to estimate bare soil evap based on water budget
4503	ENDDO
4504
4505	!! 8.2 Since we estimate bare soile evap for the next time step, we update profil_froz_hydro and mcl
4506	! (effect of mc only, the change in temp_hydro is neglected)
4507	IF ( ok_freeze_cwrr ) CALL hydrol_soil_froz(kjpindex,jst,njsc)
4508	DO jsl = 1, nslm
4509	DO ji =1, kjpindex
4510	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
4511	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
4512	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4513	ENDDO
4514	ENDDO
4515
4516	!! 8.3 K and D are recomputed for the updated profile of mc/mcl
4517	CALL hydrol_soil_coef(kjpindex,jst,njsc)
4518
4519	!! 8.4 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
4520	CALL hydrol_soil_setup(kjpindex,jst)
4521	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
4522
4523	!! 8.5 We define the system of linear equations, based on matrix coefficients,
4524
4525	!- Impose potential evaporation as flux_top in mm/step, assuming the water is available
4526	! Note that this should lead to never have evapnu>evapot_penm(ji)
4527
4528	DO ji = 1, kjpindex
4529	IF (vegtot(ji).GT.min_sechiba) THEN
4530	! We calculate a reduced demand, by means of a soil resistance
4531	IF (do_rsoil) THEN
4532	mc_rel(ji) = tmc_litter(ji,jst)/tmcs_litter(ji)
4533	! based on SM in the top 4 soil layers (litter) to smooth variability
4534	r_soil_ns(ji,jst) = exp(8.206 - 4.255 * mc_rel(ji))
4535	ELSE
4536	r_soil_ns(ji,jst) = zero
4537	ENDIF
4538
4539	! Aerodynamic resistance
4540	speed = MAX(min_wind, SQRT (u(ji)u(ji) + v(ji)v(ji)))
4541	IF (speed * tq_cdrag(ji) .GT. min_sechiba) THEN
4542	ra = un / (speed * tq_cdrag(ji))
4543	evap_soil(ji) = evapot_penm(ji) / (un + r_soil_ns(ji,jst)/ra)
4544	ELSE
4545	evap_soil(ji) = evapot_penm(ji)
4546	ENDIF
4547
4548	! AD16*** et si evap_bare_lim_ns<0 ?? car on suppose que tmcint > tmc(new)
4549	! (water2inflit permet de propager de la ponded water d'un pas de temps a l'autre:
4550	! peut-on s'en servir pour creer des cas d'evapnu potentielle negative ? a gerer dans diffuco ?)
4551
4552	flux_top(ji) = evapot_penm(ji) * &
4553	AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
4554	ELSE
4555	flux_top(ji) = zero
4556	ENDIF
4557	ENDDO
4558
4559	! We don't use rootsinks, because we assume there is no transpiration in the bare soil fraction (??)
4560	!- First layer
4561	DO ji = 1, kjpindex
4562	tmat(ji,1,1) = zero
4563	tmat(ji,1,2) = f(ji,1)
4564	tmat(ji,1,3) = g1(ji,1)
4565	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
4566	- flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day)
4567	ENDDO
4568	!- soil body
4569	DO jsl=2, nslm-1
4570	DO ji = 1, kjpindex
4571	tmat(ji,jsl,1) = e(ji,jsl)
4572	tmat(ji,jsl,2) = f(ji,jsl)
4573	tmat(ji,jsl,3) = g1(ji,jsl)
4574	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4575	+ gp(ji,jsl) * mcl(ji,jsl+1,jst) &
4576	+ (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux
4577	ENDDO
4578	ENDDO
4579	!- Last layer
4580	DO ji = 1, kjpindex
4581	jsl=nslm
4582	tmat(ji,jsl,1) = e(ji,jsl)
4583	tmat(ji,jsl,2) = f(ji,jsl)
4584	tmat(ji,jsl,3) = zero
4585	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4586	+ (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux
4587	ENDDO
4588	!- Store the equations for later use (9.6)
4589	DO jsl=1,nslm
4590	DO ji = 1, kjpindex
4591	srhs(ji,jsl) = rhs(ji,jsl)
4592	stmat(ji,jsl,1) = tmat(ji,jsl,1)
4593	stmat(ji,jsl,2) = tmat(ji,jsl,2)
4594	stmat(ji,jsl,3) = tmat(ji,jsl,3)
4595	ENDDO
4596	ENDDO
4597
4598	!! 8.6 Solve the diffusion equation, assuming that flux_top=evapot_penm (updates mcl)
4599	CALL hydrol_soil_tridiag(kjpindex,jst)
4600
4601	!! 9.7 Alternative solution with mc(1)=mcr in points where the above solution leads to mcl<mcr
4602	! hydrol_soil_tridiag calculates mc recursively from the top as a fonction of rhs and tmat
4603	! We re-use these the above values, but for mc(1)=mcr and the related tmat
4604
4605	DO ji = 1, kjpindex
4606	! by construction, mc and mcl are always on the same side of mcr, so we can use mcl here
4607	resolv(ji) = (mcl(ji,1,jst).LT.(mcr(njsc(ji))).AND.flux_top(ji).GT.min_sechiba)
4608	ENDDO
4609	!! Reset the coefficient for diffusion (tridiag is only solved if resolv(ji) = .TRUE.)O
4610	DO jsl=1,nslm
4611	!- The new condition is to put the upper layer at residual soil moisture
4612	DO ji = 1, kjpindex
4613	rhs(ji,jsl) = srhs(ji,jsl)
4614	tmat(ji,jsl,1) = stmat(ji,jsl,1)
4615	tmat(ji,jsl,2) = stmat(ji,jsl,2)
4616	tmat(ji,jsl,3) = stmat(ji,jsl,3)
4617	END DO
4618	END DO
4619
4620	DO ji = 1, kjpindex
4621	tmat(ji,1,2) = un
4622	tmat(ji,1,3) = zero
4623	rhs(ji,1) = mcr(njsc(ji))
4624	ENDDO
4625
4626	! Solves the diffusion equation with new surface bc where resolv=T
4627	CALL hydrol_soil_tridiag(kjpindex,jst)
4628
4629	!! 8.8 In both case, we have drainage to be consistent with rhs
4630	DO ji = 1, kjpindex
4631	flux_bottom(ji) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst) * (dt_sechiba/one_day)
4632	ENDDO
4633
4634	!! 8.9 Water budget to assess the top flux = soil evaporation
4635	! Where resolv=F at the 2nd step (9.6), it should simply be the potential evaporation
4636
4637	! Total soil moisture content for water budget
4638
4639	DO jsl = 1, nslm
4640	DO ji =1, kjpindex
4641	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
4642	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
4643	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
4644	ENDDO
4645	ENDDO
4646
4647	DO ji = 1, kjpindex
4648	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
4649	ENDDO
4650	DO jsl = 2,nslm-1
4651	DO ji = 1, kjpindex
4652	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
4653	* (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
4654	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
4655	ENDDO
4656	ENDDO
4657	DO ji = 1, kjpindex
4658	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
4659	* (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
4660	END DO
4661
4662	! Deduce upper flux from soil moisture variation and bottom flux
4663	! TMCi-D-BSE=TMC (BSE=bare soil evap=TMCi-TMC-D)
4664	! The numerical errors of tridiag close to saturation cannot be simply solved here,
4665	! we can only hope they are not too large because we don't add water at this stage...
4666	DO ji = 1, kjpindex
4667	evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
4668	(tmcint(ji)-tmc(ji,jst)-flux_bottom(ji))
4669	END DO
4670
4671	!! 8.10 evap_bare_lim_ns is turned from an evaporation rate to a beta
4672	DO ji = 1, kjpindex
4673	! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil.
4674	! This is given by frac_bare_ns, taking into account bare soil under vegetation
4675	IF(vegtot(ji) .GT. min_sechiba) THEN
4676	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) * frac_bare_ns(ji,jst)
4677	ELSE
4678	evap_bare_lim_ns(ji,jst) = 0.
4679	ENDIF
4680	END DO
4681
4682	! We divide by evapot, which is consistent with diffuco (evap_bare_lim_ns < evapot_penm/evapot)
4683	! Further decrease if tmc_litter is below the wilting point
4684
4685	IF (do_rsoil) THEN
4686	DO ji=1,kjpindex
4687	IF (evapot(ji).GT.min_sechiba) THEN
4688	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
4689	ELSE
4690	evap_bare_lim_ns(ji,jst) = zero ! not redundant with the is_under_mcr case below
4691	! but not necessarily useful
4692	END IF
4693	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
4694	END DO
4695	ELSE
4696	DO ji=1,kjpindex
4697	IF ((evapot(ji).GT.min_sechiba) .AND. &
4698	(tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN
4699	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
4700	ELSEIF((evapot(ji).GT.min_sechiba).AND. &
4701	(tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN
4702	evap_bare_lim_ns(ji,jst) = (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji)
4703	! This is very arbitrary, with no justification from the literature
4704	ELSE
4705	evap_bare_lim_ns(ji,jst) = zero
4706	END IF
4707	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
4708	END DO
4709	ENDIF
4710
4711	!! 8.11 Set evap_bare_lim_ns to zero if is_under_mcr at the end of the prognostic loop
4712	!! (cf us, humrelv, vegstressv in 5.2)
4713	WHERE (is_under_mcr(:,jst))
4714	evap_bare_lim_ns(:,jst) = zero
4715	ENDWHERE
4716
4717	!! 8.12 Restores mc, mcl, and tmc, to erase the effect of the dummy integrations
4718	!! on these prognostic variables
4719	DO jsl = 1, nslm
4720	DO ji = 1, kjpindex
4721	mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
4722	mcl(ji,jsl,jst) = mask_soiltile(ji,jst) * mclint(ji,jsl)
4723	ENDDO
4724	ENDDO
4725	DO ji = 1, kjpindex
4726	tmc(ji,jst) = temp(ji)
4727	ENDDO
4728
4729	ENDDO !end loop on tiles for dummy integration
4730
4731	!! 9. evap_bar_lim is the grid-cell scale beta
4732	DO ji = 1, kjpindex
4733	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
4734	r_soil(ji) = SUM(r_soil_ns(ji,:)vegtot(ji)soiltile(ji,:))
4735	ENDDO
4736
4737
4738	!! 10. XIOS export of local variables, including water conservation checks
4739
4740	CALL xios_orchidee_send_field("wtd",wtd) ! in m
4741	CALL xios_orchidee_send_field("ru_corr",ru_corr/dt_sechiba) ! adjustment flux added to surface runoff (included in runoff)
4742	CALL xios_orchidee_send_field("ru_corr2",ru_corr2/dt_sechiba)
4743	CALL xios_orchidee_send_field("dr_corr",dr_corr/dt_sechiba) ! adjustment flux added to drainage (included in drainage)
4744	CALL xios_orchidee_send_field("dr_corrnum",dr_corrnum/dt_sechiba)
4745	CALL xios_orchidee_send_field("dr_force",dr_force/dt_sechiba) ! adjustement flux added to drainage to sustain a forced wtd
4746	CALL xios_orchidee_send_field("qinfilt",qinfilt/dt_sechiba)
4747	CALL xios_orchidee_send_field("ru_infilt",ru_infilt/dt_sechiba)
4748	CALL xios_orchidee_send_field("r_soil",r_soil) ! kg/m2
4749	IF (check_cwrr) THEN
4750	CALL xios_orchidee_send_field("check_infilt",check_infilt/dt_sechiba)
4751	CALL xios_orchidee_send_field("check_tr",check_tr/dt_sechiba)
4752	CALL xios_orchidee_send_field("check_over",check_over/dt_sechiba)
4753	CALL xios_orchidee_send_field("check_under",check_under/dt_sechiba)
4754
4755	! Variables calculated in hydrol_diag_soil_flux
4756	CALL xios_orchidee_send_field("qflux",qflux/dt_sechiba) ! upward water flux at the low interface of each layer
4757	CALL xios_orchidee_send_field("check_top",check_top/dt_sechiba) !water budget residu in top layer
4758	END IF
4759
4760	END SUBROUTINE hydrol_soil
4761
4762
4763	!! ================================================================================================================================
4764	!! SUBROUTINE : hydrol_soil_infilt
4765	!!
4766	!>\BRIEF Infiltration
4767	!!
4768	!! DESCRIPTION :
4769	!! 1. We calculate the total SM at the beginning of the routine
4770	!! 2. Infiltration process
4771	!! 2.1 Initialization of time counter and infiltration rate
4772	!! 2.2 Infiltration layer by layer, accounting for an exponential law for subgrid variability
4773	!! 2.3 Resulting infiltration and surface runoff
4774	!! 3. For water conservation check, we calculate the total SM at the beginning of the routine,
4775	!! and export the difference with the flux
4776	!! 5. Local verification
4777	!!
4778	!! RECENT CHANGE(S) : 2016 by A. Ducharne
4779	!! Adding checks and interactions variables with hydrol_soil, but the processes are unchanged
4780	!!
4781	!! MAIN OUTPUT VARIABLE(S) :
4782	!!
4783	!! REFERENCE(S) :
4784	!!
4785	!! FLOWCHART : None
4786	!! \n
4787	!_ ================================================================================================================================
4788	!_ hydrol_soil_infilt
4789
4790	SUBROUTINE hydrol_soil_infilt(kjpindex, ins, njsc, flux_infilt, qinfilt_ns, ru_infilt, check)
4791
4792	!! 0. Variable and parameter declaration
4793
4794	!! 0.1 Input variables
4795
4796	! GLOBAL (in or inout)
4797	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
4798	INTEGER(i_std), INTENT(in) :: ins
4799	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell
4800	!! (1-nscm, unitless)
4801	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: flux_infilt !! Water to infiltrate
4802	!! @tex $(kg m^{-2})$ @endtex
4803
4804	!! 0.2 Output variables
4805	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux (mm/dt_sechiba)
4806	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: ru_infilt !! Surface runoff from soil_infilt (mm/dt_sechiba)
4807	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: qinfilt_ns !! Effective infiltration flux (mm/dt_sechiba)
4808
4809	!! 0.3 Modified variables
4810
4811	!! 0.4 Local variables
4812
4813	INTEGER(i_std) :: ji, jsl !! Indices
4814	REAL(r_std), DIMENSION (kjpindex) :: wat_inf_pot !! infiltrable water in the layer
4815	REAL(r_std), DIMENSION (kjpindex) :: wat_inf !! infiltrated water in the layer
4816	REAL(r_std), DIMENSION (kjpindex) :: dt_tmp !! time remaining before the end of the time step
4817	REAL(r_std), DIMENSION (kjpindex) :: dt_inf !! the time it takes to complete the infiltration in the
4818	!! layer
4819	REAL(r_std) :: k_m !! the mean conductivity used for the saturated front
4820	REAL(r_std), DIMENSION (kjpindex) :: infilt_tmp !! infiltration rate for the considered layer
4821	REAL(r_std), DIMENSION (kjpindex) :: infilt_tot !! total infiltration
4822	REAL(r_std), DIMENSION (kjpindex) :: flux_tmp !! rate at which precip hits the ground
4823
4824	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine (kg/m2)
4825	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine (kg/m2)
4826
4827
4828	!_ ================================================================================================================================
4829
4830	! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
4831
4832	!! 1. We calculate the total SM at the beginning of the routine
4833	IF (check_cwrr) THEN
4834	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
4835	DO jsl = 2,nslm-1
4836	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
4837	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
4838	ENDDO
4839	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
4840	ENDIF
4841
4842	!! 2. Infiltration process
4843
4844	!! 2.1 Initialization
4845
4846	DO ji = 1, kjpindex
4847	!! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
4848	wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,1,ins)) * dz(2) / deux, zero)
4849	wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji))
4850	mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2)
4851	!
4852	ENDDO
4853
4854	!! Initialize a countdown for infiltration during the time-step and the value of potential runoff
4855	dt_tmp(:) = dt_sechiba / one_day
4856	infilt_tot(:) = wat_inf(:)
4857	!! Compute the rate at which water will try to infiltrate each layer
4858	! flux_temp is converted here to the same unit as k_m
4859	flux_tmp(:) = (flux_infilt(:)-wat_inf(:)) / dt_tmp(:)
4860
4861	!! 2.2 Infiltration layer by layer
4862	DO jsl = 2, nslm-1
4863	DO ji = 1, kjpindex
4864	!! Infiltrability of each layer if under a saturated one
4865	! This is computed by an simple arithmetic average because
4866	! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
4867	k_m = (k(ji,jsl) + ks(njsc(ji))kfact(jsl-1,njsc(ji))kfact_root(ji,jsl,ins)) / deux
4868
4869	IF (ok_freeze_cwrr) THEN
4870	IF (temp_hydro(ji, jsl) .LT. ZeroCelsius) THEN
4871	k_m = k(ji,jsl)
4872	ENDIF
4873	ENDIF
4874
4875	!! We compute the mean rate at which water actually infiltrate:
4876	! Subgrid: Exponential distribution of k around k_m, but average p directly used
4877	! See d'Orgeval 2006, p 78, but it's not fully clear to me (AD16***)
4878	infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m))
4879
4880	!! From which we deduce the time it takes to fill up the layer or to end the time step...
4881	wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,jsl,ins)) * (dz(jsl) + dz(jsl+1)) / deux, zero)
4882	IF ( infilt_tmp(ji) > min_sechiba) THEN
4883	dt_inf(ji) = MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
4884	! The water infiltration TIME has to limited by what is still available for infiltration.
4885	IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji)-infilt_tot(ji) ) THEN
4886	dt_inf(ji) = MAX(flux_infilt(ji)-infilt_tot(ji),zero)/infilt_tmp(ji)
4887	ENDIF
4888	ELSE
4889	dt_inf(ji) = dt_tmp(ji)
4890	ENDIF
4891
4892	!! The water enters in the layer
4893	wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
4894	! bviously the moisture content
4895	mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
4896	& wat_inf(ji) * deux / (dz(jsl) + dz(jsl+1))
4897	! the time remaining before the next time step
4898	dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
4899	! and finally the infilt_tot (which is just used to check if there is a problem, below)
4900	infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
4901	ENDDO
4902	ENDDO
4903
4904	!! 2.3 Resulting infiltration and surface runoff
4905	ru_infilt(:,ins) = flux_infilt(:) - infilt_tot(:)
4906	qinfilt_ns(:,ins) = infilt_tot(:)
4907
4908	!! 3. For water conservation check: we calculate the total SM at the beginning of the routine
4909	!! and export the difference with the flux
4910	IF (check_cwrr) THEN
4911	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
4912	DO jsl = 2,nslm-1
4913	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
4914	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
4915	ENDDO
4916	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
4917	! Normally, tcmf=tmci+infilt_tot
4918	check(:,ins) = tmcf(:)-(tmci(:)+infilt_tot(:))
4919	ENDIF
4920
4921	!! 5. Local verification
4922	DO ji = 1, kjpindex
4923	IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji) + min_sechiba) THEN
4924	WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
4925	WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
4926	CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
4927	ENDIF
4928	ENDDO
4929
4930	END SUBROUTINE hydrol_soil_infilt
4931
4932
4933	!! ================================================================================================================================
4934	!! SUBROUTINE : hydrol_soil_smooth_under_mcr
4935	!!
4936	!>\BRIEF : Modifies the soil moisture profile to avoid under-residual values,
4937	!! then diagnoses the points where such "excess" values remain.
4938	!!
4939	!! DESCRIPTION :
4940	!! The "excesses" under-residual are corrected from top to bottom, by transfer of excesses
4941	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
4942	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
4943	!! and the remaining "excess" is necessarily concentrated in the top layer.
4944	!! This allowing diagnosing the flag is_under_mcr.
4945	!! Eventually, the remaining "excess" is split over the entire profile
4946	!! 1. We calculate the total SM at the beginning of the routine
4947	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
4948	!! Note that we check that mc > min_sechiba in hydrol_soil
4949	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
4950	!! and export the difference with the flux
4951	!!
4952	!! RECENT CHANGE(S) : 2016 by A. Ducharne
4953	!!
4954	!! MAIN OUTPUT VARIABLE(S) :
4955	!!
4956	!! REFERENCE(S) :
4957	!!
4958	!! FLOWCHART : None
4959	!! \n
4960	!_ ================================================================================================================================
4961	!_ hydrol_soil_smooth_under_mcr
4962
4963	SUBROUTINE hydrol_soil_smooth_under_mcr(kjpindex, ins, njsc, is_under_mcr, check)
4964
4965	!- arguments
4966
4967	!! 0. Variable and parameter declaration
4968
4969	!! 0.1 Input variables
4970
4971	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
4972	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
4973	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
4974	!! (1-nscm, unitless)
4975
4976	!! 0.2 Output variables
4977
4978	LOGICAL, DIMENSION(kjpindex,nstm), INTENT(out) :: is_under_mcr !! Flag diagnosing under residual soil moisture
4979	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
4980
4981	!! 0.3 Modified variables
4982
4983	!! 0.4 Local variables
4984
4985	INTEGER(i_std) :: ji,jsl
4986	REAL(r_std) :: excess
4987	REAL(r_std), DIMENSION(kjpindex) :: excessji
4988	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
4989	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
4990
4991	!_ ================================================================================================================================
4992
4993	!! 1. We calculate the total SM at the beginning of the routine
4994	IF (check_cwrr) THEN
4995	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
4996	DO jsl = 2,nslm-1
4997	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
4998	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
4999	ENDDO
5000	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5001	ENDIF
5002
5003	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
5004
5005	! 2.1 smoothing from top to bottom
5006	DO jsl = 1,nslm-2
5007	DO ji=1, kjpindex
5008	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
5009	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5010	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
5011	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
5012	ENDDO
5013	ENDDO
5014
5015	jsl = nslm-1
5016	DO ji=1, kjpindex
5017	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
5018	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5019	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
5020	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
5021	ENDDO
5022
5023	jsl = nslm
5024	DO ji=1, kjpindex
5025	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
5026	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5027	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
5028	& dz(jsl)/(dz(jsl-1)+dz(jsl))
5029	ENDDO
5030
5031	! 2.2 smoothing from bottom to top
5032	DO jsl = nslm-1,2,-1
5033	DO ji=1, kjpindex
5034	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
5035	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5036	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
5037	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
5038	ENDDO
5039	ENDDO
5040
5041	! 2.3 diagnoses is_under_mcr(ji), and updates the entire profile
5042	! excess > 0
5043	DO ji=1, kjpindex
5044	excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(njsc(ji))-mc(ji,1,ins),zero)
5045	ENDDO
5046	DO ji=1, kjpindex
5047	mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji) ! then mc(1)=mcr
5048	is_under_mcr(ji,ins) = (excessji(ji) .GT. min_sechiba)
5049	ENDDO
5050
5051	! 2.4 The amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
5052	! -excess(ji) * dz(2) / deux donne le deficit total, negatif, en mm
5053	! diviser par la profondeur totale en mm donne des delta_mc identiques en chaque couche, en mm
5054	! retransformes en delta_mm par couche selon les bonnes eqs (eqs_hydrol.pdf, Eqs 13-15), puis sommes
5055	! retourne bien le deficit total en mm
5056	DO jsl = 1, nslm
5057	DO ji=1, kjpindex
5058	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2) / (deux * zmaxh*mille)
5059	ENDDO
5060	ENDDO
5061	! This can lead to mc(jsl) < mcr depending on the value of excess,
5062	! but this is no major pb for the diffusion
5063	! Yet, we need to prevent evaporation if is_under_mcr
5064
5065	!! Note that we check that mc > min_sechiba in hydrol_soil
5066
5067	! We just make sure that mc remains at 0 where soiltile=0
5068	DO jsl = 1, nslm
5069	DO ji=1, kjpindex
5070	mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
5071	ENDDO
5072	ENDDO
5073
5074	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
5075	!! and export the difference with the flux
5076	IF (check_cwrr) THEN
5077	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5078	DO jsl = 2,nslm-1
5079	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5080	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5081	ENDDO
5082	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5083	! Normally, tcmf=tmci since we just redistribute the deficit
5084	check(:,ins) = tmcf(:)-tmci(:)
5085	ENDIF
5086
5087	END SUBROUTINE hydrol_soil_smooth_under_mcr
5088
5089
5090	!! ================================================================================================================================
5091	!! SUBROUTINE : hydrol_soil_smooth_over_mcs
5092	!!
5093	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
5094	!! by putting the excess in ru_ns
5095	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
5096	!!
5097	!! DESCRIPTION :
5098	!! The "excesses" over-saturation are corrected from top to bottom, by transfer of excesses
5099	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
5100	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
5101	!! and the remaining "excess" is necessarily concentrated in the top layer.
5102	!! Eventually, the remaining "excess" creates rudr_corr, to be added to ru_ns or dr_ns
5103	!! 1. We calculate the total SM at the beginning of the routine
5104	!! 2. In case of over-saturation we put the water where it is possible by smoothing
5105	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
5106	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
5107	!! and export the difference with the flux
5108	!!
5109	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5110	!!
5111	!! MAIN OUTPUT VARIABLE(S) :
5112	!!
5113	!! REFERENCE(S) :
5114	!!
5115	!! FLOWCHART : None
5116	!! \n
5117	!_ ================================================================================================================================
5118	!_ hydrol_soil_smooth_over_mcs
5119
5120	SUBROUTINE hydrol_soil_smooth_over_mcs(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
5121
5122	!- arguments
5123
5124	!! 0. Variable and parameter declaration
5125
5126	!! 0.1 Input variables
5127
5128	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5129	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
5130	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
5131	!! (1-nscm, unitless)
5132
5133	!! 0.2 Output variables
5134
5135	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
5136	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
5137
5138	!! 0.3 Modified variables
5139	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
5140
5141	!! 0.4 Local variables
5142
5143	INTEGER(i_std) :: ji,jsl
5144	REAL(r_std) :: excess
5145	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
5146	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
5147
5148	!_ ================================================================================================================================
5149
5150	!! 1. We calculate the total SM at the beginning of the routine
5151	IF (check_cwrr) THEN
5152	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5153	DO jsl = 2,nslm-1
5154	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5155	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5156	ENDDO
5157	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5158	ENDIF
5159
5160	!! 2. In case of over-saturation we put the water where it is possible by smoothing
5161
5162	! 2.1 smoothing from top to bottom
5163	DO jsl = 1, nslm-2
5164	DO ji=1, kjpindex
5165	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
5166	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5167	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
5168	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
5169	ENDDO
5170	ENDDO
5171
5172	jsl = nslm-1
5173	DO ji=1, kjpindex
5174	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
5175	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5176	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
5177	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
5178	ENDDO
5179
5180	jsl = nslm
5181	DO ji=1, kjpindex
5182	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
5183	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5184	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
5185	& dz(jsl)/(dz(jsl-1)+dz(jsl))
5186	ENDDO
5187
5188	! 2.2 smoothing from bottom to top, leading to keep most of the excess in the soil column
5189	DO jsl = nslm-1,2,-1
5190	DO ji=1, kjpindex
5191	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
5192	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5193	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
5194	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
5195	ENDDO
5196	ENDDO
5197
5198	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
5199
5200	DO ji=1, kjpindex
5201	excess = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(njsc(ji)),zero)
5202	mc(ji,1,ins) = mc(ji,1,ins) - excess ! then mc(1)=mcs
5203	rudr_corr(ji,ins) = rudr_corr(ji,ins) + excess * dz(2) / deux
5204	is_over_mcs(ji) = .FALSE.
5205	ENDDO
5206
5207	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
5208	!! and export the difference with the flux
5209
5210	IF (check_cwrr) THEN
5211	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5212	DO jsl = 2,nslm-1
5213	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5214	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5215	ENDDO
5216	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5217	! Normally, tcmf=tmci-rudr_corr
5218	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
5219	ENDIF
5220
5221	END SUBROUTINE hydrol_soil_smooth_over_mcs
5222
5223	!! ================================================================================================================================
5224	!! SUBROUTINE : hydrol_soil_smooth_over_mcs2
5225	!!
5226	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
5227	!! by putting the excess in ru_ns
5228	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
5229	!!
5230	!! DESCRIPTION :
5231	!! The "excesses" over-saturation are corrected, by directly discarding the excess as rudr_corr,
5232	!! to be added to ru_ns or dr_nsrunoff (via rudr_corr).
5233	!! Therefore, there is no more smoothing, and this helps preventing the saturation of too many layers,
5234	!! which leads to numerical errors with tridiag.
5235	!! 1. We calculate the total SM at the beginning of the routine
5236	!! 2. In case of over-saturation, we directly eliminate the excess via rudr_corr
5237	!! The calculation of the adjustement flux needs to account for nodes n-1 and n+1.
5238	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
5239	!! and export the difference with the flux
5240	!!
5241	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5242	!!
5243	!! MAIN OUTPUT VARIABLE(S) :
5244	!!
5245	!! REFERENCE(S) :
5246	!!
5247	!! FLOWCHART : None
5248	!! \n
5249	!_ ================================================================================================================================
5250	!_ hydrol_soil_smooth_over_mcs2
5251
5252	SUBROUTINE hydrol_soil_smooth_over_mcs2(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
5253
5254	!- arguments
5255
5256	!! 0. Variable and parameter declaration
5257
5258	!! 0.1 Input variables
5259
5260	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5261	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
5262	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
5263	!! (1-nscm, unitless)
5264
5265	!! 0.2 Output variables
5266
5267	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
5268	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
5269
5270	!! 0.3 Modified variables
5271	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
5272
5273	!! 0.4 Local variables
5274
5275	INTEGER(i_std) :: ji,jsl
5276	REAL(r_std), DIMENSION(kjpindex,nslm) :: excess
5277	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
5278	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
5279
5280	!_ ================================================================================================================================
5281	!-
5282
5283	!! 1. We calculate the total SM at the beginning of the routine
5284	IF (check_cwrr) THEN
5285	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5286	DO jsl = 2,nslm-1
5287	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5288	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5289	ENDDO
5290	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5291	ENDIF
5292
5293	!! 2. In case of over-saturation, we don't do any smoothing,
5294	!! but directly eliminate the excess as runoff (via rudr_corr)
5295	! we correct the calculation of the adjustement flux, which needs to account for nodes n-1 and n+1
5296	! for the calculation to remain simple and accurate, we directly drain all the oversaturated mc,
5297	! without transfering to lower layers
5298
5299	!! 2.1 thresholding from top to bottom, with excess defined along jsl
5300	DO jsl = 1, nslm
5301	DO ji=1, kjpindex
5302	excess(ji,jsl) = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero) ! >=0
5303	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess(ji,jsl) ! here mc either does not change or decreases
5304	ENDDO
5305	ENDDO
5306
5307	!! 2.2 To ensure conservation, this needs to be balanced by additional drainage (in kg/m2/dt)
5308	DO ji = 1, kjpindex
5309	rudr_corr(ji,ins) = dz(2) * ( trois*excess(ji,1) + excess(ji,2) )/huit ! top layer = initialisation
5310	ENDDO
5311	DO jsl = 2,nslm-1 ! intermediate layers
5312	DO ji = 1, kjpindex
5313	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(jsl) &
5314	& * (trois*excess(ji,jsl)+excess(ji,jsl-1))/huit &
5315	& + dz(jsl+1) * (trois*excess(ji,jsl)+excess(ji,jsl+1))/huit
5316	ENDDO
5317	ENDDO
5318	DO ji = 1, kjpindex
5319	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(nslm) & ! bottom layer
5320	& * (trois * excess(ji,nslm) + excess(ji,nslm-1))/huit
5321	is_over_mcs(ji) = .FALSE.
5322	END DO
5323
5324	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
5325	!! and export the difference with the flux
5326
5327	IF (check_cwrr) THEN
5328	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5329	DO jsl = 2,nslm-1
5330	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5331	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5332	ENDDO
5333	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5334	! Normally, tcmf=tmci-rudr_corr
5335	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
5336	ENDIF
5337
5338	END SUBROUTINE hydrol_soil_smooth_over_mcs2
5339
5340
5341	!! ================================================================================================================================
5342	!! SUBROUTINE : hydrol_diag_soil_flux
5343	!!
5344	!>\BRIEF : This subroutine diagnoses the vertical liquid water fluxes between the
5345	!! different soil layers, based on each layer water budget. It also checks the
5346	!! corresponding water conservation (during redistribution).
5347	!!
5348	!! DESCRIPTION :
5349	!! 1. Initialize qflux from the bottom, with dr_ns
5350	!! 2. Between layer nslm and nslm-1, by means of water budget knowing mc changes and flux at the lowest interface
5351	!! 3. We go up, and deduct qflux(1:nslm-2), still by means of water budget
5352	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface should equal -flux_top
5353	!!
5354	!! RECENT CHANGE(S) : 2016 by A. Ducharne to fit hydrol_soil
5355	!!
5356	!! MAIN OUTPUT VARIABLE(S) :
5357	!!
5358	!! REFERENCE(S) :
5359	!!
5360	!! FLOWCHART : None
5361	!! \n
5362	!_ ================================================================================================================================
5363	!_ hydrol_diag_soil_flux
5364
5365	SUBROUTINE hydrol_diag_soil_flux(kjpindex,ins,mclint,flux_top)
5366	!
5367	!! 0. Variable and parameter declaration
5368
5369	!! 0.1 Input variables
5370
5371	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5372	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
5373	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mclint !! mc values at the beginning of the time step
5374	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flux_top !! Exfiltration (bare soil evaporation minus infiltration)
5375
5376	!! 0.2 Output variables
5377
5378	!! 0.3 Modified variables
5379
5380	!! 0.4 Local variables
5381	REAL(r_std), DIMENSION (kjpindex) :: check_temp !! Diagnosed flux at soil surface, should equal -flux_top
5382	INTEGER(i_std) :: jsl,ji
5383
5384	!_ ================================================================================================================================
5385
5386	!- Compute the diffusion flux at every level from bottom to top (using mcl,mclint, and sink values)
5387	DO ji = 1, kjpindex
5388
5389	!! 1. Initialize qflux_ns from the bottom, with dr_ns
5390	jsl = nslm
5391	qflux_ns(ji,jsl,ins) = dr_ns(ji,ins)
5392	!! 2. Between layer nslm and nslm-1, by means of water budget
5393	!! knowing mc changes and flux at the lowest interface
5394	! qflux_ns is downward
5395	jsl = nslm-1
5396	qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) &
5397	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
5398	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
5399	& * (dz(jsl+1)/huit) &
5400	& + rootsink(ji,jsl+1,ins)
5401	ENDDO
5402
5403	!! 3. We go up, and deduct qflux_ns(1:nslm-2), still by means of water budget
5404	! Here, qflux_ns(ji,1,ins) is the downward flux between the top soil layer and the 2nd one
5405	DO jsl = nslm-2,1,-1
5406	DO ji = 1, kjpindex
5407	qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) &
5408	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
5409	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
5410	& * (dz(jsl+1)/huit) &
5411	& + rootsink(ji,jsl+1,ins) &
5412	& + (dz(jsl+2)/huit) &
5413	& * (troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1) &
5414	& + mcl(ji,jsl+2,ins)-mclint(ji,jsl+2))
5415	END DO
5416	ENDDO
5417
5418	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface (check_temp)
5419	!! should equal -flux_top
5420	DO ji = 1, kjpindex
5421
5422	check_temp(ji) = qflux_ns(ji,1,ins) + (dz(2)/huit) &
5423	& * (trois* (mcl(ji,1,ins)-mclint(ji,1)) + (mcl(ji,2,ins)-mclint(ji,2))) &
5424	& + rootsink(ji,1,ins)
5425	! flux_top is positive when upward, while check_temp is positive when downward
5426	check_top_ns(ji,ins) = flux_top(ji)+check_temp(ji)
5427
5428	IF (ABS(check_top_ns(ji,ins))/dt_sechiba .GT. min_sechiba) THEN
5429	! Diagnosed (check_temp) and imposed (flux_top) differ by more than 1.e-8 mm/s
5430	WRITE(numout,*) 'Problem in the water balance, qflux_ns computation, surface fluxes', flux_top(ji),check_temp(ji)
5431	WRITE(numout,*) 'Diagnosed and imposed fluxes differ by more than 1.e-8 mm/s: ', check_top_ns(ji,ins)
5432	WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
5433	WRITE(numout,*) 'mclint', mclint(ji,:)
5434	WRITE(numout,*) 'mcl', mcl(ji,:,ins)
5435	WRITE (numout,*) 'rootsink', rootsink(ji,1,ins)
5436	CALL ipslerr_p(1, 'hydrol_diag_soil_flux', 'NOTE:',&
5437	& 'Problem in the water balance, qflux_ns computation','')
5438	ENDIF
5439	ENDDO
5440
5441	END SUBROUTINE hydrol_diag_soil_flux
5442
5443	!! ================================================================================================================================
5444	!! SUBROUTINE : hydrol_soil_tridiag
5445	!!
5446	!>\BRIEF This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix.
5447	!!
5448	!! DESCRIPTION : It is only applied in the grid-cells where resolv(ji)=TRUE
5449	!!
5450	!! RECENT CHANGE(S) : None
5451	!!
5452	!! MAIN OUTPUT VARIABLE(S) : mcl (global module variable)
5453	!!
5454	!! REFERENCE(S) :
5455	!!
5456	!! FLOWCHART : None
5457	!! \n
5458	!_ ================================================================================================================================
5459	!_ hydrol_soil_tridiag
5460
5461	SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
5462
5463	!- arguments
5464
5465	!! 0. Variable and parameter declaration
5466
5467	!! 0.1 Input variables
5468
5469	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5470	INTEGER(i_std), INTENT(in) :: ins !! number of soil type
5471
5472	!! 0.2 Output variables
5473
5474	!! 0.3 Modified variables
5475
5476	!! 0.4 Local variables
5477
5478	INTEGER(i_std) :: ji,jsl
5479	REAL(r_std), DIMENSION(kjpindex) :: bet
5480	REAL(r_std), DIMENSION(kjpindex,nslm) :: gam
5481
5482	!_ ================================================================================================================================
5483	DO ji = 1, kjpindex
5484
5485	IF (resolv(ji)) THEN
5486	bet(ji) = tmat(ji,1,2)
5487	mcl(ji,1,ins) = rhs(ji,1)/bet(ji)
5488	ENDIF
5489	ENDDO
5490
5491	DO jsl = 2,nslm
5492	DO ji = 1, kjpindex
5493
5494	IF (resolv(ji)) THEN
5495
5496	gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
5497	bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
5498	mcl(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mcl(ji,jsl-1,ins))/bet(ji)
5499	ENDIF
5500
5501	ENDDO
5502	ENDDO
5503
5504	DO ji = 1, kjpindex
5505	IF (resolv(ji)) THEN
5506	DO jsl = nslm-1,1,-1
5507	mcl(ji,jsl,ins) = mcl(ji,jsl,ins) - gam(ji,jsl+1)*mcl(ji,jsl+1,ins)
5508	ENDDO
5509	ENDIF
5510	ENDDO
5511
5512	END SUBROUTINE hydrol_soil_tridiag
5513
5514
5515	!! ================================================================================================================================
5516	!! SUBROUTINE : hydrol_soil_coef
5517	!!
5518	!>\BRIEF Computes coef for the linearised hydraulic conductivity
5519	!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin.
5520	!!
5521	!! DESCRIPTION :
5522	!! First, we identify the interval i in which the current value of mc is located.
5523	!! Then, we give the values of the linearized parameters to compute
5524	!! conductivity and diffusivity as K=a*mc+b and d.
5525	!!
5526	!! RECENT CHANGE(S) : Addition of the dependence to profil_froz_hydro_ns
5527	!!
5528	!! MAIN OUTPUT VARIABLE(S) :
5529	!!
5530	!! REFERENCE(S) :
5531	!!
5532	!! FLOWCHART : None
5533	!! \n
5534	!_ ================================================================================================================================
5535	!_ hydrol_soil_coef
5536
5537	SUBROUTINE hydrol_soil_coef(kjpindex,ins,njsc)
5538
5539	IMPLICIT NONE
5540	!
5541	!! 0. Variable and parameter declaration
5542
5543	!! 0.1 Input variables
5544
5545	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5546	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
5547	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
5548
5549	!! 0.2 Output variables
5550
5551	!! 0.3 Modified variables
5552
5553	!! 0.4 Local variables
5554
5555	INTEGER(i_std) :: jsl,ji,i
5556	REAL(r_std) :: mc_ratio
5557	REAL(r_std) :: mc_used !! Used liquid water content
5558	REAL(r_std) :: x,m
5559
5560	!_ ================================================================================================================================
5561
5562	IF (ok_freeze_cwrr) THEN
5563
5564	! Calculation of liquid and frozen saturation degrees with respect to residual
5565	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
5566	! 1-x=frozen saturation degree/residual=(mcf-mcr)/(mcs-mcr) (=profil_froz_hydro)
5567
5568	DO jsl=1,nslm
5569	DO ji=1,kjpindex
5570
5571	x = 1._r_std - profil_froz_hydro_ns(ji, jsl,ins)
5572
5573	! mc_used is used in the calculation of hydrological properties
5574	! It corresponds to a liquid mc, but the expression is different from mcl in hydrol_soil,
5575	! to ensure that we get the a, b, d of the first bin when mcl<mcr
5576	mc_used = mcr(njsc(ji))+x*MAX((mc(ji,jsl, ins)-mcr(njsc(ji))),zero)
5577	!
5578	! calcul de k based on mc_liq
5579	!
5580	i= MAX(imin, MIN(imax-1, INT(imin +(imax-imin)*(mc_used-mcr(njsc(ji)))/(mcs(njsc(ji))-mcr(njsc(ji))))))
5581	a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
5582	b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
5583	d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
5584	k(ji,jsl) = MAX(k_lin(imin+1,jsl,njsc(ji)), &
5585	a_lin(i,jsl,njsc(ji)) * mc_used + b_lin(i,jsl,njsc(ji))) ! in mm/d
5586	ENDDO ! loop on grid
5587	ENDDO
5588
5589	ELSE
5590
5591	! .NOT. ok_freeze_cwrr
5592	DO jsl=1,nslm
5593	DO ji=1,kjpindex
5594
5595	! it is impossible to consider a mc<mcr for the binning
5596	mc_ratio = MAX(mc(ji,jsl,ins)-mcr(njsc(ji)), zero)/(mcs(njsc(ji))-mcr(njsc(ji)))
5597
5598	i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
5599	a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
5600	b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
5601	d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
5602	k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,njsc(ji)), &
5603	a_lin(i,jsl,njsc(ji)) * mc(ji,jsl,ins) + b_lin(i,jsl,njsc(ji))) ! in mm/d
5604	END DO
5605	END DO
5606	ENDIF
5607
5608	END SUBROUTINE hydrol_soil_coef
5609
5610	!! ================================================================================================================================
5611	!! SUBROUTINE : hydrol_soil_froz
5612	!!
5613	!>\BRIEF Computes profil_froz_hydro_ns, the fraction of frozen water in the soil layers.
5614	!!
5615	!! DESCRIPTION :
5616	!!
5617	!! RECENT CHANGE(S) : Created by A. Ducharne in 2016.
5618	!!
5619	!! MAIN OUTPUT VARIABLE(S) : profil_froz_hydro_ns
5620	!!
5621	!! REFERENCE(S) :
5622	!!
5623	!! FLOWCHART : None
5624	!! \n
5625	!_ ================================================================================================================================
5626	!_ hydrol_soil_froz
5627
5628	SUBROUTINE hydrol_soil_froz(kjpindex,ins,njsc)
5629
5630	IMPLICIT NONE
5631	!
5632	!! 0. Variable and parameter declaration
5633
5634	!! 0.1 Input variables
5635
5636	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5637	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
5638	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
5639
5640	!! 0.2 Output variables
5641
5642	!! 0.3 Modified variables
5643
5644	!! 0.4 Local variables
5645
5646	INTEGER(i_std) :: jsl,ji,i
5647	REAL(r_std) :: x,m
5648	REAL(r_std) :: denom
5649	REAL(r_std),DIMENSION (kjpindex) :: froz_frac_moy
5650	REAL(r_std),DIMENSION (kjpindex) :: smtot_moy
5651	REAL(r_std),DIMENSION (kjpindex,nslm) :: mc_ns
5652
5653	!_ ================================================================================================================================
5654
5655	! ONLY FOR THE (ok_freeze_cwrr) CASE
5656
5657	! Calculation of liquid and frozen saturation degrees above residual moisture
5658	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
5659	! 1-x=frozen saturation degree/residual=(mcf-mcr)/(mcs-mcr) (=profil_froz_hydro)
5660	! It's important for the good work of the water diffusion scheme (tridiag) that the total
5661	! liquid water also includes mcr, so mcl > 0 even when x=0
5662
5663	DO jsl=1,nslm
5664	DO ji=1,kjpindex
5665	! Van Genuchten parameter for thermodynamical calculation
5666	m = 1. -1./nvan(njsc(ji))
5667
5668	IF ((.NOT. ok_thermodynamical_freezing).OR.(mc(ji,jsl, ins).LT.(mcr(njsc(ji))+min_sechiba))) THEN
5669	! Linear soil freezing or soil moisture below residual
5670	IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
5671	x=1._r_std
5672	ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
5673	(temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
5674	x=(temp_hydro(ji, jsl)-(ZeroCelsius-fr_dT/2.))/fr_dT
5675	ELSE
5676	x=0._r_std
5677	ENDIF
5678	ELSE IF (ok_thermodynamical_freezing) THEN
5679	! Thermodynamical soil freezing
5680	IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
5681	x=1._r_std
5682	ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
5683	(temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
5684	! Factor 2.2 from the PhD of Isabelle Gouttevin
5685	x=MIN(((mcs(njsc(ji))-mcr(njsc(ji))) &
5686	((2.21000.avan(njsc(ji))(ZeroCelsius+fr_dT/2.-temp_hydro(ji, jsl)) &
5687	lhf/ZeroCelsius/10.)nvan(njsc(ji))+1.)*(-m)) / &
5688	(mc(ji,jsl, ins)-mcr(njsc(ji))),1._r_std)
5689	ELSE
5690	x=0._r_std
5691	ENDIF
5692	ENDIF
5693
5694	profil_froz_hydro_ns(ji,jsl,ins) = 1._r_std-x
5695
5696	mc_ns(ji,jsl)=mc(ji,jsl,ins)/mcs(njsc(ji))
5697
5698	ENDDO ! loop on grid
5699	ENDDO
5700
5701	! Apply correction on the frozen fraction
5702	froz_frac_moy(:)=zero
5703	denom=zero
5704	DO jsl=1,nslm
5705	froz_frac_moy(:)=froz_frac_moy(:)+dh(jsl)*profil_froz_hydro_ns(:,jsl,ins)
5706	denom=denom+dh(jsl)
5707	ENDDO
5708	froz_frac_moy(:)=froz_frac_moy(:)/denom
5709
5710	smtot_moy(:)=zero
5711	denom=zero
5712	DO jsl=1,nslm-1
5713	smtot_moy(:)=smtot_moy(:)+dh(jsl)*mc_ns(:,jsl)
5714	denom=denom+dh(jsl)
5715	ENDDO
5716	smtot_moy(:)=smtot_moy(:)/denom
5717
5718	DO jsl=1,nslm
5719	profil_froz_hydro_ns(:,jsl,ins)=MIN(profil_froz_hydro_ns(:,jsl,ins)* &
5720	(froz_frac_moy(:)*froz_frac_corr) &
5721	(smtot_moy(:)**smtot_corr), max_froz_hydro)
5722	ENDDO
5723
5724	END SUBROUTINE hydrol_soil_froz
5725
5726
5727	!! ================================================================================================================================
5728	!! SUBROUTINE : hydrol_soil_setup
5729	!!
5730	!>\BRIEF This subroutine computes the matrix coef.
5731	!!
5732	!! DESCRIPTION : None
5733	!!
5734	!! RECENT CHANGE(S) : None
5735	!!
5736	!! MAIN OUTPUT VARIABLE(S) : matrix coef
5737	!!
5738	!! REFERENCE(S) :
5739	!!
5740	!! FLOWCHART : None
5741	!! \n
5742	!_ ================================================================================================================================
5743
5744	SUBROUTINE hydrol_soil_setup(kjpindex,ins)
5745
5746
5747	IMPLICIT NONE
5748	!
5749	!! 0. Variable and parameter declaration
5750
5751	!! 0.1 Input variables
5752	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5753	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
5754
5755	!! 0.2 Output variables
5756
5757	!! 0.3 Modified variables
5758
5759	!! 0.4 Local variables
5760
5761	INTEGER(i_std) :: jsl,ji
5762	REAL(r_std) :: temp3, temp4
5763
5764	!_ ================================================================================================================================
5765	!-we compute tridiag matrix coefficients (LEFT and RIGHT)
5766	! of the system to solve [LEFT]mc_{t+1}=[RIGHT]mc{t}+[add terms]:
5767	! e(nslm),f(nslm),g1(nslm) for the [left] vector
5768	! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
5769
5770	! w_time=1 (in constantes_soil) indicates implicit computation for diffusion
5771	temp3 = w_time*(dt_sechiba/one_day)/deux
5772	temp4 = (un-w_time)*(dt_sechiba/one_day)/deux
5773
5774	! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
5775
5776	!- coefficient for first layer
5777	DO ji = 1, kjpindex
5778	e(ji,1) = zero
5779	f(ji,1) = trois * dz(2)/huit + temp3 &
5780	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
5781	g1(ji,1) = dz(2)/(huit) - temp3 &
5782	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
5783	ep(ji,1) = zero
5784	fp(ji,1) = trois * dz(2)/huit - temp4 &
5785	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
5786	gp(ji,1) = dz(2)/(huit) + temp4 &
5787	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
5788	ENDDO
5789
5790	!- coefficient for medium layers
5791
5792	DO jsl = 2, nslm-1
5793	DO ji = 1, kjpindex
5794	e(ji,jsl) = dz(jsl)/(huit) - temp3 &
5795	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
5796
5797	f(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit + temp3 &
5798	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
5799	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
5800
5801	g1(ji,jsl) = dz(jsl+1)/(huit) - temp3 &
5802	& * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
5803
5804	ep(ji,jsl) = dz(jsl)/(huit) + temp4 &
5805	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
5806
5807	fp(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit - temp4 &
5808	& * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
5809	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
5810
5811	gp(ji,jsl) = dz(jsl+1)/(huit) + temp4 &
5812	& *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
5813	ENDDO
5814	ENDDO
5815
5816	!- coefficient for last layer
5817	DO ji = 1, kjpindex
5818	e(ji,nslm) = dz(nslm)/(huit) - temp3 &
5819	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
5820	f(ji,nslm) = trois * dz(nslm)/huit + temp3 &
5821	& * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm)) &
5822	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
5823	g1(ji,nslm) = zero
5824	ep(ji,nslm) = dz(nslm)/(huit) + temp4 &
5825	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
5826	fp(ji,nslm) = trois * dz(nslm)/huit - temp4 &
5827	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm)) &
5828	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
5829	gp(ji,nslm) = zero
5830	ENDDO
5831
5832	END SUBROUTINE hydrol_soil_setup
5833
5834
5835	!! ================================================================================================================================
5836	!! SUBROUTINE : hydrol_split_soil
5837	!!
5838	!>\BRIEF Splits 2d variables into 3d variables, per soiltile (_ns suffix), at the beginning of hydrol
5839	!! At this stage, the forcing fluxes to hydrol are transformed from grid-cell averages
5840	!! to mean fluxes over vegtot=sum(soiltile)
5841	!!
5842	!! DESCRIPTION :
5843	!! 1. Split 2d variables into 3d variables, per soiltile
5844	!! 1.1 Throughfall
5845	!! 1.2 Bare soil evaporation
5846	!! 1.2.1 vevapnu_old
5847	!! 1.2.2 ae_ns new
5848	!! 1.3 transpiration
5849	!! 1.4 root sink
5850	!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes
5851	!! 2.1 precisol
5852	!! 2.2 ae_ns and evapnu
5853	!! 2.3 transpiration
5854	!! 2.4 root sink
5855	!!
5856	!! RECENT CHANGE(S) : 2016 by A. Ducharne to match the simplification of hydrol_soil
5857	!!
5858	!! MAIN OUTPUT VARIABLE(S) :
5859	!!
5860	!! REFERENCE(S) :
5861	!!
5862	!! FLOWCHART : None
5863	!! \n
5864	!_ ================================================================================================================================
5865	!_ hydrol_split_soil
5866
5867	SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, evap_bare_lim, tot_bare_soil, e_frac)
5868	!
5869	! interface description
5870
5871	!! 0. Variable and parameter declaration
5872
5873	!! 0.1 Input variables
5874
5875	INTEGER(i_std), INTENT(in) :: kjpindex
5876	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget_max !! max Vegetation map
5877	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soiltile within vegtot (0-1, unitless)
5878	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: vevapnu !! Bare soil evaporation
5879	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
5880	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: humrel !! Relative humidity
5881	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evap_bare_lim !!
5882	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
5883	REAL(r_std), DIMENSION (kjpindex,nvm,nbdl,nstm), OPTIONAL, INTENT(in) :: e_frac !! Relative humidity per layer
5884
5885	!! 0.4 Local variables
5886
5887	INTEGER(i_std) :: ji, jv, jsl, jst
5888	REAL(r_std), DIMENSION (kjpindex) :: vevapnu_old
5889	REAL(r_std), DIMENSION (kjpindex) :: tmp_check1
5890	REAL(r_std), DIMENSION (kjpindex) :: tmp_check2
5891	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmp_check3
5892
5893	!_ ================================================================================================================================
5894
5895	!! 1. Split 2d variables into 3d variables, per soiltile
5896
5897	! Reminders:
5898	! corr_veg_soil(:,nvm,nstm) = PFT fraction per soiltile in each grid-cell
5899	! corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
5900	! soiltile(:,nstm) = fraction of vegtot covered by each soiltile (0-1, unitless)
5901	! vegtot(:) = total fraction of grid-cell covered by PFTs (fraction with bare soil + vegetation)
5902	! veget_max(:,nvm) = PFT fractions of vegtot+frac_nobio
5903	! veget(:,nvm) = fractions (of vegtot+frac_nobio) covered by vegetation in each PFT
5904	! BUT veget(:,1)=veget_max(:,1)
5905	! frac_bare(:,nvm) = fraction (of veget_max) with bare soil in each PFT
5906	! tot_bare_soil(:) = fraction of grid mesh covered by all bare soil (=SUM(frac_bare*veget_max))
5907	! frac_bare_ns(:,nstm) = evaporating bare soil fraction (of vegtot) per soiltile (defined in hydrol_vegupd)
5908
5909	!! 1.1 Throughfall
5910	! Transformation from precisol (flux from PFT jv in m2 of grid-mesh)
5911	! to precisol_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
5912	precisol_ns(:,:)=zero
5913	DO jv=1,nvm
5914	DO ji=1,kjpindex
5915	jst=pref_soil_veg(jv)
5916	IF((veget_max(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
5917	precisol_ns(ji,jst) = precisol_ns(ji,jst) + &
5918	precisol(ji,jv) / (soiltile(ji,jst)*vegtot(ji))
5919	ENDIF
5920	END DO
5921	END DO
5922
5923	!! 1.2 Bare soil evaporation
5924	!! 1.2.1 vevapnu_old
5925	! AD16*** vevapnu_old ne sert que pour le split suivant de vevapnu (issu de enerbil) en ae_ns pour hydrol_soil
5926	! mais il ne semble y avoir aucune bonne raison de contraindre ae_ns en fonction de vevapnu_old
5927	! vevapnu_old(:)=zero
5928	! DO jst=1,nstm
5929	! DO ji=1,kjpindex
5930	! IF ( vegtot(ji) .GT. min_sechiba) THEN
5931	! vevapnu_old(ji)=vevapnu_old(ji)+ &
5932	! & ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
5933	! ENDIF
5934	! END DO
5935	! END DO
5936
5937	!! 1.2.2 ae_ns new
5938	! AD16*** les lignes ci-dessous sont excessivement compliquees et ne garantissent pas que ae_ns = 0 si evap_bare_lim=0
5939	! c'est notamment le cas pour les 3emes et 6emes conditions
5940	! DO jst=1,nstm
5941	! DO ji=1,kjpindex
5942	! IF (vevapnu_old(ji).GT.min_sechiba) THEN
5943	! IF(evap_bare_lim(ji).GT.min_sechiba) THEN
5944	! ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
5945	! ELSE
5946	! IF(vevapnu_old(ji).GT.min_sechiba) THEN
5947	! ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji) ! 3Ãšme condition
5948	! ELSE
5949	! ae_ns(ji,jst)=zero
5950	! ENDIF
5951	! ENDIF
5952	! ELSEIF(frac_bare_ns(ji,jst).GT.min_sechiba) THEN
5953	! IF(evap_bare_lim(ji).GT.min_sechiba) THEN
5954	! ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
5955	! ELSE
5956	! IF(tot_bare_soil(ji).GT.min_sechiba) THEN
5957	! ae_ns(ji,jst) = vevapnu(ji) * frac_bare_ns(ji,jst)/tot_bare_soil(ji) ! 6Ãšme condition
5958	! ELSE
5959	! ae_ns(ji,jst) = zero
5960	! ENDIF
5961	! ENDIF
5962	! ENDIF
5963	! END DO
5964	! END DO
5965	! ADNV27072016: we believe the following block should be used (tests needed before committ, since AD16*** had pb with it)
5966	!!$ ! given the definition of evap_bare_lim, it leads to sum(ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji))=vevapnu(ji)
5967	ae_ns(:,:)=zero
5968	DO jst=1,nstm
5969	DO ji=1,kjpindex
5970	IF(evap_bare_lim(ji).GT.min_sechiba) THEN
5971	ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
5972	ELSE
5973	ae_ns(ji,jst) = zero
5974	ENDIF
5975	ENDDO
5976	ENDDO
5977
5978	!! 1.3 transpiration
5979	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
5980	! to tr_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
5981	! To do next: simplify the use of humrelv(ji,jv,jst) /humrel(ji,jv), since both are equal
5982	tr_ns(:,:)=zero
5983	DO jv=1,nvm
5984	jst=pref_soil_veg(jv)
5985	DO ji=1,kjpindex
5986	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba))THEN
5987	tr_ns(ji,jst)= tr_ns(ji,jst) &
5988	+ transpir(ji,jv) * (humrelv(ji,jv,jst) / humrel(ji,jv)) &
5989	/ (soiltile(ji,jst)*vegtot(ji))
5990
5991	ENDIF
5992	END DO
5993	END DO
5994
5995	!! 1.4 root sink
5996	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
5997	! to root_sink (flux from contributing PFTs and soil layer with another unit, in m2 of soiltile)
5998	rootsink(:,:,:)=zero
5999	IF(ok_hydrol_arch)THEN
6000	DO jv = 1,nvm
6001	jst=pref_soil_veg(jv) ! OBS jst = 1,nstm
6002	DO jsl=1,nslm
6003	DO ji=1,kjpindex
6004	IF (humrel(ji,jv).GT.min_sechiba .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
6005	rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
6006	+ (transpir(ji,jv)*e_frac(ji,jv,jsl,jst)) &
6007	/ (soiltile(ji,jst)*vegtot(ji))
6008	END IF
6009	END DO
6010	END DO
6011	END DO
6012
6013	ELSE ! IF(ok_hydrol_arch)
6014
6015	DO jv=1,nvm
6016	jst=pref_soil_veg(jv)
6017	DO jsl=1,nslm
6018	DO ji=1,kjpindex
6019	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba)) THEN
6020	rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
6021	+ transpir(ji,jv) * (us(ji,jv,jst,jsl) / humrel(ji,jv)) &
6022	/ (soiltile(ji,jst)*vegtot(ji))
6023	! rootsink(ji,1,jst)=0 as us(ji,jv,jst,1)=0
6024	END IF
6025	END DO
6026	END DO
6027	END DO
6028	ENDIF
6029
6030
6031	END SUBROUTINE hydrol_split_soil
6032
6033
6034	!! ================================================================================================================================
6035	!! SUBROUTINE : hydrol_diag_soil
6036	!!
6037	!>\BRIEF Calculates diagnostic variables at the grid-cell scale
6038	!!
6039	!! DESCRIPTION :
6040	!! - 1. Apply mask_soiltile
6041	!! - 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
6042	!!
6043	!! RECENT CHANGE(S) : 2016 by A. Ducharne for the claculation of shumdiag_perma
6044	!!
6045	!! MAIN OUTPUT VARIABLE(S) :
6046	!!
6047	!! REFERENCE(S) :
6048	!!
6049	!! FLOWCHART : None
6050	!! \n
6051	!_ ================================================================================================================================
6052	!_ hydrol_diag_soil
6053
6054	SUBROUTINE hydrol_diag_soil (kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
6055	& evapot, vevapnu, returnflow, reinfiltration, irrigation, &
6056	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
6057	!
6058	! interface description
6059
6060	!! 0. Variable and parameter declaration
6061
6062	!! 0.1 Input variables
6063
6064	! input scalar
6065	INTEGER(i_std), INTENT(in) :: kjpindex
6066	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. vegetation type
6067	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
6068	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
6069	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !!
6070	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the deep reservoir
6071	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
6072	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Water from irrigation
6073	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !!
6074
6075	!! 0.2 Output variables
6076
6077	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of litter wetness
6078	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! complete runoff
6079	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
6080	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag !! relative soil moisture
6081	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
6082	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter cond.
6083	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
6084	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
6085	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
6086
6087	!! 0.3 Modified variables
6088
6089	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !!
6090
6091	!! 0.4 Local variables
6092
6093	INTEGER(i_std) :: ji, jv, jsl, jst, i, jd
6094	REAL(r_std), DIMENSION (kjpindex) :: mask_vegtot
6095	REAL(r_std) :: k_tmp, tmc_litter_ratio
6096
6097	!_ ================================================================================================================================
6098	!
6099	! Put the prognostics variables of soil to zero if soiltype is zero
6100
6101	!! 1. Apply mask_soiltile
6102
6103	DO jst=1,nstm
6104	DO ji=1,kjpindex
6105
6106	ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
6107	dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
6108	ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
6109	tmc(ji,jst) = tmc(ji,jst) * mask_soiltile(ji,jst)
6110
6111	DO jv=1,nvm
6112	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
6113	DO jsl=1,nslm
6114	us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl) * mask_soiltile(ji,jst)
6115	END DO
6116	END DO
6117
6118	DO jsl=1,nslm
6119	mc(ji,jsl,jst) = mc(ji,jsl,jst) * mask_soiltile(ji,jst)
6120	END DO
6121
6122	END DO
6123	END DO
6124
6125	runoff(:) = zero
6126	drainage(:) = zero
6127	humtot(:) = zero
6128	shumdiag(:,:)= zero
6129	shumdiag_perma(:,:)=zero
6130	k_litt(:) = zero
6131	litterhumdiag(:) = zero
6132	tmc_litt_dry_mea(:) = zero
6133	tmc_litt_wet_mea(:) = zero
6134	tmc_litt_mea(:) = zero
6135	humrel(:,:) = zero
6136	vegstress(:,:) = zero
6137	IF (ok_freeze_cwrr) THEN
6138	profil_froz_hydro(:,:)=zero ! initialisation for the mean of profil_froz_hydro_ns
6139	ENDIF
6140
6141	!! 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
6142
6143	DO ji = 1, kjpindex
6144	mask_vegtot(ji) = 0
6145	IF(vegtot(ji) .GT. min_sechiba) THEN
6146	mask_vegtot(ji) = 1
6147	ENDIF
6148	END DO
6149
6150	DO ji = 1, kjpindex
6151	! Here we weight ae_ns by the fraction of bare evaporating soil.
6152	! This is given by frac_bare_ns, taking into account bare soil under vegetation
6153	ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
6154	END DO
6155
6156	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
6157	DO jst = 1, nstm
6158	DO ji = 1, kjpindex
6159	drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)soiltile(ji,jst) dr_ns(ji,jst))
6160	runoff(ji) = mask_vegtot(ji) * (runoff(ji) + vegtot(ji)soiltile(ji,jst) ru_ns(ji,jst)) &
6161	& + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
6162	humtot(ji) = mask_vegtot(ji) * (humtot(ji) + vegtot(ji)soiltile(ji,jst) tmc(ji,jst))
6163	IF (ok_freeze_cwrr) THEN
6164	! profil_froz_hydro_ns comes from hydrol_soil, to remain the same as in the prognotic loop
6165	profil_froz_hydro(ji,:)=mask_vegtot(ji) * &
6166	(profil_froz_hydro(ji,:) + vegtot(ji)soiltile(ji,jst) profil_froz_hydro_ns(ji,:, jst))
6167	ENDIF
6168	END DO
6169	END DO
6170
6171	! we add the excess of snow sublimation to vevapnu
6172	! - because vevapsno is modified in hydrol_snow if subsinksoil
6173	! - it is multiplied by vegtot because it is devided by 1-tot_frac_nobio at creation in hydrol_snow
6174
6175	DO ji = 1,kjpindex
6176	vevapnu(ji) = vevapnu (ji) + subsinksoil(ji)*vegtot(ji)
6177	END DO
6178
6179	DO jst=1,nstm
6180	DO jv=1,nvm
6181	DO ji=1,kjpindex
6182	IF(veget_max(ji,jv).GT.min_sechiba) THEN
6183	vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)
6184	vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
6185	ENDIF
6186	END DO
6187	END DO
6188	END DO
6189
6190	DO jst=1,nstm
6191	DO jv=1,nvm
6192	DO ji=1,kjpindex
6193	humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)
6194	humrel(ji,jv)=MAX(humrel(ji,jv),zero)
6195	END DO
6196	END DO
6197	END DO
6198
6199	!! Litter... the goal is to calculate drysoil_frac, to calculate the albedo in condveg
6200	! In condveg, drysoil_frac serve to calculate the albedo of drysoil, excluding the nobio contribution which is further added
6201	! In conclusion, we calculate drysoil_frac based on moisture averages restricted to the soiltile (no multiplication by vegtot)
6202	!! k_litt is calculated here as a grid-cell average (for consistency with drainage)
6203	!! litterhumdiag, like shumdiag, is averaged over the soiltiles for transmission to stomate
6204	DO jst=1,nstm
6205	DO ji=1,kjpindex
6206	! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds
6207	IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
6208	i = imin
6209	ELSE
6210	tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
6211	& (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
6212	i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
6213	ENDIF
6214	k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
6215	k_litt(ji) = k_litt(ji) + vegtot(ji)soiltile(ji,jst) SQRT(k_tmp) ! grid-cell average
6216	ENDDO
6217	DO ji=1,kjpindex
6218	litterhumdiag(ji) = litterhumdiag(ji) + &
6219	& soil_wet_litter(ji,jst) * soiltile(ji,jst)
6220
6221	tmc_litt_wet_mea(ji) = tmc_litt_wet_mea(ji) + &
6222	& tmc_litter_awet(ji,jst)* soiltile(ji,jst)
6223
6224	tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
6225	& tmc_litter_adry(ji,jst) * soiltile(ji,jst)
6226
6227	tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
6228	& tmc_litter(ji,jst) * soiltile(ji,jst)
6229	ENDDO
6230	ENDDO
6231
6232	DO ji=1,kjpindex
6233	IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
6234	drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
6235	& (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
6236	ELSE
6237	drysoil_frac(ji) = zero
6238	ENDIF
6239	END DO
6240
6241	! Calculate soilmoist, as a function of total water content (mc)
6242	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
6243	soilmoist(:,:) = zero
6244	DO jst=1,nstm
6245	DO ji=1,kjpindex
6246	soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
6247	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
6248	DO jsl = 2,nslm-1
6249	soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
6250	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
6251	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
6252	END DO
6253	soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
6254	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
6255	END DO
6256	END DO
6257	DO ji=1,kjpindex
6258	soilmoist(ji,:) = soilmoist(ji,:) * vegtot(ji) ! conversion to grid-cell average
6259	ENDDO
6260
6261	! Shumdiag: we start from soil_wet, change the range over which the relative moisture is calculated,
6262	! convert from hydrol to diag soil layers, then do a spatial average,
6263	! excluding the nobio fraction on which stomate doesn't act
6264	DO jst=1,nstm
6265	DO jd=1,nbdl
6266	DO ji=1,kjpindex
6267	DO jsl=1,nslm
6268	shumdiag(ji,jd) = shumdiag(ji,jd) + soil_wet(ji,jsl,jst) * &
6269	soiltile(ji,jst) * frac_hydro_diag(jsl,jd) * &
6270	((mcs(njsc(ji))-mcw(njsc(ji)))/(mcf(njsc(ji))-mcw(njsc(ji))))
6271	ENDDO
6272	shumdiag(ji,jd) = MAX(MIN(shumdiag(ji,jd), un), zero)
6273	ENDDO
6274	ENDDO
6275	ENDDO
6276
6277	! Shumdiag_perma is based on soilmoist / moisture at saturation in the layer
6278	! Her we start from grid averages by hydrol soil layer and transform it to the diag levels
6279	! We keep a grid-cell average, like for all variables transmitted to ok_freeze
6280	DO jd=1,nbdl
6281	DO ji=1,kjpindex
6282	DO jsl=1,nslm
6283	shumdiag_perma(ji,jd) = soilmoist(ji,jsl)*frac_hydro_diag(jsl,jd) &
6284	/(dh(jsl)*mcs(njsc(ji)))
6285	ENDDO
6286	shumdiag_perma(ji,jd) = MAX(MIN(shumdiag_perma(ji,jd), un), zero)
6287	ENDDO
6288	ENDDO
6289
6290	END SUBROUTINE hydrol_diag_soil
6291
6292
6293	!! ================================================================================================================================
6294	!! SUBROUTINE : hydrol_alma
6295	!!
6296	!>\BRIEF This routine computes the changes in soil moisture and interception storage for the ALMA outputs.
6297	!!
6298	!! DESCRIPTION : None
6299	!!
6300	!! RECENT CHANGE(S) : None
6301	!!
6302	!! MAIN OUTPUT VARIABLE(S) :
6303	!!
6304	!! REFERENCE(S) :
6305	!!
6306	!! FLOWCHART : None
6307	!! \n
6308	!_ ================================================================================================================================
6309	!_ hydrol_alma
6310
6311	SUBROUTINE hydrol_alma (kjpindex, index, lstep_init, qsintveg, snow, snow_nobio, soilwet)
6312	!
6313	!! 0. Variable and parameter declaration
6314
6315	!! 0.1 Input variables
6316
6317	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
6318	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
6319	LOGICAL, INTENT (in) :: lstep_init !! At which time is this routine called ?
6320	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
6321	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow water equivalent
6322	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
6323
6324	!! 0.2 Output variables
6325
6326	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: soilwet !! Soil wetness
6327
6328	!! 0.3 Modified variables
6329
6330	!! 0.4 Local variables
6331
6332	INTEGER(i_std) :: ji
6333	REAL(r_std) :: watveg
6334
6335	!_ ================================================================================================================================
6336	!
6337	!
6338	IF ( lstep_init ) THEN
6339	! Initialize variables if they were not found in the restart file
6340
6341	DO ji = 1, kjpindex
6342	watveg = SUM(qsintveg(ji,:))
6343	tot_watveg_beg(ji) = watveg
6344	tot_watsoil_beg(ji) = humtot(ji)
6345	snow_beg(ji) = snow(ji) + SUM(snow_nobio(ji,:))
6346	ENDDO
6347
6348	RETURN
6349
6350	ENDIF
6351	!
6352	! Calculate the values for the end of the time step
6353	!
6354	DO ji = 1, kjpindex
6355	watveg = SUM(qsintveg(ji,:)) ! average within the mesh
6356	tot_watveg_end(ji) = watveg
6357	tot_watsoil_end(ji) = humtot(ji) ! average within the mesh
6358	snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:)) ! average within the mesh
6359
6360	delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji) ! average within the mesh
6361	delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
6362	delswe(ji) = snow_end(ji) - snow_beg(ji) ! average within the mesh
6363	ENDDO
6364	!
6365	!
6366	! Transfer the total water amount at the end of the current timestep top the begining of the next one.
6367	!
6368	tot_watveg_beg = tot_watveg_end
6369	tot_watsoil_beg = tot_watsoil_end
6370	snow_beg(:) = snow_end(:)
6371	!
6372	DO ji = 1,kjpindex
6373	IF ( mx_eau_var(ji) > 0 ) THEN
6374	soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
6375	ELSE
6376	soilwet(ji) = zero
6377	ENDIF
6378	ENDDO
6379	!
6380	END SUBROUTINE hydrol_alma
6381	!
6382
6383
6384	!! ================================================================================================================================
6385	!! SUBROUTINE : hydrol_calculate_temp_hydro
6386	!!
6387	!>\BRIEF Calculate the temperature at hydrological levels
6388	!!
6389	!! DESCRIPTION : None
6390	!!
6391	!! RECENT CHANGE(S) : None
6392	!!
6393	!! MAIN OUTPUT VARIABLE(S) :
6394	!!
6395	!! REFERENCE(S) :
6396	!!
6397	!! FLOWCHART : None
6398	!! \n
6399	!_ ================================================================================================================================
6400
6401
6402	SUBROUTINE hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
6403
6404	!! 0.1 Input variables
6405
6406	INTEGER(i_std), INTENT(in) :: kjpindex
6407	REAL(r_std),DIMENSION (kjpindex,nbdl), INTENT (in) :: stempdiag
6408	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow
6409	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in) :: snowdz
6410
6411
6412	!! 0.2 Local variables
6413
6414	INTEGER jh, jd, ji
6415	REAL(r_std) :: snow_h
6416	REAL(r_std) :: lev_diag, prev_diag, lev_prog, prev_prog
6417	REAL(r_std), DIMENSION(nslm,nbdl) :: intfactt
6418
6419
6420	DO ji=1,kjpindex
6421	!The snow pack is above the surface soil in the new snow model.
6422	snow_h=0
6423
6424	intfactt(:,:)=0.
6425	prev_diag = snow_h
6426	DO jh = 1, nslm
6427	IF (jh.EQ.1) THEN
6428	lev_diag = zz(2)/1000./2.+snow_h
6429	ELSEIF (jh.EQ.nslm) THEN
6430	lev_diag = zz(nslm)/1000.+snow_h
6431
6432	ELSE
6433	lev_diag = zz(jh)/1000. &
6434	& +(zz(jh+1)-zz(jh))/1000./2.+snow_h
6435
6436	ENDIF
6437	prev_prog = 0.0
6438	DO jd = 1, nbdl
6439	lev_prog = diaglev(jd)
6440	IF ((lev_diag.GT.diaglev(nbdl).AND. &
6441	& prev_diag.LT.diaglev(nbdl)-min_sechiba)) THEN
6442	lev_diag=diaglev(nbdl)
6443	ENDIF
6444	intfactt(jh,jd) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog),&
6445	& 0.0)/(lev_diag-prev_diag)
6446	prev_prog = lev_prog
6447	ENDDO
6448	IF (lev_diag.GT.diaglev(nbdl).AND. &
6449	& prev_diag.GE.diaglev(nbdl)-min_sechiba) intfactt(jh,nbdl)=1.
6450	prev_diag = lev_diag
6451	ENDDO
6452	ENDDO
6453
6454	temp_hydro(:,:)=0.
6455	DO jd= 1, nbdl
6456	DO jh= 1, nslm
6457	DO ji = 1, kjpindex
6458	temp_hydro(ji,jh) = temp_hydro(ji,jh) + stempdiag(ji,jd)*intfactt(jh,jd)
6459	ENDDO
6460	ENDDO
6461	ENDDO
6462
6463	END SUBROUTINE hydrol_calculate_temp_hydro
6464
6465
6466	!! ================================================================================================================================
6467	!! SUBROUTINE : hydrol_calculate_frac_hydro_diag
6468	!!
6469	!>\BRIEF Caluculate frac_hydro_diag for interpolation between hydrological and diagnostic axes
6470	!!
6471	!! DESCRIPTION : None
6472	!!
6473	!! RECENT CHANGE(S) : None
6474	!!
6475	!! MAIN OUTPUT VARIABLE(S) :
6476	!!
6477	!! REFERENCE(S) :
6478	!!
6479	!! FLOWCHART : None
6480	!! \n
6481	!_ ================================================================================================================================
6482
6483	SUBROUTINE hydrol_calculate_frac_hydro_diag
6484
6485	!! 0.1 Local variables
6486
6487	INTEGER(i_std) :: jd, jh
6488	REAL(r_std) :: prev_hydro, next_hydro, prev_diag, next_diag
6489
6490
6491	frac_hydro_diag(:,:)=0.
6492	prev_diag = 0.0
6493
6494	DO jd = 1, nbdl
6495
6496	next_diag = diaglev(jd)
6497	prev_hydro = 0.0
6498	DO jh = 1, nslm
6499	IF (jh.EQ.1) THEN
6500	next_hydro = zz(2)/1000./2.
6501	ELSEIF (jh.EQ.nslm) THEN
6502	next_hydro = zz(nslm)/1000.
6503	ELSE
6504	next_hydro = zz(jh)/1000.+(zz(jh+1)-zz(jh))/1000./2.
6505	ENDIF
6506	frac_hydro_diag(jh,jd) = MAX(MIN(next_hydro, next_diag)-MAX(prev_hydro, prev_diag), 0.)/(next_diag - prev_diag)
6507	prev_hydro=next_hydro
6508	ENDDO
6509
6510	prev_diag = next_diag
6511	ENDDO
6512
6513	END SUBROUTINE hydrol_calculate_frac_hydro_diag
6514
6515
6516	END MODULE hydrol

Note: See TracBrowser for help on using the repository browser.

Download in other formats: