Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

hydrol.f90 @ 7541

Last change on this file since 7541 was 7541, checked in by fabienne.maignan, 2 years ago
Zhang publication on coupling factor
File size: 349.2 KB

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

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

Context Navigation

source: branches/publications/ORCHIDEE_2.2_r7266/ORCHIDEE/src_sechiba/hydrol.f90 @ 7541

Download in other formats: