Context Navigation

source: branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/hydrol.f90 @ 7444

Last change on this file since 7444 was 7444, checked in by agnes.ducharne, 2 years ago
Finishes r7443 for WETNESS_TRANSPIR_MAX.
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 348.7 KB

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

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

Download in other formats: