Context Navigation

hydrol.f90 @ 5630

Last change on this file since 5630 was 5506, checked in by josefine.ghattas, 6 years ago

Cleaning in cwrr, see ticket #431 : the two keywords check_cwrr and check_cwrr2 were intended to perform water conservation checks and are now merged, under the name check_cwrr. Some obsolete diagnostics were removed, but we keep the calculation of the vertical soil water fluxes between the soil layers and the water budget check in the top soil layer. The calculations are done and the results are written with xios if CHECK_CWRR=y in run.def.

AD & JG

M src_xml/file_def_orchidee.xml
M src_xml/field_def_orchidee.xml
M src_parameters/constantes_soil_var.f90
M src_parameters/constantes_soil.f90
M src_parallel/xios_orchidee.f90
M src_sechiba/hydrol.f90

Property svn:keywords set to Revision Date HeadURL Date Author Revision

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

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

Context Navigation

source: tags/ORCHIDEE_2_1/ORCHIDEE/src_sechiba/hydrol.f90 @ 5630

Download in other formats: