Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

hydrol.f90

Last change on this file was 5745, checked in by thomas.verbeke, 6 years ago

Update GW version of ORCHIDEE-GW branche:
1) Addition of these trunk changesets:
https://forge.ipsl.jussieu.fr/orchidee/changeset/5433/trunk/ORCHIDEE
https://forge.ipsl.jussieu.fr/orchidee/changeset/5536/trunk/ORCHIDEE
https://forge.ipsl.jussieu.fr/orchidee/changeset/5573/trunk/ORCHIDEE
https://forge.ipsl.jussieu.fr/orchidee/changeset/5614/trunk/ORCHIDEE

2) Modification of wtd calculation in hydrol.f90
3) Modification of .xml files

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

File size: 381.0 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_snow, hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil.
14	!! The assumption in this module is that very high vertical resolution is
15	!! needed in order to properly resolve the vertical diffusion of water in
16	!! the soils. Furthermore we have taken into account the sub-grid variability
17	!! of soil properties and vegetation cover by allowing the co-existence of
18	!! different soil moisture columns in the same grid box.
19	!! This routine was originaly developed by Patricia deRosnay.
20	!!
21	!! RECENT CHANGE(S) : None
22	!!
23	!! REFERENCE(S) :
24	!! - de Rosnay, P., J. Polcher, M. Bruen, and K. Laval, Impact of a physically based soil
25	!! water flow and soil-plant interaction representation for modeling large-scale land surface
26	!! processes, J. Geophys. Res, 107 (10.1029), 2002. \n
27	!! - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled
28	!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. \n
29	!! - de Rosnay, P., M. Bruen, and J. Polcher, Sensitivity of surface fluxes to the number of layers in the soil
30	!! model used in GCMs, Geophysical research letters, 27 (20), 3329 - 3332, 2000. \n
31	!! - dâOrgeval, T., J. Polcher, and P. De Rosnay, Sensitivity of the West African hydrological
32	!! cycle in ORCHIDEE to infiltration processes, Hydrol. Earth Syst. Sci. Discuss, 5, 2251 - 2292, 2008. \n
33	!! - Carsel, R., and R. Parrish, Developing joint probability distributions of soil water retention
34	!! characteristics, Water Resources Research, 24 (5), 755 - 769, 1988. \n
35	!! - Mualem, Y., A new model for predicting the hydraulic conductivity of unsaturated porous
36	!! media, Water Resources Research, 12 (3), 513 - 522, 1976. \n
37	!! - Van Genuchten, M., A closed-form equation for predicting the hydraulic conductivity of
38	!! unsaturated soils, Soil Science Society of America Journal, 44 (5), 892 - 898, 1980. \n
39	!! - Campoy, A., Ducharne, A., Cheruy, F., Hourdin, F., Polcher, J., and Dupont, J.-C., Response
40	!! of land surface fluxes and precipitation to different soil bottom hydrological conditions in a
41	!! general circulation model, J. Geophys. Res, in press, 2013. \n
42	!! - Gouttevin, I., Krinner, G., Ciais, P., Polcher, J., and Legout, C. , 2012. Multi-scale validation
43	!! of a new soil freezing scheme for a land-surface model with physically-based hydrology.
44	!! The Cryosphere, 6, 407-430, doi: 10.5194/tc-6-407-2012. \n
45	!!
46	!! SVN :
47	!! $HeadURL$
48	!! $Date$
49	!! $Revision$
50	!! \n
51	!_ ===============================================================================================\n
52	MODULE hydrol
53
54	USE ioipsl
55	USE xios_orchidee
56	USE constantes
57	USE time, ONLY : one_day, dt_sechiba, julian_diff
58	USE constantes_soil
59	USE pft_parameters
60	USE sechiba_io_p
61	USE grid
62	USE explicitsnow
63
64	IMPLICIT NONE
65
66	PRIVATE
67	PUBLIC :: hydrol_main, hydrol_initialize, hydrol_finalize, hydrol_clear
68
69	!
70	! variables used inside hydrol module : declaration and initialisation
71	!
72	LOGICAL, SAVE :: doponds=.FALSE. !! Reinfiltration flag (true/false)
73	!$OMP THREADPRIVATE(doponds)
74	REAL(r_std), SAVE :: froz_frac_corr !! Coefficient for water frozen fraction correction
75	!$OMP THREADPRIVATE(froz_frac_corr)
76	REAL(r_std), SAVE :: max_froz_hydro !! Coefficient for water frozen fraction correction
77	!$OMP THREADPRIVATE(max_froz_hydro)
78	REAL(r_std), SAVE :: smtot_corr !! Coefficient for water frozen fraction correction
79	!$OMP THREADPRIVATE(smtot_corr)
80	LOGICAL, SAVE :: do_rsoil=.FALSE. !! Flag to calculate rsoil for bare soile evap
81	!! (true/false)
82	!$OMP THREADPRIVATE(do_rsoil)
83	LOGICAL, SAVE :: ok_dynroot !! Flag to activate dynamic root profile to optimize soil
84	!! moisture usage, similar to Beer et al.2007
85	!$OMP THREADPRIVATE(ok_dynroot)
86	CHARACTER(LEN=80) , SAVE :: var_name !! To store variables names for I/O
87	!$OMP THREADPRIVATE(var_name)
88	!
89	REAL(r_std), PARAMETER :: allowed_err = 2.0E-8_r_std
90	REAL(r_std), PARAMETER :: EPS1 = EPSILON(un) !! A small number
91	! one dimension array allocated, computed, saved and got in hydrol module
92	! Values per soil type
93	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: nvan !! Van Genuchten coeficients n (unitless)
94	! RK: 1/n=1-m
95	!$OMP THREADPRIVATE(nvan)
96	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: avan !! Van Genuchten coeficients a
97	!! @tex $(mm^{-1})$ @endtex
98	!$OMP THREADPRIVATE(avan)
99	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcr !! Residual volumetric water content
100	!! @tex $(m^{3} m^{-3})$ @endtex
101	!$OMP THREADPRIVATE(mcr)
102	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcs !! Saturated volumetric water content
103	!! @tex $(m^{3} m^{-3})$ @endtex
104	!$OMP THREADPRIVATE(mcs)
105	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: ks !! Hydraulic conductivity at saturation
106	!! @tex $(mm d^{-1})$ @endtex
107	!$OMP THREADPRIVATE(ks)
108	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pcent !! Fraction of saturated volumetric soil moisture above
109	!! which transpir is max (0-1, unitless)
110	!$OMP THREADPRIVATE(pcent)
111	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcfc !! Volumetric water content at field capacity
112	!! @tex $(m^{3} m^{-3})$ @endtex
113	!$OMP THREADPRIVATE(mcfc)
114	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mcw !! Volumetric water content at wilting point
115	!! @tex $(m^{3} m^{-3})$ @endtex
116	!$OMP THREADPRIVATE(mcw)
117	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_awet !! Vol. wat. cont. above which albedo is cst
118	!! @tex $(m^{3} m^{-3})$ @endtex
119	!$OMP THREADPRIVATE(mc_awet)
120	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_adry !! Vol. wat. cont. below which albedo is cst
121	!! @tex $(m^{3} m^{-3})$ @endtex
122	!$OMP THREADPRIVATE(mc_adry)
123	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_beg !! Total amount of water on vegetation at start of time
124	!! step @tex $(kg m^{-2})$ @endtex
125	!$OMP THREADPRIVATE(tot_watveg_beg)
126	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_end !! Total amount of water on vegetation at end of time step
127	!! @tex $(kg m^{-2})$ @endtex
128	!$OMP THREADPRIVATE(tot_watveg_end)
129	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_beg !! Total amount of water in the soil at start of time step
130	!! @tex $(kg m^{-2})$ @endtex
131	!$OMP THREADPRIVATE(tot_watsoil_beg)
132	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_end !! Total amount of water in the soil at end of time step
133	!! @tex $(kg m^{-2})$ @endtex
134	!$OMP THREADPRIVATE(tot_watsoil_end)
135	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_beg !! Total amount of snow at start of time step
136	!! @tex $(kg m^{-2})$ @endtex
137	!$OMP THREADPRIVATE(snow_beg)
138	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_end !! Total amount of snow at end of time step
139	!! @tex $(kg m^{-2})$ @endtex
140	!$OMP THREADPRIVATE(snow_end)
141	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delsoilmoist !! Change in soil moisture @tex $(kg m^{-2})$ @endtex
142	!$OMP THREADPRIVATE(delsoilmoist)
143	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delintercept !! Change in interception storage
144	!! @tex $(kg m^{-2})$ @endtex
145	!$OMP THREADPRIVATE(delintercept)
146	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delswe !! Change in SWE @tex $(kg m^{-2})$ @endtex
147	!$OMP THREADPRIVATE(delswe)
148	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: undermcr !! Nb of tiles under mcr for a given time step
149	!$OMP THREADPRIVATE(undermcr)
150	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget !! zero/one when veget fraction is zero/higher (1)
151	!$OMP THREADPRIVATE(mask_veget)
152	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile !! zero/one where soil tile is zero/higher (1)
153	!$OMP THREADPRIVATE(mask_soiltile)
154	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: humrelv !! Water stress index for transpiration
155	!! for each soiltile x PFT couple (0-1, unitless)
156	!$OMP THREADPRIVATE(humrelv)
157	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegstressv !! Water stress index for vegetation growth
158	!! for each soiltile x PFT couple (0-1, unitless)
159	!$OMP THREADPRIVATE(vegstressv)
160	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: us !! Water stress index for transpiration
161	!! (by soil layer and PFT) (0-1, unitless)
162	!$OMP THREADPRIVATE(us)
163	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol !! Throughfall+Totmelt per PFT
164	!! @tex $(kg m^{-2})$ @endtex
165	!$OMP THREADPRIVATE(precisol)
166	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: throughfall !! Throughfall per PFT
167	!! @tex $(kg m^{-2})$ @endtex
168	!$OMP THREADPRIVATE(throughfall)
169	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol_ns !! Throughfall per soiltile
170	!! @tex $(kg m^{-2})$ @endtex
171	!$OMP THREADPRIVATE(precisol_ns)
172	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ae_ns !! Bare soil evaporation per soiltile
173	!! @tex $(kg m^{-2})$ @endtex
174	!$OMP THREADPRIVATE(ae_ns)
175	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: free_drain_coef !! Coefficient for free drainage at bottom
176	!! (0-1, unitless)
177	!$OMP THREADPRIVATE(free_drain_coef)
178	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: zwt_force !! Prescribed water table depth (m)
179	!$OMP THREADPRIVATE(zwt_force)
180	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: frac_bare_ns !! Evaporating bare soil fraction per soiltile
181	!! (0-1, unitless)
182	!$OMP THREADPRIVATE(frac_bare_ns)
183	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: rootsink !! Transpiration sink by soil layer and soiltile
184	!! @tex $(kg m^{-2})$ @endtex
185	!$OMP THREADPRIVATE(rootsink)
186	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsnowveg !! Sublimation of snow on vegetation
187	!! @tex $(kg m^{-2})$ @endtex
188	!$OMP THREADPRIVATE(subsnowveg)
189	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio !! Sublimation of snow on other surface types
190	!! (ice, lakes,...) @tex $(kg m^{-2})$ @endtex
191	!$OMP THREADPRIVATE(subsnownobio)
192	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: icemelt !! Ice melt @tex $(kg m^{-2})$ @endtex
193	!$OMP THREADPRIVATE(icemelt)
194	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsinksoil !! Excess of sublimation as a sink for the soil
195	!! @tex $(kg m^{-2})$ @endtex
196	!$OMP THREADPRIVATE(subsinksoil)
197	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot !! Total Total fraction of grid-cell covered by PFTs
198	!! (bare soil + vegetation) (1; 1)
199	!$OMP THREADPRIVATE(vegtot)
200	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: resdist !! Soiltile values from previous time-step (1; 1)
201	!$OMP THREADPRIVATE(resdist)
202	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot_old !! Total Total fraction of grid-cell covered by PFTs
203	!! from previous time-step (1; 1)
204	!$OMP THREADPRIVATE(vegtot_old)
205	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mx_eau_var !! Maximum water content of the soil @tex $(kg m^{-2})$ @endtex
206	!$OMP THREADPRIVATE(mx_eau_var)
207
208	! arrays used by cwrr scheme
209	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: nroot !! Normalized root length fraction in each soil layer
210	!! (0-1, unitless)
211	!! DIM = kjpindex * nvm * nslm
212	!$OMP THREADPRIVATE(nroot)
213	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kfact_root !! Factor to increase Ks towards the surface
214	!! (unitless)
215	!! DIM = kjpindex * nslm * nstm
216	!$OMP THREADPRIVATE(kfact_root)
217	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kfact !! Factor to reduce Ks with depth (unitless)
218	!! DIM = nslm * nscm
219	!$OMP THREADPRIVATE(kfact)
220	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: zz !! Depth of nodes [znh in vertical_soil] transformed into (mm)
221	!$OMP THREADPRIVATE(zz)
222	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dz !! Internode thickness [dnh in vertical_soil] transformed into (mm)
223	!$OMP THREADPRIVATE(dz)
224	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dh !! Layer thickness [dlh in vertical_soil] transformed into (mm)
225	!$OMP THREADPRIVATE(dh)
226	INTEGER(i_std), SAVE :: itopmax !! Number of layers where the node is above 0.1m depth
227	!$OMP THREADPRIVATE(itopmax)
228	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mc_lin !! 50 Vol. Wat. Contents to linearize K and D, for each texture
229	!! @tex $(m^{3} m^{-3})$ @endtex
230	!! DIM = imin:imax * nscm
231	!$OMP THREADPRIVATE(mc_lin)
232	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: k_lin !! 50 values of unsaturated K, for each soil layer and texture
233	!! @tex $(mm d^{-1})$ @endtex
234	!! DIM = imin:imax * nslm * nscm
235	!$OMP THREADPRIVATE(k_lin)
236	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: d_lin !! 50 values of diffusivity D, for each soil layer and texture
237	!! @tex $(mm^2 d^{-1})$ @endtex
238	!! DIM = imin:imax * nslm * nscm
239	!$OMP THREADPRIVATE(d_lin)
240	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: a_lin !! 50 values of the slope in K=a*mc+b, for each soil layer and texture
241	!! @tex $(mm d^{-1})$ @endtex
242	!! DIM = imin:imax * nslm * nscm
243	!$OMP THREADPRIVATE(a_lin)
244	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: b_lin !! 50 values of y-intercept in K=a*mc+b, for each soil layer and texture
245	!! @tex $(m^{3} m^{-3})$ @endtex
246	!! DIM = imin:imax * nslm * nscm
247	!$OMP THREADPRIVATE(b_lin)
248	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: humtot !! Total Soil Moisture @tex $(kg m^{-2})$ @endtex
249	!$OMP THREADPRIVATE(humtot)
250	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: humtot_ns !! Total Soil Moisture pert soil tile @tex $(kg m^{-2})$ @endtex
251	!$OMP THREADPRIVATE(humtot_ns)
252	LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: resolv !! Mask of land points where to solve the diffusion equation
253	!! (true/false)
254	!$OMP THREADPRIVATE(resolv)
255
256	!! for output
257	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kk_moy !! Mean hydraulic conductivity over soiltiles (mm/d)
258	!$OMP THREADPRIVATE(kk_moy)
259	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kk !! Hydraulic conductivity for each soiltiles (mm/d)
260	!$OMP THREADPRIVATE(kk)
261	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: avan_mod_tab !! VG parameter a modified from exponantial profile
262	!! @tex $(mm^{-1})$ @endtex !! DIMENSION (nslm,nscm)
263	!$OMP THREADPRIVATE(avan_mod_tab)
264	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: nvan_mod_tab !! VG parameter n modified from exponantial profile
265	!! (unitless) !! DIMENSION (nslm,nscm)
266	!$OMP THREADPRIVATE(nvan_mod_tab)
267
268	!! linarization coefficients of hydraulic conductivity K (hydrol_soil_coef)
269	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: k !! Hydraulic conductivity K for each soil layer
270	!! @tex $(mm d^{-1})$ @endtex
271	!! DIM = (:,nslm)
272	!$OMP THREADPRIVATE(k)
273	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: a !! Slope in K=a*mc+b(:,nslm)
274	!! @tex $(mm d^{-1})$ @endtex
275	!! DIM = (:,nslm)
276	!$OMP THREADPRIVATE(a)
277	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: b !! y-intercept in K=a*mc+b
278	!! @tex $(m^{3} m^{-3})$ @endtex
279	!! DIM = (:,nslm)
280	!$OMP THREADPRIVATE(b)
281	!! linarization coefficients of hydraulic diffusivity D (hydrol_soil_coef)
282	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: d !! Diffusivity D for each soil layer
283	!! @tex $(mm^2 d^{-1})$ @endtex
284	!! DIM = (:,nslm)
285	!$OMP THREADPRIVATE(d)
286	!! matrix coefficients (hydrol_soil_tridiag and hydrol_soil_setup), see De Rosnay (1999), p155-157
287	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: e !! Left-hand tridiagonal matrix coefficients
288	!$OMP THREADPRIVATE(e)
289	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: f !! Left-hand tridiagonal matrix coefficients
290	!$OMP THREADPRIVATE(f)
291	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: g1 !! Left-hand tridiagonal matrix coefficients
292	!$OMP THREADPRIVATE(g1)
293
294	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ep !! Right-hand matrix coefficients
295	!$OMP THREADPRIVATE(ep)
296	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: fp !! Right-hand atrix coefficients
297	!$OMP THREADPRIVATE(fp)
298	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gp !! Right-hand atrix coefficients
299	!$OMP THREADPRIVATE(gp)
300	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: rhs !! Right-hand system
301	!$OMP THREADPRIVATE(rhs)
302	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: srhs !! Temporarily stored rhs
303	!$OMP THREADPRIVATE(srhs)
304	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: tmat !! Left-hand tridiagonal matrix
305	!$OMP THREADPRIVATE(tmat)
306	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: stmat !! Temporarily stored tmat
307	!$OMP THREADPRIVATE(stmat)
308	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: water2infilt !! Water to be infiltrated
309	!! @tex $(kg m^{-2})$ @endtex
310	!$OMP THREADPRIVATE(water2infilt)
311	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc !! Total moisture content per soiltile
312	!! @tex $(kg m^{-2})$ @endtex
313	!$OMP THREADPRIVATE(tmc)
314	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcr !! Total moisture content at residual per soiltile
315	!! @tex $(kg m^{-2})$ @endtex
316	!$OMP THREADPRIVATE(tmcr)
317	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcs !! Total moisture content at saturation per soiltile
318	!! @tex $(kg m^{-2})$ @endtex
319	!$OMP THREADPRIVATE(tmcs)
320	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcfc !! Total moisture content at field capacity per soiltile
321	!! @tex $(kg m^{-2})$ @endtex
322	!$OMP THREADPRIVATE(tmcfc)
323	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcw !! Total moisture content at wilting point per soiltile
324	!! @tex $(kg m^{-2})$ @endtex
325	!$OMP THREADPRIVATE(tmcw)
326	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter !! Total moisture in the litter per soiltile
327	!! @tex $(kg m^{-2})$ @endtex
328	!$OMP THREADPRIVATE(tmc_litter)
329	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_mea !! Total moisture in the litter over the grid
330	!! @tex $(kg m^{-2})$ @endtex
331	!$OMP THREADPRIVATE(tmc_litt_mea)
332	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_wilt !! Total moisture of litter at wilt point per soiltile
333	!! @tex $(kg m^{-2})$ @endtex
334	!$OMP THREADPRIVATE(tmc_litter_wilt)
335	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_field !! Total moisture of litter at field cap. per soiltile
336	!! @tex $(kg m^{-2})$ @endtex
337	!$OMP THREADPRIVATE(tmc_litter_field)
338	!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
339	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_res !! Total moisture of litter at residual moisture per soiltile
340	!! @tex $(kg m^{-2})$ @endtex
341	!$OMP THREADPRIVATE(tmc_litter_res)
342	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_sat !! Total moisture of litter at saturation per soiltile
343	!! @tex $(kg m^{-2})$ @endtex
344	!$OMP THREADPRIVATE(tmc_litter_sat)
345	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_awet !! Total moisture of litter at mc_awet per soiltile
346	!! @tex $(kg m^{-2})$ @endtex
347	!$OMP THREADPRIVATE(tmc_litter_awet)
348	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_adry !! Total moisture of litter at mc_adry per soiltile
349	!! @tex $(kg m^{-2})$ @endtex
350	!$OMP THREADPRIVATE(tmc_litter_adry)
351	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which
352	!! albedo is fixed constant
353	!! @tex $(kg m^{-2})$ @endtex
354	!$OMP THREADPRIVATE(tmc_litt_wet_mea)
355	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which
356	!! albedo is constant
357	!! @tex $(kg m^{-2})$ @endtex
358	!$OMP THREADPRIVATE(tmc_litt_dry_mea)
359	LOGICAL, SAVE :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
360	!$OMP THREADPRIVATE(tmc_init_updated)
361
362	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: v1 !! Temporary variable (:)
363	!$OMP THREADPRIVATE(v1)
364
365	!! par type de sol :
366	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ru_ns !! Surface runoff per soiltile
367	!! @tex $(kg m^{-2})$ @endtex
368	!$OMP THREADPRIVATE(ru_ns)
369	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dr_ns !! Drainage per soiltile
370	!! @tex $(kg m^{-2})$ @endtex
371	!$OMP THREADPRIVATE(dr_ns)
372	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tr_ns !! Transpiration per soiltile
373	!$OMP THREADPRIVATE(tr_ns)
374	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegetmax_soil !! (:,nvm,nstm) percentage of each veg. type on each soil
375	!! of each grid point
376	!$OMP THREADPRIVATE(vegetmax_soil)
377	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: ratio_soil !!IGEM
378	!$OMP THREADPRIVATE(ratio_soil)
379	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc !! Total volumetric water content at the calculation nodes
380	!! (eg : liquid + frozen)
381	!! @tex $(m^{3} m^{-3})$ @endtex
382	!$OMP THREADPRIVATE(mc)
383
384	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_prev !! Soil moisture from file at previous timestep in the file
385	!$OMP THREADPRIVATE(mc_read_prev)
386	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_next !! Soil moisture from file at next time step in the file
387	!$OMP THREADPRIVATE(mc_read_next)
388	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mask_mc_interp !! Mask of valid data in soil moisture nudging file
389	!$OMP THREADPRIVATE(mask_mc_interp)
390	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowdz_read_prev !! snowdz read from file at previous timestep in the file
391	!$OMP THREADPRIVATE(snowdz_read_prev)
392	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowdz_read_next !! snowdz read from file at next time step in the file
393	!$OMP THREADPRIVATE(snowdz_read_next)
394	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowrho_read_prev !! snowrho read from file at previous timestep in the file
395	!$OMP THREADPRIVATE(snowrho_read_prev)
396	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowrho_read_next !! snowrho read from file at next time step in the file
397	!$OMP THREADPRIVATE(snowrho_read_next)
398	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowtemp_read_prev !! snowtemp read from file at previous timestep in the file
399	!$OMP THREADPRIVATE(snowtemp_read_prev)
400	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowtemp_read_next !! snowtemp read from file at next time step in the file
401	!$OMP THREADPRIVATE(snowtemp_read_next)
402	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_snow_interp !! Mask of valid data in snow nudging file
403	!$OMP THREADPRIVATE(mask_snow_interp)
404
405	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mcl !! Liquid water content
406	!! @tex $(m^{3} m^{-3})$ @endtex
407	!$OMP THREADPRIVATE(mcl)
408	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soilmoist !! (:,nslm) Mean of each soil layer's moisture
409	!! across soiltiles
410	!! @tex $(kg m^{-2})$ @endtex
411	!$OMP THREADPRIVATE(soilmoist)
412	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soilmoist_liquid !! (:,nslm) Mean of each soil layer's liquid moisture
413	!! across soiltiles
414	!! @tex $(kg m^{-2})$ @endtex
415	!$OMP THREADPRIVATE(soilmoist_liquid)
416	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: soil_wet_ns !! Soil wetness above mcw (0-1, unitless)
417	!$OMP THREADPRIVATE(soil_wet_ns)
418	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soil_wet_litter !! Soil wetness aove mvw in the litter (0-1, unitless)
419	!$OMP THREADPRIVATE(soil_wet_litter)
420	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: qflux !! Diffusive water fluxes between soil layers
421	!$OMP THREADPRIVATE(qflux)
422	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz_hydro !! Frozen fraction for each hydrological soil layer
423	!$OMP THREADPRIVATE(profil_froz_hydro)
424	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: profil_froz_hydro_ns !! As profil_froz_hydro per soiltile
425	!$OMP THREADPRIVATE(profil_froz_hydro_ns)
426	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: temp_hydro !! Temp profile on hydrological levels
427	!$OMP THREADPRIVATE(temp_hydro)
428	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: lateral_sink !! Flux (mm/dtsechiba) from WTD zone to river IGEM
429	!$OMP THREADPRIVATE(lateral_sink)
430	REAL(r_std), SAVE :: RC_fac !! River factor for the lateral flow calculation
431	! (no dim for the moment, spatialised in the future)
432	!$OMP THREADPRIVATE(RC_fac)
433
434
435
436	CONTAINS
437
438	!! ================================================================================================================================
439	!! SUBROUTINE : hydrol_initialize
440	!!
441	!>\BRIEF Allocate module variables, read from restart file or initialize with default values
442	!!
443	!! DESCRIPTION :
444	!!
445	!! MAIN OUTPUT VARIABLE(S) :
446	!!
447	!! REFERENCE(S) :
448	!!
449	!! FLOWCHART : None
450	!! \n
451	!_ ================================================================================================================================
452
453	SUBROUTINE hydrol_initialize ( kjit, kjpindex, index, rest_id, &
454	njsc, soiltile, veget, veget_max, &
455	humrel, vegstress, drysoil_frac, &
456	shumdiag_perma, qsintveg, &
457	evap_bare_lim, evap_bare_lim_ns, snow, snow_age, snow_nobio, &
458	snow_nobio_age, snowrho, snowtemp, snowgrain, &
459	snowdz, snowheat, &
460	mc_layh, mcl_layh, soilmoist_out)
461
462	!! 0. Variable and parameter declaration
463	!! 0.1 Input variables
464	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
465	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
466	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
467	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
468	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
469	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
470	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
471	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
472
473	!! 0.2 Output variables
474	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
475	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
476	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
477	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
478	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
479	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor for bare soil evaporation
480	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out) :: evap_bare_lim_ns !! Limitation factor for bare soil evaporation
481	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
482	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
483	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
484	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out):: snow_nobio_age !! Snow age on ice, lakes, ...
485	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowrho !! Snow density
486	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowtemp !! Snow temperature
487	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowgrain !! Snow grainsize
488	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowdz !! Snow layer thickness
489	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowheat !! Snow heat content
490	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
491	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
492	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: soilmoist_out !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
493	REAL(r_std),DIMENSION (kjpindex) :: soilwetdummy !! Temporary variable never used
494
495
496	!! 0.4 Local variables
497	INTEGER(i_std) :: jsl
498	!_ ================================================================================================================================
499
500	CALL hydrol_init (kjit, kjpindex, index, rest_id, veget_max, soiltile, &
501	humrel, vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg, &
502	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
503	drysoil_frac, evap_bare_lim, evap_bare_lim_ns)
504
505	CALL hydrol_var_init (kjpindex, veget, veget_max, &
506	soiltile, njsc, mx_eau_var, shumdiag_perma, &
507	drysoil_frac, qsintveg, mc_layh, mcl_layh)
508
509	!! Initialize hydrol_alma routine if the variables were not found in the restart file. This is done in the end of
510	!! hydrol_initialize so that all variables(humtot,..) that will be used are initialized.
511	IF (ALL(tot_watveg_beg(:)==val_exp) .OR. ALL(tot_watsoil_beg(:)==val_exp) .OR. ALL(snow_beg(:)==val_exp)) THEN
512	! The output variable soilwetdummy is not calculated at first call to hydrol_alma.
513	CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwetdummy)
514	END IF
515
516	!! Calculate itopmax indicating the number of layers where the node is above 0.1m depth
517	itopmax=1
518	DO jsl = 1, nslm
519	! znh : depth of nodes
520	IF (znh(jsl) <= 0.1) THEN
521	itopmax=jsl
522	END IF
523	END DO
524	IF (printlev>=3) WRITE(numout,*) "Number of layers where the node is above 0.1m depth: itopmax=",itopmax
525
526	! Copy soilmoist into a local variable to be sent to thermosoil
527	soilmoist_out(:,:) = soilmoist(:,:)
528
529	END SUBROUTINE hydrol_initialize
530
531
532	!! ================================================================================================================================
533	!! SUBROUTINE : hydrol_main
534	!!
535	!>\BRIEF
536	!!
537	!! DESCRIPTION :
538	!! - called every time step
539	!! - initialization and finalization part are not done in here
540	!!
541	!! - 1 computes snow ==> hydrol_snow
542	!! - 2 computes vegetations reservoirs ==> hydrol_vegupd
543	!! - 3 computes canopy ==> hydrol_canop
544	!! - 4 computes surface reservoir ==> hydrol_flood
545	!! - 5 computes soil hydrology ==> hydrol_soil
546	!!
547	!! IMPORTANT NOTICE : The water fluxes are used in their integrated form, over the time step
548	!! dt_sechiba, with a unit of kg m^{-2}.
549	!!
550	!! RECENT CHANGE(S) : None
551	!!
552	!! MAIN OUTPUT VARIABLE(S) :
553	!!
554	!! REFERENCE(S) :
555	!!
556	!! FLOWCHART : None
557	!! \n
558	!_ ================================================================================================================================
559
560	SUBROUTINE hydrol_main (kjit, kjpindex, &
561	& index, indexveg, indexsoil, indexlayer, indexnslm, &
562	& temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
563	& qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, &
564	& tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, flowtowtd,& !IGEM
565	& humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, evap_bare_lim_ns, &
566	& flood_frac, flood_res, &
567	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, ratio_tile, soiltile, fraclut, reinf_slope, &!IGEM
568	& rest_id, hist_id, hist2_id,qtot_to_river, reinf_from_fast,&!IGEM
569	& contfrac, stempdiag, &
570	& temp_air, pb, u, v, tq_cdrag, swnet, pgflux, &
571	& snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
572	& grndflux,gtemp,tot_bare_soil, &
573	& lambda_snow,cgrnd_snow,dgrnd_snow,frac_snow_veg,temp_sol_add, &
574	& mc_layh, mcl_layh, soilmoist_out )
575
576	!! 0. Variable and parameter declaration
577
578	!! 0.1 Input variables
579
580	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
581	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
582	INTEGER(i_std),INTENT (in) :: rest_id,hist_id !! _Restart_ file and _history_ file identifier
583	INTEGER(i_std),INTENT (in) :: hist2_id !! _history_ file 2 identifier
584	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
585	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg !! Indeces of the points on the 3D map for veg
586	INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil !! Indeces of the points on the 3D map for soil
587	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer !! Indeces of the points on the 3D map for soil layers
588	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexnslm !! Indeces of the points on the 3D map for of diagnostic soil layers
589
590	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_rain !! Rain precipitation
591	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_snow !! Snow precipitation
592	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: returnflow !! Routed water which comes back into the soil (from the
593	!! bottom)
594	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinfiltration !! Routed water which comes back into the soil (at the
595	!! top)
596	REAL(r_std),DIMENSION (kjpindex), INTENT (in) ::reinf_from_fast !IGEM
597	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: irrigation !!Water from irrigation returning to soil moisture
598	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: flowtowtd !!IGEM
599	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol_new !! New soil temperature
600	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
601	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio !! Fraction of ice, lakes, ...
602	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: totfrac_nobio !! Total fraction of ice+lakes+...
603	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: soilcap !! Soil capacity
604	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
605	REAL(r_std),DIMENSION (kjpindex,nlut), INTENT (in) :: fraclut !! Fraction of each landuse tile (0-1, unitless)
606	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vevapwet !! Interception loss
607	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
608	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
609	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintmax !! Maximum water on vegetation for interception
610	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
611	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Slope coef
612	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot !! Soil Potential Evaporation
613	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot_penm !! Soil Potential Evaporation Correction
614	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: flood_frac !! flood fraction
615	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid
616	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
617	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature
618	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
619	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient (-)
620	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
621	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net shortwave radiation
622	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pgflux !! Net energy into snowpack
623	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: gtemp !! First soil layer temperature
624	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
625	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lambda_snow !! Coefficient of the linear extrapolation of surface temperature
626	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: cgrnd_snow !! Integration coefficient for snow numerical scheme
627	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: dgrnd_snow !! Integration coefficient for snow numerical scheme
628	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: frac_snow_veg !! Snow cover fraction on vegetation
629	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: ratio_tile !!IGEM
630
631	!! 0.2 Output variables
632
633	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
634	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
635	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out):: shumdiag !! Relative soil moisture in each soil layer
636	!! with respect to (mcfc-mcw)
637	!! (unitless; can be out of 0-1)
638	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out):: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
639	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter approximate conductivity
640	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
641	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_melt !! Total melt
642	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: floodout !! Flux out of floodplains
643	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: qtot_to_river !!IGEM
644
645	!! 0.3 Modified variables
646
647	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg !! Water on vegetation due to interception
648	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
649	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(inout):: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation
650	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel !! Relative humidity
651	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapnu !! Bare soil evaporation
652	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapsno !! Snow evaporation
653	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapflo !! Floodplain evaporation
654	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: flood_res !! flood reservoir estimate
655	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow !! Snow mass [kg/m^2]
656	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow_age !! Snow age
657	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
658	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
659	!! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
660	!! The water balance is limite to + or - 10^6 so that accumulation is not endless
661
662	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: runoff !! Complete surface runoff
663	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drainage !! Drainage
664	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density
665	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature
666	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowgrain !! Snow grainsize
667	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness
668	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowheat !! Snow heat content
669	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowliq !! Snow liquid content (m)
670	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: grndflux !! Net flux into soil W/m2
671	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mc_layh !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
672	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]
673	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: soilmoist_out!! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
674	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_add !! additional surface temperature due to the melt of first layer
675	!! at the present time-step @tex ($K$) @endtex
676
677
678	!! 0.4 Local variables
679
680	INTEGER(i_std) :: jst !! Index of soil tiles (unitless, 1-3)
681	INTEGER(i_std) :: jsl !! Index of soil layers (unitless)
682	INTEGER(i_std) :: ji, jv
683	REAL(r_std),DIMENSION (kjpindex) :: soilwet !! A temporary diagnostic of soil wetness
684	REAL(r_std),DIMENSION (kjpindex) :: snowdepth !! Depth of snow layer, only for diagnostics with ok_explicitsnow=n
685	REAL(r_std),DIMENSION (kjpindex) :: snowdepth_diag !! Depth of snow layer containing default values, only for diagnostics
686	REAL(r_std),DIMENSION (kjpindex, nsnow) :: snowdz_diag !! Depth of snow layer on all layers containing default values, only for diagnostics
687	REAL(r_std),DIMENSION (kjpindex) :: njsc_tmp !! Temporary REAL value for njsc to write it
688	REAL(r_std), DIMENSION (kjpindex) :: snowmelt !! Snow melt [mm/dt_sechiba]
689	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmc_top !! Moisture content in the itopmax upper layers, per tile
690	REAL(r_std), DIMENSION (kjpindex) :: humtot_top !! Moisture content in the itopmax upper layers, for diagnistics
691	REAL(r_std), DIMENSION(kjpindex) :: histvar !! Temporary variable when computations are needed
692	REAL(r_std), DIMENSION (kjpindex,nvm) :: frac_bare !! Fraction(of veget_max) of bare soil in each vegetation type
693	INTEGER(i_std), DIMENSION(kjpindex*imax) :: mc_lin_axis_index
694	REAL(r_std), DIMENSION(kjpindex) :: twbr !! Grid-cell mean of TWBR Total Water Budget Residu[kg/m2/dt]
695	REAL(r_std), DIMENSION(kjpindex,nstm) :: twbr_ns !! IGEM
696	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_nroot !! To ouput the grid-cell mean of nroot
697	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_dlh !! To ouput the soil layer thickness on all grid points [m]
698	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcs !! To ouput the mean of mcs
699	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcfc !! To ouput the mean of mcfc
700	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcw !! To ouput the mean of mcw
701	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcr !! To ouput the mean of mcr
702	REAL(r_std),DIMENSION (kjpindex) :: land_tmcs !! To ouput the grid-cell mean of tmcs
703	REAL(r_std),DIMENSION (kjpindex) :: land_tmcfc !! To ouput the grid-cell mean of tmcfc
704	REAL(r_std),DIMENSION (kjpindex) :: drain_upd !! Change in drainage due to decrease in vegtot
705	!! on mc [kg/m2/dt]
706	REAL(r_std),DIMENSION (kjpindex) :: runoff_upd !! Change in runoff due to decrease in vegtot
707	!! on water2infilt[kg/m2/dt]
708	REAL(r_std),DIMENSION (kjpindex) :: mrsow !! Soil wetness above wilting point for CMIP6 (humtot-WP)/(SAT-WP)
709	REAL(r_std), DIMENSION (kjpindex,nlut) :: humtot_lut !! Moisture content on landuse tiles, for diagnostics
710	REAL(r_std), DIMENSION (kjpindex,nlut) :: humtot_top_lut !! Moisture content in upper layers on landuse tiles, for diagnostics
711	REAL(r_std), DIMENSION (kjpindex,nlut) :: mrro_lut !! Total runoff from landuse tiles, for diagnostics
712
713	!_ ================================================================================================================================
714	!! 1. Update vegtot_old and recalculate vegtot
715	vegtot_old(:) = vegtot(:)
716
717	DO ji = 1, kjpindex
718	vegtot(ji) = SUM(veget_max(ji,:))
719	ENDDO
720
721
722	!! 2. Applay nudging for soil moisture and/or snow variables
723	IF (ok_nudge_mc .OR. ok_nudge_snow) THEN
724	CALL hydrol_nudge(kjit, kjpindex, mc, snowdz, snowrho, snowtemp, soiltile)
725	END IF
726
727
728	!! 3. Shared time step
729	IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
730
731	!
732	!! 3.1 Calculate snow processes with explicit method or bucket snow model
733	IF (ok_explicitsnow) THEN
734	! Explicit snow model
735	IF (printlev>=3) WRITE (numout,*) ' ok_explicitsnow : use multi-snow layer '
736	CALL explicitsnow_main(kjpindex, precip_rain, precip_snow, temp_air, pb, &
737	u, v, temp_sol_new, soilcap, pgflux, &
738	frac_nobio, totfrac_nobio,gtemp, &
739	lambda_snow, cgrnd_snow, dgrnd_snow, contfrac, &
740	vevapsno, snow_age, snow_nobio_age,snow_nobio, snowrho, &
741	snowgrain, snowdz, snowtemp, snowheat, snow, &
742	temp_sol_add, &
743	snowliq, subsnownobio, grndflux, snowmelt, tot_melt, &
744	subsinksoil)
745	ELSE
746	! Bucket snow model
747	CALL hydrol_snow(kjpindex, precip_rain, precip_snow, temp_sol_new, soilcap, &
748	frac_nobio, totfrac_nobio, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
749	tot_melt, snowdepth,snowmelt)
750	END IF
751
752	!
753	!! 3.2 computes vegetations reservoirs ==>hydrol_vegupd
754	! Modif temp vuichard
755	CALL hydrol_vegupd(kjpindex, veget, veget_max, ratio_tile, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)!IGEM
756
757	!! Calculate kfact_root
758	!! An exponential factor is used to increase ks near the surface depending on the amount of roots in the soil
759	!! through a geometric average over the vegets
760	!! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al. 2008, Eqs. 3-4
761	!! (Calibrated against Hapex-Sahel measurements)
762	!! Since rev 2916: veget_max/2 is used instead of veget
763	kfact_root(:,:,:) = un
764	DO jsl = 1, nslm
765	DO jv = 2, nvm
766	jst = pref_soil_veg(jv)
767	DO ji = 1, kjpindex
768	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
769	kfact_root(ji,jsl,jst) = kfact_root(ji,jsl,jst) * &
770	& MAX((MAXVAL(ks_usda)/ks(njsc(ji)))*(- vegetmax_soil(ji,jv,jst)/2 (humcste(jv)*zz(jsl)/mille - un)/deux), &
771	un)
772	ENDIF
773	ENDDO
774	ENDDO
775	ENDDO
776
777	DO jsl = 1, nslm !IGEM tile4
778	DO jv = 2, nvm
779	DO ji = 1, kjpindex
780	IF(soiltile(ji,4) .GT. min_sechiba) THEN
781	kfact_root(ji,jsl,4) = kfact_root(ji,jsl,4) * &
782	&MAX((MAXVAL(ks_usda)/ks(njsc(ji)))*(-vegetmax_soil(ji,jv,4)/2 (humcste(jv)*zz(jsl)/mille - un)/deux), &
783	un)
784	ENDIF
785	ENDDO
786	ENDDO
787	ENDDO !IGEM
788
789
790
791	!
792	!! 3.3 computes canopy ==>hydrol_canop
793	CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
794
795	!
796	!! 3.4 computes surface reservoir ==>hydrol_flood
797	CALL hydrol_flood(kjpindex, vevapflo, flood_frac, flood_res, floodout)
798
799	!
800	!! 3.5 computes soil hydrology ==>hydrol_soil
801
802	CALL hydrol_soil(kjpindex, veget_max, ratio_tile, soiltile, njsc, reinf_slope, &!IGEM
803	transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
804	returnflow, reinfiltration, irrigation, flowtowtd, qtot_to_river, reinf_from_fast,& !IGEM
805	tot_melt,evap_bare_lim, evap_bare_lim_ns, shumdiag, shumdiag_perma, &
806	k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,&
807	stempdiag,snow,snowdz, tot_bare_soil, u, v, tq_cdrag, &
808	mc_layh, mcl_layh)
809
810	! The update fluxes come from hydrol_vegupd
811	drainage(:) = drainage(:) + drain_upd(:)
812	runoff(:) = runoff(:) + runoff_upd(:)
813
814
815	!! 4 write out file ==> hydrol_alma/histwrite(*)
816	!
817	! If we use the ALMA standards
818	CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
819
820
821	! Calculate the moisture in the upper itopmax layers corresponding to 0.1m (humtot_top):
822	! For ORCHIDEE with nslm=11 and zmaxh=2, itopmax=6.
823	! We compute tmc_top as tmc but only for the first itopmax layers. Then we compute a humtot with this variable.
824	DO jst=1,nstm
825	DO ji=1,kjpindex
826	tmc_top(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
827	DO jsl = 2, itopmax
828	tmc_top(ji,jst) = tmc_top(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
829	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
830	ENDDO
831	ENDDO
832	ENDDO
833
834	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
835	humtot_top(:) = zero
836	DO jst=1,nstm
837	DO ji=1,kjpindex
838	humtot_top(ji) = humtot_top(ji) + soiltile(ji,jst) * tmc_top(ji,jst) * vegtot(ji)
839	ENDDO
840	ENDDO
841
842	! Calculate the Total Water Budget Residu (in kg/m2 over dt_sechiba)
843	! All the delstocks and fluxes below are averaged over the mesh
844	! snow_nobio included in delswe
845	! Does not include the routing reservoirs, although the flux to/from routing are integrated
846	DO ji=1,kjpindex
847	twbr(ji) = (delsoilmoist(ji) + delintercept(ji) + delswe(ji)) &
848	- ( precip_rain(ji) + precip_snow(ji) + irrigation(ji) + floodout(ji) + flowtowtd(ji)&!IGEM
849	+ returnflow(ji) + reinfiltration(ji) + reinf_from_fast(ji)) &!IGEM
850	+ ( runoff(ji) + drainage(ji) + qtot_to_river(ji) + SUM(vevapwet(ji,:)) &!IGEM
851	+ SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) )
852	ENDDO
853
854
855	!write(numout,*)'twbr',twbr(:)
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) ! layer thickness (m)
876	ENDDO
877	CALL xios_orchidee_send_field("dlh",land_dlh)
878	DO jsl=1,nslm
879	land_dlh(:,jsl)=znh(jsl) ! depth of nodes (m)
880	ENDDO
881	CALL xios_orchidee_send_field("znh",land_dlh)
882
883	! Particular soil moisture values, spatially averaged over the grid-cell
884	! (a) total SM in kg/m2
885	! we average the total values of each soiltile and multiply by vegtot to transform to a grid-cell mean (over total land)
886	land_tmcs(:) = zero
887	land_tmcfc(:) = zero
888	DO jst=1,nstm
889	DO ji=1,kjpindex
890	land_tmcs(ji) = land_tmcs(ji) + soiltile(ji,jst) * tmcs(ji,jst) * vegtot(ji)
891	land_tmcfc(ji) = land_tmcfc(ji) + soiltile(ji,jst) * tmcfc(ji,jst) * vegtot(ji)
892	ENDDO
893	ENDDO
894	CALL xios_orchidee_send_field("tmcs",land_tmcs) ! in kg/m2
895	CALL xios_orchidee_send_field("tmcfc",land_tmcfc) ! in kg/m2
896
897	! (b) volumetric moisture content by layers in m3/m3
898	! mcs etc are identical in all layers (no normalization by vegtot to be comparable to mc)
899	DO jsl=1,nslm
900	land_mcs(:,jsl) = mcs(njsc(:))
901	land_mcfc(:,jsl) = mcfc(njsc(:))
902	land_mcw(:,jsl) = mcw(njsc(:))
903	land_mcr(:,jsl) = mcr(njsc(:))
904	ENDDO
905	CALL xios_orchidee_send_field("mcs",land_mcs) ! in m3/m3
906	CALL xios_orchidee_send_field("mcfc",land_mcfc) ! in m3/m3
907	CALL xios_orchidee_send_field("mcw",land_mcw) ! in m3/m3
908	CALL xios_orchidee_send_field("mcr",land_mcr) ! in m3/m3
909
910	CALL xios_orchidee_send_field("water2infilt",water2infilt)
911	CALL xios_orchidee_send_field("mc",mc)
912	CALL xios_orchidee_send_field("kfact_root",kfact_root)
913	CALL xios_orchidee_send_field("vegetmax_soil",vegetmax_soil)
914	CALL xios_orchidee_send_field("evapnu_soil",ae_ns/dt_sechiba)
915	CALL xios_orchidee_send_field("drainage_soil",dr_ns/dt_sechiba)
916	CALL xios_orchidee_send_field("transpir_soil",tr_ns/dt_sechiba)
917	CALL xios_orchidee_send_field("runoff_soil",ru_ns/dt_sechiba)
918	CALL xios_orchidee_send_field("humrel",humrel)
919	CALL xios_orchidee_send_field("drainage",drainage/dt_sechiba) ! [kg m-2 s-1]
920	CALL xios_orchidee_send_field("runoff",runoff/dt_sechiba) ! [kg m-2 s-1]
921	CALL xios_orchidee_send_field("precisol",precisol/dt_sechiba)
922	CALL xios_orchidee_send_field("throughfall",throughfall/dt_sechiba)
923	CALL xios_orchidee_send_field("precip_rain",precip_rain/dt_sechiba)
924	CALL xios_orchidee_send_field("precip_snow",precip_snow/dt_sechiba)
925	CALL xios_orchidee_send_field("qsintmax",qsintmax)
926	CALL xios_orchidee_send_field("qsintveg",qsintveg)
927	CALL xios_orchidee_send_field("qsintveg_tot",SUM(qsintveg(:,:),dim=2))
928	histvar(:)=(precip_rain(:)-SUM(throughfall(:,:),dim=2))
929	CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
930
931	IF ( do_floodplains ) THEN
932	CALL xios_orchidee_send_field("floodout",floodout/dt_sechiba)
933	END IF
934
935	CALL xios_orchidee_send_field("snowmelt",snowmelt/dt_sechiba)
936	CALL xios_orchidee_send_field("tot_melt",tot_melt/dt_sechiba)
937
938	CALL xios_orchidee_send_field("soilmoist",soilmoist)
939	CALL xios_orchidee_send_field("soilmoist_liquid",soilmoist_liquid)
940	CALL xios_orchidee_send_field("humtot_frozen",SUM(soilmoist(:,:),2)-SUM(soilmoist_liquid(:,:),2))
941	CALL xios_orchidee_send_field("tmc",tmc)
942	CALL xios_orchidee_send_field("humtot",humtot)
943	CALL xios_orchidee_send_field("humtot_top",humtot_top)
944
945	! For the soil wetness above wilting point for CMIP6 (mrsow)
946	mrsow(:) = MAX( zero,humtot(:) - zmaxhmillemcw(njsc(:)) ) &
947	/ ( zmaxhmille( mcs(njsc(:)) - mcw(njsc(:)) ) )
948	CALL xios_orchidee_send_field("mrsow",mrsow)
949
950	CALL xios_orchidee_send_field("qtot_to_river",qtot_to_river/dt_sechiba) !(kg/m2(grid)/s) !IGEM
951
952	! Prepare diagnostic snow variables depending on snow scheme
953	IF (ok_explicitsnow) THEN
954	! Add XIOS default value where no snow
955	DO ji=1,kjpindex
956	IF (snow(ji) > 0) THEN
957	snowdz_diag(ji,:) = snowdz(ji,:)
958	snowdepth_diag(ji) = SUM(snowdz(ji,:))(1-totfrac_nobio(ji))frac_snow_veg(ji)
959	ELSE
960	snowdz_diag(ji,:) = xios_default_val
961	snowdepth_diag(ji) = xios_default_val
962	END IF
963	END DO
964	CALL xios_orchidee_send_field("snowdz",snowdz_diag)
965	CALL xios_orchidee_send_field("snowdepth",snowdepth_diag)
966	ELSE
967	! Add XIOS default value where no snow
968	DO ji=1,kjpindex
969	IF (snow(ji) > 0) THEN
970	snowdz_diag(ji,:) = snowdepth(ji)
971	snowdepth_diag(ji) = snowdepth(ji)*(1-totfrac_nobio(ji))
972	ELSE
973	snowdz_diag(ji,:) = xios_default_val
974	snowdepth_diag(ji) = xios_default_val
975	END IF
976	END DO
977	CALL xios_orchidee_send_field("snowdz",snowdz_diag(:,1))
978	CALL xios_orchidee_send_field("snowdepth",snowdepth_diag)
979	END IF
980
981	CALL xios_orchidee_send_field("frac_bare",frac_bare)
982	CALL xios_orchidee_send_field("frac_bare_ns",frac_bare_ns) !IGEM19
983	CALL xios_orchidee_send_field("soilwet",soilwet)
984	CALL xios_orchidee_send_field("delsoilmoist",delsoilmoist)
985	CALL xios_orchidee_send_field("delswe",delswe)
986	CALL xios_orchidee_send_field("delintercept",delintercept)
987
988	IF (ok_freeze_cwrr) THEN
989	CALL xios_orchidee_send_field("profil_froz_hydro",profil_froz_hydro)
990	CALL xios_orchidee_send_field("temp_hydro",temp_hydro)
991	END IF
992	CALL xios_orchidee_send_field("profil_froz_hydro_ns", profil_froz_hydro_ns)
993	CALL xios_orchidee_send_field("kk_moy",kk_moy) ! in mm/d
994	CALL xios_orchidee_send_field("kk",kk) ! in mm/d !IGEM
995
996	!! Calculate diagnostic variables on Landuse tiles for LUMIP/CMIP6
997	humtot_lut(:,:)=0
998	humtot_top_lut(:,:)=0
999	mrro_lut(:,:)=0
1000	DO jv=1,nvm
1001	jst=pref_soil_veg(jv) ! soil tile index WARNING IGEM change here considering the tile 4!
1002	IF (natural(jv)) THEN
1003	humtot_lut(:,id_psl) = humtot_lut(:,id_psl) + tmc(:,jst)*veget_max(:,jv)
1004	humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl) + tmc_top(:,jst)*veget_max(:,jv)
1005	mrro_lut(:,id_psl) = mrro_lut(:,id_psl) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
1006	ELSE
1007	humtot_lut(:,id_crp) = humtot_lut(:,id_crp) + tmc(:,jst)*veget_max(:,jv)
1008	humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp) + tmc_top(:,jst)*veget_max(:,jv)
1009	mrro_lut(:,id_crp) = mrro_lut(:,id_crp) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
1010	ENDIF
1011	END DO
1012
1013	WHERE (fraclut(:,id_psl)>min_sechiba)
1014	humtot_lut(:,id_psl) = humtot_lut(:,id_psl)/fraclut(:,id_psl)
1015	humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl)/fraclut(:,id_psl)
1016	mrro_lut(:,id_psl) = mrro_lut(:,id_psl)/fraclut(:,id_psl)/dt_sechiba
1017	ELSEWHERE
1018	humtot_lut(:,id_psl) = val_exp
1019	humtot_top_lut(:,id_psl) = val_exp
1020	mrro_lut(:,id_psl) = val_exp
1021	END WHERE
1022	WHERE (fraclut(:,id_crp)>min_sechiba)
1023	humtot_lut(:,id_crp) = humtot_lut(:,id_crp)/fraclut(:,id_crp)
1024	humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp)/fraclut(:,id_crp)
1025	mrro_lut(:,id_crp) = mrro_lut(:,id_crp)/fraclut(:,id_crp)/dt_sechiba
1026	ELSEWHERE
1027	humtot_lut(:,id_crp) = val_exp
1028	humtot_top_lut(:,id_crp) = val_exp
1029	mrro_lut(:,id_crp) = val_exp
1030	END WHERE
1031
1032	humtot_lut(:,id_pst) = val_exp
1033	humtot_lut(:,id_urb) = val_exp
1034	humtot_top_lut(:,id_pst) = val_exp
1035	humtot_top_lut(:,id_urb) = val_exp
1036	mrro_lut(:,id_pst) = val_exp
1037	mrro_lut(:,id_urb) = val_exp
1038
1039	CALL xios_orchidee_send_field("humtot_lut",humtot_lut)
1040	CALL xios_orchidee_send_field("humtot_top_lut",humtot_top_lut)
1041	CALL xios_orchidee_send_field("mrro_lut",mrro_lut)
1042
1043
1044	IF ( .NOT. almaoutput ) THEN
1045	CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
1046
1047	DO jst=1,nstm
1048	! var_name= "mc_1" ... "mc_3"
1049	WRITE (var_name,"('moistc_',i1)") jst
1050	CALL histwrite_p(hist_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
1051
1052	! var_name= "kfactroot_1" ... "kfactroot_3"
1053	WRITE (var_name,"('kfactroot_',i1)") jst
1054	CALL histwrite_p(hist_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
1055
1056	! var_name= "vegetsoil_1" ... "vegetsoil_3"
1057	WRITE (var_name,"('vegetsoil_',i1)") jst
1058	CALL histwrite_p(hist_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
1059	ENDDO
1060	CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
1061	CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
1062	CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
1063	CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
1064	CALL histwrite_p(hist_id, 'tmc', kjit, tmc, kjpindex*nstm, indexsoil)
1065	! mrso is a perfect duplicate of humtot
1066	CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
1067	CALL histwrite_p(hist_id, 'mrso', kjit, humtot, kjpindex, index)
1068	CALL histwrite_p(hist_id, 'mrsos', kjit, humtot_top, kjpindex, index)
1069	njsc_tmp(:)=njsc(:)
1070	CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
1071	CALL histwrite_p(hist_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
1072	CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
1073	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
1074	CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
1075	CALL histwrite_p(hist_id, 'mrros', kjit, runoff, kjpindex, index)
1076	histvar(:)=(runoff(:)+drainage(:))
1077	CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
1078	CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
1079	CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
1080
1081	histvar(:)=(precip_rain(:)-SUM(throughfall(:,:),dim=2))
1082	CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
1083
1084	CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
1085	CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
1086	CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
1087	CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
1088	CALL histwrite_p(hist_id, 'shumdiag_perma',kjit,shumdiag_perma,kjpindex*nslm,indexnslm)
1089
1090	IF ( do_floodplains ) THEN
1091	CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
1092	ENDIF
1093	!
1094	IF ( hist2_id > 0 ) THEN
1095	DO jst=1,nstm
1096	! var_name= "mc_1" ... "mc_3"
1097	WRITE (var_name,"('moistc_',i1)") jst
1098	CALL histwrite_p(hist2_id, TRIM(var_name), kjit,mc(:,:,jst), kjpindex*nslm, indexlayer)
1099
1100	! var_name= "kfactroot_1" ... "kfactroot_3"
1101	WRITE (var_name,"('kfactroot_',i1)") jst
1102	CALL histwrite_p(hist2_id, TRIM(var_name), kjit, kfact_root(:,:,jst), kjpindex*nslm, indexlayer)
1103
1104	! var_name= "vegetsoil_1" ... "vegetsoil_3"
1105	WRITE (var_name,"('vegetsoil_',i1)") jst
1106	CALL histwrite_p(hist2_id, TRIM(var_name), kjit,vegetmax_soil(:,:,jst), kjpindex*nvm, indexveg)
1107	ENDDO
1108	CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
1109	CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
1110	CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
1111	CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
1112	CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
1113	! mrso is a perfect duplicate of humtot
1114	CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
1115	CALL histwrite_p(hist2_id, 'mrso', kjit, humtot, kjpindex, index)
1116	CALL histwrite_p(hist2_id, 'mrsos', kjit, humtot_top, kjpindex, index)
1117	njsc_tmp(:)=njsc(:)
1118	CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
1119	CALL histwrite_p(hist2_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
1120	CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
1121	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
1122	CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
1123	CALL histwrite_p(hist2_id, 'mrros', kjit, runoff, kjpindex, index)
1124	histvar(:)=(runoff(:)+drainage(:))
1125	CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
1126
1127	IF ( do_floodplains ) THEN
1128	CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
1129	ENDIF
1130	CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
1131	CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
1132	CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
1133	CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
1134	CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
1135	CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
1136	ENDIF
1137	ELSE
1138	CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
1139	CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
1140	CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
1141	CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
1142	CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
1143	CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
1144	CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
1145	CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
1146	!
1147	CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
1148	CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
1149	!
1150	CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
1151	CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
1152	!
1153	IF (.NOT. ok_explicitsnow) CALL histwrite_p(hist_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
1154	!
1155	IF ( hist2_id > 0 ) THEN
1156	CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
1157	CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
1158	CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
1159	CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
1160	CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
1161	CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
1162	CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
1163	CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
1164	!
1165	CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
1166	CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
1167	!
1168	CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
1169	CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
1170	!
1171	IF (.NOT. ok_explicitsnow) CALL histwrite_p(hist2_id, 'SnowDepth', kjit, snowdepth, kjpindex, index)
1172	ENDIF
1173	ENDIF
1174
1175	IF (ok_freeze_cwrr) THEN
1176	CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit,profil_froz_hydro , kjpindex*nslm, indexlayer)
1177
1178	CALL histwrite_p(hist_id, 'temp_hydro', kjit,temp_hydro , kjpindex*nslm, indexlayer)
1179	ENDIF
1180	CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
1181	DO jst=1,nstm
1182	WRITE (var_name,"('profil_froz_hydro_',i1)") jst
1183	CALL histwrite_p(hist_id, TRIM(var_name), kjit, profil_froz_hydro_ns(:,:,jst), kjpindex*nslm, indexlayer)
1184	ENDDO
1185
1186	! Copy soilmoist into a local variable to be sent to thermosoil
1187	soilmoist_out(:,:) = soilmoist(:,:)
1188
1189	IF (printlev>=3) WRITE (numout,*) ' hydrol_main Done '
1190
1191	END SUBROUTINE hydrol_main
1192
1193
1194	!! ================================================================================================================================
1195	!! SUBROUTINE : hydrol_finalize
1196	!!
1197	!>\BRIEF
1198	!!
1199	!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrol to restart file
1200	!!
1201	!! MAIN OUTPUT VARIABLE(S) :
1202	!!
1203	!! REFERENCE(S) :
1204	!!
1205	!! FLOWCHART : None
1206	!! \n
1207	!_ ================================================================================================================================
1208
1209	SUBROUTINE hydrol_finalize( kjit, kjpindex, rest_id, vegstress, &
1210	qsintveg, humrel, snow, snow_age, snow_nobio, &
1211	snow_nobio_age, snowrho, snowtemp, snowdz, &
1212	snowheat, snowgrain, ratio_tile, &!IGEM
1213	drysoil_frac, evap_bare_lim, evap_bare_lim_ns)
1214
1215	!! 0. Variable and parameter declaration
1216	!! 0.1 Input variables
1217	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
1218	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
1219	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
1220	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1221	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
1222	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: humrel
1223	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
1224	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow_age !! Snow age
1225	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
1226	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age !! Snow age on ice, lakes, ...
1227	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho !! Snow density
1228	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature
1229	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowdz !! Snow layer thickness
1230	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowheat !! Snow heat content
1231	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowgrain !! Snow grainsize
1232	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: drysoil_frac !! function of litter wetness
1233	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: evap_bare_lim
1234	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(in) :: evap_bare_lim_ns
1235	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(in) :: ratio_tile !! IGEM
1236
1237	!! 0.4 Local variables
1238	INTEGER(i_std) :: jst, jsl
1239
1240	!_ ================================================================================================================================
1241
1242
1243	IF (printlev>=3) WRITE (numout,*) 'Write restart file with HYDROLOGIC variables '
1244
1245	DO jst=1,nstm
1246	! var_name= "mc_1" ... "mc_3"
1247	WRITE (var_name,"('moistc_',i1)") jst
1248	CALL restput_p(rest_id, var_name, nbp_glo, nslm, 1, kjit, mc(:,:,jst), 'scatter', nbp_glo, index_g)
1249	END DO
1250
1251	DO jst=1,nstm
1252	! var_name= "mcl_1" ... "mcl_3"
1253	WRITE (var_name,"('moistcl_',i1)") jst
1254	CALL restput_p(rest_id, var_name, nbp_glo, nslm, 1, kjit, mcl(:,:,jst), 'scatter', nbp_glo, index_g)
1255	END DO
1256
1257	IF (ok_nudge_mc) THEN
1258	DO jst=1,nstm
1259	WRITE (var_name,"('mc_read_next_',i1)") jst
1260	CALL restput_p(rest_id, var_name, nbp_glo, nslm, 1, kjit, mc_read_next(:,:,jst), 'scatter', nbp_glo, index_g)
1261	END DO
1262	END IF
1263
1264	IF (ok_nudge_snow) THEN
1265	CALL restput_p(rest_id, 'snowdz_read_next', nbp_glo, nsnow, 1, kjit, snowdz_read_next(:,:), &
1266	'scatter', nbp_glo, index_g)
1267	CALL restput_p(rest_id, 'snowrho_read_next', nbp_glo, nsnow, 1, kjit, snowrho_read_next(:,:), &
1268	'scatter', nbp_glo, index_g)
1269	CALL restput_p(rest_id, 'snowtemp_read_next', nbp_glo, nsnow, 1, kjit, snowtemp_read_next(:,:), &
1270	'scatter', nbp_glo, index_g)
1271	END IF
1272
1273
1274
1275	DO jst=1,nstm
1276	DO jsl=1,nslm
1277	! var_name= "us_1_01" ... "us_3_11"
1278	!WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
1279	WRITE (var_name,"('us_',i1,'_',i3.3)") jst,jsl
1280	CALL restput_p(rest_id, var_name, nbp_glo,nvm, 1,kjit,us(:,:,jst,jsl),'scatter',nbp_glo,index_g)
1281	END DO
1282	END DO
1283
1284	CALL restput_p(rest_id, 'free_drain_coef', nbp_glo, nstm, 1, kjit, free_drain_coef, 'scatter', nbp_glo, index_g)
1285	CALL restput_p(rest_id, 'zwt_force', nbp_glo, nstm, 1, kjit, zwt_force, 'scatter', nbp_glo, index_g)
1286	CALL restput_p(rest_id, 'water2infilt', nbp_glo, nstm, 1, kjit, water2infilt, 'scatter', nbp_glo, index_g)
1287	CALL restput_p(rest_id, 'ae_ns', nbp_glo, nstm, 1, kjit, ae_ns, 'scatter', nbp_glo, index_g)
1288	CALL restput_p(rest_id, 'vegstress', nbp_glo, nvm, 1, kjit, vegstress, 'scatter', nbp_glo, index_g)
1289	CALL restput_p(rest_id, 'snow', nbp_glo, 1, 1, kjit, snow, 'scatter', nbp_glo, index_g)
1290	CALL restput_p(rest_id, 'snow_age', nbp_glo, 1, 1, kjit, snow_age, 'scatter', nbp_glo, index_g)
1291	CALL restput_p(rest_id, 'snow_nobio', nbp_glo, nnobio, 1, kjit, snow_nobio, 'scatter', nbp_glo, index_g)
1292	CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo, nnobio, 1, kjit, snow_nobio_age, 'scatter', nbp_glo, index_g)
1293	CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit, qsintveg, 'scatter', nbp_glo, index_g)
1294	CALL restput_p(rest_id, 'evap_bare_lim_ns', nbp_glo, nstm, 1, kjit, evap_bare_lim_ns, 'scatter', nbp_glo, index_g)
1295	CALL restput_p(rest_id, 'evap_bare_lim', nbp_glo, 1, 1, kjit, evap_bare_lim, 'scatter', nbp_glo, index_g)
1296	CALL restput_p(rest_id, 'resdist', nbp_glo, nstm, 1, kjit, resdist, 'scatter', nbp_glo, index_g)
1297	CALL restput_p(rest_id, 'vegtot_old', nbp_glo, 1, 1, kjit, vegtot_old, 'scatter', nbp_glo, index_g)
1298	CALL restput_p(rest_id, 'drysoil_frac', nbp_glo, 1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
1299	CALL restput_p(rest_id, 'humrel', nbp_glo, nvm, 1, kjit, humrel, 'scatter', nbp_glo, index_g)
1300
1301	CALL restput_p(rest_id, 'tot_watveg_beg', nbp_glo, 1, 1, kjit, tot_watveg_beg, 'scatter', nbp_glo, index_g)
1302	CALL restput_p(rest_id, 'tot_watsoil_beg', nbp_glo, 1, 1, kjit, tot_watsoil_beg, 'scatter', nbp_glo, index_g)
1303	CALL restput_p(rest_id, 'snow_beg', nbp_glo, 1, 1, kjit, snow_beg, 'scatter', nbp_glo, index_g)
1304
1305	CALL restput_p(rest_id, 'swt_frac', nbp_glo, 1, 1, kjit, ratio_tile(:,4), 'scatter', nbp_glo, index_g) !IGEM
1306	!CALL restput_p(rest_id, 'wtd_ns', nbp_glo, nstm, 1, kjit, wtd_ns, 'scatter', nbp_glo, index_g) !IGEM
1307
1308	! Write variables for explictsnow module to restart file
1309	IF (ok_explicitsnow) THEN
1310	CALL explicitsnow_finalize ( kjit, kjpindex, rest_id, snowrho, &
1311	snowtemp, snowdz, snowheat, snowgrain)
1312	END IF
1313
1314	END SUBROUTINE hydrol_finalize
1315
1316
1317	!! ================================================================================================================================
1318	!! SUBROUTINE : hydrol_init
1319	!!
1320	!>\BRIEF Initializations and memory allocation
1321	!!
1322	!! DESCRIPTION :
1323	!! - 1 Some initializations
1324	!! - 2 make dynamic allocation with good dimension
1325	!! - 2.1 array allocation for soil textur
1326	!! - 2.2 Soil texture choice
1327	!! - 3 Other array allocation
1328	!! - 4 Open restart input file and read data for HYDROLOGIC process
1329	!! - 5 get restart values if none were found in the restart file
1330	!! - 6 Vegetation array
1331	!! - 7 set humrelv from us
1332	!!
1333	!! RECENT CHANGE(S) : None
1334	!!
1335	!! MAIN OUTPUT VARIABLE(S) :
1336	!!
1337	!! REFERENCE(S) :
1338	!!
1339	!! FLOWCHART : None
1340	!! \n
1341	!_ ================================================================================================================================
1342	!!_ hydrol_init
1343
1344	SUBROUTINE hydrol_init(kjit, kjpindex, index, rest_id, veget_max, soiltile, &
1345	humrel, vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg, &
1346	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
1347	drysoil_frac, evap_bare_lim, evap_bare_lim_ns)
1348
1349
1350	!! 0. Variable and parameter declaration
1351
1352	!! 0.1 Input variables
1353
1354	INTEGER(i_std), INTENT (in) :: kjit !! Time step number
1355	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
1356	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
1357	INTEGER(i_std), INTENT (in) :: rest_id !! _Restart_ file identifier
1358	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Carte de vegetation max
1359	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
1360
1361	!! 0.2 Output variables
1362
1363	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Stress hydrique, relative humidity
1364	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1365	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
1366	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
1367	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio !! Snow on ice, lakes, ...
1368	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age !! Snow age on ice, lakes, ...
1369	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
1370	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowdz !! Snow depth
1371	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowgrain !! Snow grain size
1372	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowheat !! Snow heat content
1373	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowtemp !! Snow temperature
1374	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowrho !! Snow density
1375	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: drysoil_frac !! function of litter wetness
1376	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: evap_bare_lim
1377	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(out) :: evap_bare_lim_ns
1378
1379	!! 0.4 Local variables
1380
1381	INTEGER(i_std) :: ier !! Error code
1382	INTEGER(i_std) :: ji !! Index of land grid cells (1)
1383	INTEGER(i_std) :: jv !! Index of PFTs (1)
1384	INTEGER(i_std) :: jst !! Index of soil tiles (1)
1385	INTEGER(i_std) :: jsl !! Index of soil layers (1)
1386	INTEGER(i_std) :: jsc !! Index of soil texture (1)
1387	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
1388	!! Switch to 2 tu turn fatal errors into warnings
1389	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: free_drain_max !! Temporary var for initialization of free_drain_coef
1390	!REAL(r_std), ALLOCATABLE, DIMENSION (:,:) :: free_drain_max
1391	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: zwt_default !! Temporary variable for initialization of zwt_force
1392	REAL(r_std) :: init_tile4_moisture !! IGEM initial soil moisture in tile 4
1393	REAL(r_std) :: free_drain_val
1394	LOGICAL :: zforce !! To test if we force the WT in any of the soiltiles
1395
1396	!_ ================================================================================================================================
1397
1398	!! 1 Some initializations
1399	!
1400	!Config Key = DO_PONDS
1401	!Config Desc = Should we include ponds
1402	!Config Def = n
1403	!Config If = HYDROL_CWRR
1404	!Config Help = This parameters allows the user to ask the model
1405	!Config to take into account the ponds and return
1406	!Config the water into the soil moisture. If this is
1407	!Config activated, then there is no reinfiltration
1408	!Config computed inside the hydrol module.
1409	!Config Units = [FLAG]
1410	!
1411	doponds = .FALSE.
1412	CALL getin_p('DO_PONDS', doponds)
1413
1414	!Config Key = FROZ_FRAC_CORR
1415	!Config Desc = Coefficient for the frozen fraction correction
1416	!Config Def = 1.0
1417	!Config If = HYDROL_CWRR and OK_FREEZE
1418	!Config Help =
1419	!Config Units = [-]
1420	froz_frac_corr = 1.0
1421	CALL getin_p("FROZ_FRAC_CORR", froz_frac_corr)
1422
1423	!Config Key = MAX_FROZ_HYDRO
1424	!Config Desc = Coefficient for the frozen fraction correction
1425	!Config Def = 1.0
1426	!Config If = HYDROL_CWRR and OK_FREEZE
1427	!Config Help =
1428	!Config Units = [-]
1429	max_froz_hydro = 1.0
1430	CALL getin_p("MAX_FROZ_HYDRO", max_froz_hydro)
1431
1432	!Config Key = SMTOT_CORR
1433	!Config Desc = Coefficient for the frozen fraction correction
1434	!Config Def = 2.0
1435	!Config If = HYDROL_CWRR and OK_FREEZE
1436	!Config Help =
1437	!Config Units = [-]
1438	smtot_corr = 2.0
1439	CALL getin_p("SMTOT_CORR", smtot_corr)
1440
1441	!Config Key = DO_RSOIL
1442	!Config Desc = Should we reduce soil evaporation with a soil resistance
1443	!Config Def = n
1444	!Config If = HYDROL_CWRR
1445	!Config Help = This parameters allows the user to ask the model
1446	!Config to calculate a soil resistance to reduce the soil evaporation
1447	!Config Units = [FLAG]
1448	!
1449	do_rsoil = .FALSE.
1450	CALL getin_p('DO_RSOIL', do_rsoil)
1451
1452	!Config Key = OK_DYNROOT
1453	!Config Desc = Calculate dynamic root profile to optimize soil moisture usage
1454	!Config Def = n
1455	!Config If = HYDROL_CWRR
1456	!Config Help =
1457	!Config Units = [FLAG]
1458	ok_dynroot = .FALSE.
1459	CALL getin_p('OK_DYNROOT',ok_dynroot)
1460
1461	!Config Key = RC_CSTE
1462	!Config Desc = FACTOR TO ADJUST FLOW FROM WATER TABLE TO RIVER
1463	!Config Def = n
1464	!Config If = HYDROL_CWRR
1465	!Config Help =
1466	!Config Units = [FLAG]
1467	RC_fac = 1.0 !IGEM
1468	CALL getin_p('RC_CSTE',RC_fac) !IGEM
1469
1470	!! 2 make dynamic allocation with good dimension
1471
1472	!! 2.1 array allocation for soil texture
1473
1474	ALLOCATE (nvan(nscm),stat=ier)
1475	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan','','')
1476
1477	ALLOCATE (avan(nscm),stat=ier)
1478	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan','','')
1479
1480	ALLOCATE (mcr(nscm),stat=ier)
1481	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcr','','')
1482
1483	ALLOCATE (mcs(nscm),stat=ier)
1484	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcs','','')
1485
1486	ALLOCATE (ks(nscm),stat=ier)
1487	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ks','','')
1488
1489	ALLOCATE (pcent(nscm),stat=ier)
1490	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable pcent','','')
1491
1492	ALLOCATE (mcfc(nscm),stat=ier)
1493	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcfc','','')
1494
1495	ALLOCATE (mcw(nscm),stat=ier)
1496	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcw','','')
1497
1498	ALLOCATE (mc_awet(nscm),stat=ier)
1499	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_awet','','')
1500
1501	ALLOCATE (mc_adry(nscm),stat=ier)
1502	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_adry','','')
1503
1504	!!__2.2 Soil texture choose
1505
1506	SELECTCASE (nscm)
1507	CASE (3)
1508
1509	nvan(:) = nvan_fao(:)
1510	avan(:) = avan_fao(:)
1511	mcr(:) = mcr_fao(:)
1512	mcs(:) = mcs_fao(:)
1513	ks(:) = ks_fao(:)
1514	pcent(:) = pcent_fao(:)
1515	mcfc(:) = mcf_fao(:)
1516	mcw(:) = mcw_fao(:)
1517	mc_awet(:) = mc_awet_fao(:)
1518	mc_adry(:) = mc_adry_fao(:)
1519	CASE (12)
1520
1521	nvan(:) = nvan_usda(:)
1522	avan(:) = avan_usda(:)
1523	mcr(:) = mcr_usda(:)
1524	mcs(:) = mcs_usda(:)
1525	ks(:) = ks_usda(:)
1526	pcent(:) = pcent_usda(:)
1527	mcfc(:) = mcf_usda(:)
1528	mcw(:) = mcw_usda(:)
1529	mc_awet(:) = mc_awet_usda(:)
1530	mc_adry(:) = mc_adry_usda(:)
1531
1532	CASE DEFAULT
1533	WRITE (numout,*) 'Unsupported soil type classification. Choose between zobler and usda according to the map'
1534	CALL ipslerr_p(3,'hydrol_init','Unsupported soil type classification. ',&
1535	'Choose between zobler and usda according to the map','')
1536	ENDSELECT
1537
1538
1539	!! 2.3 Read in the run.def the parameters values defined by the user
1540
1541	!Config Key = CWRR_N_VANGENUCHTEN
1542	!Config Desc = Van genuchten coefficient n
1543	!Config If = HYDROL_CWRR
1544	!Config Def = 1.89, 1.56, 1.31
1545	!Config Help = This parameter will be constant over the entire
1546	!Config simulated domain, thus independent from soil
1547	!Config texture.
1548	!Config Units = [-]
1549	CALL getin_p("CWRR_N_VANGENUCHTEN",nvan)
1550
1551	!! Check parameter value (correct range)
1552	IF ( ANY(nvan(:) <= zero) ) THEN
1553	CALL ipslerr_p(error_level, "hydrol_init.", &
1554	& "Wrong parameter value for CWRR_N_VANGENUCHTEN.", &
1555	& "This parameter should be positive. ", &
1556	& "Please, check parameter value in run.def. ")
1557	END IF
1558
1559
1560	!Config Key = CWRR_A_VANGENUCHTEN
1561	!Config Desc = Van genuchten coefficient a
1562	!Config If = HYDROL_CWRR
1563	!Config Def = 0.0075, 0.0036, 0.0019
1564	!Config Help = This parameter will be constant over the entire
1565	!Config simulated domain, thus independent from soil
1566	!Config texture.
1567	!Config Units = [1/mm]
1568	CALL getin_p("CWRR_A_VANGENUCHTEN",avan)
1569
1570	!! Check parameter value (correct range)
1571	IF ( ANY(avan(:) <= zero) ) THEN
1572	CALL ipslerr_p(error_level, "hydrol_init.", &
1573	& "Wrong parameter value for CWRR_A_VANGENUCHTEN.", &
1574	& "This parameter should be positive. ", &
1575	& "Please, check parameter value in run.def. ")
1576	END IF
1577
1578
1579	!Config Key = VWC_RESIDUAL
1580	!Config Desc = Residual soil water content
1581	!Config If = HYDROL_CWRR
1582	!Config Def = 0.065, 0.078, 0.095
1583	!Config Help = This parameter will be constant over the entire
1584	!Config simulated domain, thus independent from soil
1585	!Config texture.
1586	!Config Units = [m3/m3]
1587	CALL getin_p("VWC_RESIDUAL",mcr)
1588
1589	!! Check parameter value (correct range)
1590	IF ( ANY(mcr(:) < zero) .OR. ANY(mcr(:) > 1.) ) THEN
1591	CALL ipslerr_p(error_level, "hydrol_init.", &
1592	& "Wrong parameter value for VWC_RESIDUAL.", &
1593	& "This parameter is ranged between 0 and 1. ", &
1594	& "Please, check parameter value in run.def. ")
1595	END IF
1596
1597
1598	!Config Key = VWC_SAT
1599	!Config Desc = Saturated soil water content
1600	!Config If = HYDROL_CWRR
1601	!Config Def = 0.41, 0.43, 0.41
1602	!Config Help = This parameter will be constant over the entire
1603	!Config simulated domain, thus independent from soil
1604	!Config texture.
1605	!Config Units = [m3/m3]
1606	CALL getin_p("VWC_SAT",mcs)
1607
1608	!! Check parameter value (correct range)
1609	IF ( ANY(mcs(:) < zero) .OR. ANY(mcs(:) > 1.) .OR. ANY(mcs(:) <= mcr(:)) ) THEN
1610	CALL ipslerr_p(error_level, "hydrol_init.", &
1611	& "Wrong parameter value for VWC_SAT.", &
1612	& "This parameter should be greater than VWC_RESIDUAL and less than 1. ", &
1613	& "Please, check parameter value in run.def. ")
1614	END IF
1615
1616
1617	!Config Key = CWRR_KS
1618	!Config Desc = Hydraulic conductivity Saturation
1619	!Config If = HYDROL_CWRR
1620	!Config Def = 1060.8, 249.6, 62.4
1621	!Config Help = This parameter will be constant over the entire
1622	!Config simulated domain, thus independent from soil
1623	!Config texture.
1624	!Config Units = [mm/d]
1625	CALL getin_p("CWRR_KS",ks)
1626
1627	!! Check parameter value (correct range)
1628	IF ( ANY(ks(:) <= zero) ) THEN
1629	CALL ipslerr_p(error_level, "hydrol_init.", &
1630	& "Wrong parameter value for CWRR_KS.", &
1631	& "This parameter should be positive. ", &
1632	& "Please, check parameter value in run.def. ")
1633	END IF
1634
1635
1636	!Config Key = WETNESS_TRANSPIR_MAX
1637	!Config Desc = Soil moisture above which transpir is max
1638	!Config If = HYDROL_CWRR
1639	!Config Def = 0.5, 0.5, 0.5
1640	!Config Help = This parameter is independent from soil texture for
1641	!Config the time being.
1642	!Config Units = [-]
1643	CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
1644
1645	!! Check parameter value (correct range)
1646	IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
1647	CALL ipslerr_p(error_level, "hydrol_init.", &
1648	& "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
1649	& "This parameter should be positive and less or equals than 1. ", &
1650	& "Please, check parameter value in run.def. ")
1651	END IF
1652
1653
1654	!Config Key = VWC_FC
1655	!Config Desc = Volumetric water content field capacity
1656	!Config If = HYDROL_CWRR
1657	!Config Def = 0.32, 0.32, 0.32
1658	!Config Help = This parameter is independent from soil texture for
1659	!Config the time being.
1660	!Config Units = [m3/m3]
1661	CALL getin_p("VWC_FC",mcfc)
1662
1663	!! Check parameter value (correct range)
1664	IF ( ANY(mcfc(:) > mcs(:)) ) THEN
1665	CALL ipslerr_p(error_level, "hydrol_init.", &
1666	& "Wrong parameter value for VWC_FC.", &
1667	& "This parameter should be less than VWC_SAT. ", &
1668	& "Please, check parameter value in run.def. ")
1669	END IF
1670
1671
1672	!Config Key = VWC_WP
1673	!Config Desc = Volumetric water content Wilting pt
1674	!Config If = HYDROL_CWRR
1675	!Config Def = 0.10, 0.10, 0.10
1676	!Config Help = This parameter is independent from soil texture for
1677	!Config the time being.
1678	!Config Units = [m3/m3]
1679	CALL getin_p("VWC_WP",mcw)
1680
1681	!! Check parameter value (correct range)
1682	IF ( ANY(mcw(:) > mcfc(:)) .OR. ANY(mcw(:) < mcr(:)) ) THEN
1683	CALL ipslerr_p(error_level, "hydrol_init.", &
1684	& "Wrong parameter value for VWC_WP.", &
1685	& "This parameter should be greater or equal than VWC_RESIDUAL and less or equal than VWC_SAT.", &
1686	& "Please, check parameter value in run.def. ")
1687	END IF
1688
1689
1690	!Config Key = VWC_MIN_FOR_WET_ALB
1691	!Config Desc = Vol. wat. cont. above which albedo is cst
1692	!Config If = HYDROL_CWRR
1693	!Config Def = 0.25, 0.25, 0.25
1694	!Config Help = This parameter is independent from soil texture for
1695	!Config the time being.
1696	!Config Units = [m3/m3]
1697	CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
1698
1699	!! Check parameter value (correct range)
1700	IF ( ANY(mc_awet(:) < 0) ) THEN
1701	CALL ipslerr_p(error_level, "hydrol_init.", &
1702	& "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
1703	& "This parameter should be positive. ", &
1704	& "Please, check parameter value in run.def. ")
1705	END IF
1706
1707
1708	!Config Key = VWC_MAX_FOR_DRY_ALB
1709	!Config Desc = Vol. wat. cont. below which albedo is cst
1710	!Config If = HYDROL_CWRR
1711	!Config Def = 0.1, 0.1, 0.1
1712	!Config Help = This parameter is independent from soil texture for
1713	!Config the time being.
1714	!Config Units = [m3/m3]
1715	CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
1716
1717	!! Check parameter value (correct range)
1718	IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
1719	CALL ipslerr_p(error_level, "hydrol_init.", &
1720	& "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
1721	& "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
1722	& "Please, check parameter value in run.def. ")
1723	END IF
1724
1725
1726	!! 3 Other array allocation
1727
1728
1729	ALLOCATE (mask_veget(kjpindex,nvm),stat=ier)
1730	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_veget','','')
1731
1732	ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier)
1733	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_soiltile','','')
1734
1735	ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier)
1736	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humrelv','','')
1737
1738	ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier)
1739	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegstressv','','')
1740
1741	ALLOCATE (us(kjpindex,nvm,nstm,nslm),stat=ier)
1742	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable us','','')
1743
1744	ALLOCATE (precisol(kjpindex,nvm),stat=ier)
1745	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol','','')
1746
1747	ALLOCATE (throughfall(kjpindex,nvm),stat=ier)
1748	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable throughfall','','')
1749
1750	ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier)
1751	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol_nc','','')
1752
1753	ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier)
1754	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_coef','','')
1755
1756	ALLOCATE (ratio_soil(kjpindex,nvm,nstm),stat=ier) !IGEM
1757	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocateofvariableratio_soil','','') !IGEM
1758
1759	ALLOCATE (zwt_force(kjpindex,nstm),stat=ier)
1760	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_force','','')
1761
1762	ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier)
1763	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_bare_ns','','')
1764
1765	ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
1766	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable water2infilt','','')
1767
1768	ALLOCATE (ae_ns(kjpindex,nstm),stat=ier)
1769	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ae_ns','','')
1770
1771	!!$ ALLOCATE (evap_bare_lim_ns(kjpindex,nstm),stat=ier)
1772	!!$ IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable evap_bare_lim_ns','','')
1773
1774	ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier)
1775	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rootsink','','')
1776
1777	ALLOCATE (subsnowveg(kjpindex),stat=ier)
1778	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnowveg','','')
1779
1780	ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier)
1781	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnownobio','','')
1782
1783	ALLOCATE (icemelt(kjpindex),stat=ier)
1784	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable icemelt','','')
1785
1786	ALLOCATE (subsinksoil(kjpindex),stat=ier)
1787	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsinksoil','','')
1788
1789	ALLOCATE (mx_eau_var(kjpindex),stat=ier)
1790	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mx_eau_var','','')
1791
1792	ALLOCATE (vegtot(kjpindex),stat=ier)
1793	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot','','')
1794
1795	ALLOCATE (vegtot_old(kjpindex),stat=ier)
1796	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot_old','','')
1797
1798	ALLOCATE (resdist(kjpindex,nstm),stat=ier)
1799	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resdist','','')
1800
1801	ALLOCATE (humtot(kjpindex),stat=ier)
1802	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot','','')
1803
1804	ALLOCATE (humtot_ns(kjpindex,nstm),stat=ier) !IGEM
1805	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot_ns','','')
1806
1807	ALLOCATE (resolv(kjpindex),stat=ier)
1808	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resolv','','')
1809
1810	ALLOCATE (k(kjpindex,nslm),stat=ier)
1811	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k','','')
1812
1813	ALLOCATE (kk_moy(kjpindex,nslm),stat=ier)
1814	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk_moy','','')
1815	kk_moy(:,:) = 276.48
1816
1817	ALLOCATE (kk(kjpindex,nslm,nstm),stat=ier)
1818	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk','','')
1819	kk(:,:,:) = 276.48
1820
1821	ALLOCATE (avan_mod_tab(nslm,nscm),stat=ier)
1822	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan_mod_tab','','')
1823
1824	ALLOCATE (nvan_mod_tab(nslm,nscm),stat=ier)
1825	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan_mod_tab','','')
1826
1827	ALLOCATE (a(kjpindex,nslm),stat=ier)
1828	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a','','')
1829
1830	ALLOCATE (b(kjpindex,nslm),stat=ier)
1831	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b','','')
1832
1833	ALLOCATE (d(kjpindex,nslm),stat=ier)
1834	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d','','')
1835
1836	ALLOCATE (e(kjpindex,nslm),stat=ier)
1837	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable e','','')
1838
1839	ALLOCATE (f(kjpindex,nslm),stat=ier)
1840	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable f','','')
1841
1842	ALLOCATE (g1(kjpindex,nslm),stat=ier)
1843	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable g1','','')
1844
1845	ALLOCATE (ep(kjpindex,nslm),stat=ier)
1846	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ep','','')
1847
1848	ALLOCATE (fp(kjpindex,nslm),stat=ier)
1849	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable fp','','')
1850
1851	ALLOCATE (gp(kjpindex,nslm),stat=ier)
1852	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable gp','','')
1853
1854	ALLOCATE (rhs(kjpindex,nslm),stat=ier)
1855	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rhs','','')
1856
1857	ALLOCATE (srhs(kjpindex,nslm),stat=ier)
1858	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable srhs','','')
1859
1860	ALLOCATE (tmc(kjpindex,nstm),stat=ier)
1861	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc','','')
1862
1863	ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
1864	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcs','','')
1865
1866	ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
1867	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcr','','')
1868
1869	ALLOCATE (tmcfc(kjpindex,nstm),stat=ier)
1870	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcfc','','')
1871
1872	ALLOCATE (tmcw(kjpindex,nstm),stat=ier)
1873	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcw','','')
1874
1875	ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
1876	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter','','')
1877
1878	ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
1879	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_mea','','')
1880
1881	ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
1882	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_res','','')
1883
1884	ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
1885	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_wilt','','')
1886
1887	ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
1888	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_field','','')
1889
1890	ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
1891	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_sat','','')
1892
1893	ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
1894	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_awet','','')
1895
1896	ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
1897	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_adry','','')
1898
1899	ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
1900	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_wet_mea','','')
1901
1902	ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
1903	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_dry_mea','','')
1904
1905	ALLOCATE (v1(kjpindex,nstm),stat=ier)
1906	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable v1','','')
1907
1908	ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
1909	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ru_ns','','')
1910	ru_ns(:,:) = zero
1911
1912	ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
1913	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dr_ns','','')
1914	dr_ns(:,:) = zero
1915
1916	ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
1917	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tr_ns','','')
1918
1919	ALLOCATE (vegetmax_soil(kjpindex,nvm,nstm),stat=ier)
1920	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegetmax_soil','','')
1921
1922	ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
1923	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc','','')
1924
1925	ALLOCATE (lateral_sink(kjpindex,nslm,nstm),stat=ier) !IGEM
1926	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable lateral_sink','','') !IGEM
1927
1928
1929	! Variables for nudging of soil moisture
1930	IF (ok_nudge_mc) THEN
1931	ALLOCATE (mc_read_prev(kjpindex,nslm,nstm),stat=ier)
1932	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_prev','','')
1933	ALLOCATE (mc_read_next(kjpindex,nslm,nstm),stat=ier)
1934	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_next','','')
1935	ALLOCATE (mask_mc_interp(kjpindex,nslm,nstm),stat=ier)
1936	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_mc_interp','','')
1937	END IF
1938
1939	! Variables for nudging of snow variables
1940	IF (ok_nudge_snow) THEN
1941	ALLOCATE (snowdz_read_prev(kjpindex,nsnow),stat=ier)
1942	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_prev','','')
1943	ALLOCATE (snowdz_read_next(kjpindex,nsnow),stat=ier)
1944	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_next','','')
1945
1946	ALLOCATE (snowrho_read_prev(kjpindex,nsnow),stat=ier)
1947	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_prev','','')
1948	ALLOCATE (snowrho_read_next(kjpindex,nsnow),stat=ier)
1949	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_next','','')
1950
1951	ALLOCATE (snowtemp_read_prev(kjpindex,nsnow),stat=ier)
1952	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_prev','','')
1953	ALLOCATE (snowtemp_read_next(kjpindex,nsnow),stat=ier)
1954	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_next','','')
1955
1956	ALLOCATE (mask_snow_interp(kjpindex,nsnow),stat=ier)
1957	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_snow_interp','','')
1958	END IF
1959
1960	ALLOCATE (mcl(kjpindex, nslm, nstm),stat=ier)
1961	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcl','','')
1962
1963	IF (ok_freeze_cwrr) THEN
1964	ALLOCATE (profil_froz_hydro(kjpindex, nslm),stat=ier)
1965	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydrol','','')
1966	profil_froz_hydro(:,:) = zero
1967
1968	ALLOCATE (temp_hydro(kjpindex, nslm),stat=ier)
1969	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable temp_hydro','','')
1970	temp_hydro(:,:) = 280.
1971	ENDIF
1972
1973	ALLOCATE (profil_froz_hydro_ns(kjpindex, nslm, nstm),stat=ier)
1974	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydro_ns','','')
1975	profil_froz_hydro_ns(:,:,:) = zero
1976
1977	ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
1978	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
1979
1980	ALLOCATE (soilmoist_liquid(kjpindex,nslm),stat=ier)
1981	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist_liquid','','')
1982
1983	ALLOCATE (soil_wet_ns(kjpindex,nslm,nstm),stat=ier)
1984	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_ns','','')
1985
1986	ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
1987	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_litter','','')
1988
1989	ALLOCATE (qflux(kjpindex,nslm,nstm),stat=ier)
1990	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux','','')
1991
1992	ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
1993	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmat','','')
1994
1995	ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
1996	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable stmat','','')
1997
1998	ALLOCATE (nroot(kjpindex,nvm, nslm),stat=ier)
1999	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nroot','','')
2000
2001	ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
2002	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact_root','','')
2003
2004	ALLOCATE (kfact(nslm, nscm),stat=ier)
2005	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact','','')
2006
2007	ALLOCATE (zz(nslm),stat=ier)
2008	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zz','','')
2009
2010	ALLOCATE (dz(nslm),stat=ier)
2011	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dz','','')
2012
2013	ALLOCATE (dh(nslm),stat=ier)
2014	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dh','','')
2015
2016	ALLOCATE (mc_lin(imin:imax, nscm),stat=ier)
2017	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_lin','','')
2018
2019	ALLOCATE (k_lin(imin:imax, nslm, nscm),stat=ier)
2020	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k_lin','','')
2021
2022	ALLOCATE (d_lin(imin:imax, nslm, nscm),stat=ier)
2023	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d_lin','','')
2024
2025	ALLOCATE (a_lin(imin:imax, nslm, nscm),stat=ier)
2026	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a_lin','','')
2027
2028	ALLOCATE (b_lin(imin:imax, nslm, nscm),stat=ier)
2029	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b_lin','','')
2030
2031	ALLOCATE (undermcr(kjpindex),stat=ier)
2032	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable undermcr','','')
2033
2034	ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
2035	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watveg_beg','','')
2036
2037	ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
2038	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watvag_end','','')
2039
2040	ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
2041	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_beg','','')
2042
2043	ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
2044	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_end','','')
2045
2046	ALLOCATE (delsoilmoist(kjpindex),stat=ier)
2047	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delsoilmoist','','')
2048
2049	ALLOCATE (delintercept(kjpindex),stat=ier)
2050	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delintercept','','')
2051
2052	ALLOCATE (delswe(kjpindex),stat=ier)
2053	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delswe','','')
2054
2055	ALLOCATE (snow_beg(kjpindex),stat=ier)
2056	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_beg','','')
2057
2058	ALLOCATE (snow_end(kjpindex),stat=ier)
2059	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_end','','')
2060
2061	!! 4 Open restart input file and read data for HYDROLOGIC process
2062	IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
2063
2064	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
2065	!
2066	DO jst=1,nstm
2067	! var_name= "mc_1" ... "mc_3"
2068	WRITE (var_name,"('moistc_',I1)") jst
2069	IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
2070	CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc(:,:,jst), "gather", nbp_glo, index_g)
2071	END DO
2072
2073	IF (ok_nudge_mc) THEN
2074	DO jst=1,nstm
2075	WRITE (var_name,"('mc_read_next_',I1)") jst
2076	IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME','Soil moisture read from nudging file')
2077	CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mc_read_next(:,:,jst), &
2078	"gather", nbp_glo, index_g)
2079	END DO
2080	END IF
2081
2082	IF (ok_nudge_snow) THEN
2083	IF (is_root_prc) THEN
2084	CALL ioconf_setatt_p('UNITS', 'm')
2085	CALL ioconf_setatt_p('LONG_NAME','Snow layer thickness read from nudging file')
2086	ENDIF
2087	CALL restget_p (rest_id, 'snowdz_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowdz_read_next, &
2088	"gather", nbp_glo, index_g)
2089
2090	IF (is_root_prc) THEN
2091	CALL ioconf_setatt_p('UNITS', 'kg/m^3')
2092	CALL ioconf_setatt_p('LONG_NAME','Snow density profile read from nudging file')
2093	ENDIF
2094	CALL restget_p (rest_id, 'snowrho_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowrho_read_next, &
2095	"gather", nbp_glo, index_g)
2096
2097	IF (is_root_prc) THEN
2098	CALL ioconf_setatt_p('UNITS', 'K')
2099	CALL ioconf_setatt_p('LONG_NAME','Snow temperature read from nudging file')
2100	ENDIF
2101	CALL restget_p (rest_id, 'snowtemp_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowtemp_read_next, &
2102	"gather", nbp_glo, index_g)
2103	END IF
2104
2105	DO jst=1,nstm
2106	! var_name= "mcl_1" ... "mcl_3"
2107	WRITE (var_name,"('moistcl_',I1)") jst
2108	IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
2109	CALL restget_p (rest_id, var_name, nbp_glo, nslm , 1, kjit, .TRUE., mcl(:,:,jst), "gather", nbp_glo, index_g)
2110	END DO
2111
2112	IF (is_root_prc) CALL ioconf_setatt_p('UNITS', '-')
2113	DO jst=1,nstm
2114	DO jsl=1,nslm
2115	! var_name= "us_1_01" ... "us_3_11"
2116	!WRITE (var_name,"('us_',i1,'_',i2.2)") jst,jsl
2117	WRITE (var_name,"('us_',i1,'_',i3.3)") jst,jsl !IGEM
2118	IF (is_root_prc) CALL ioconf_setatt_p('LONG_NAME',var_name)
2119	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., us(:,:,jst,jsl), "gather", nbp_glo, index_g)
2120	END DO
2121	END DO
2122	!
2123	var_name= 'free_drain_coef'
2124	IF (is_root_prc) THEN
2125	CALL ioconf_setatt_p('UNITS', '-')
2126	CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
2127	ENDIF
2128	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
2129	!
2130	var_name= 'zwt_force'
2131	IF (is_root_prc) THEN
2132	CALL ioconf_setatt_p('UNITS', 'm')
2133	CALL ioconf_setatt_p('LONG_NAME','Prescribed water table depth')
2134	ENDIF
2135	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., zwt_force, "gather", nbp_glo, index_g)
2136	!
2137	var_name= 'water2infilt'
2138	IF (is_root_prc) THEN
2139	CALL ioconf_setatt_p('UNITS', '-')
2140	CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
2141	ENDIF
2142	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
2143	!
2144	var_name= 'ae_ns'
2145	IF (is_root_prc) THEN
2146	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
2147	CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
2148	ENDIF
2149	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
2150	!
2151	var_name= 'snow'
2152	IF (is_root_prc) THEN
2153	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
2154	CALL ioconf_setatt_p('LONG_NAME','Snow mass')
2155	ENDIF
2156	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
2157	!
2158	var_name= 'snow_age'
2159	IF (is_root_prc) THEN
2160	CALL ioconf_setatt_p('UNITS', 'd')
2161	CALL ioconf_setatt_p('LONG_NAME','Snow age')
2162	ENDIF
2163	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
2164	!
2165	var_name= 'snow_nobio'
2166	IF (is_root_prc) THEN
2167	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
2168	CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
2169	ENDIF
2170	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
2171	!
2172	var_name= 'snow_nobio_age'
2173	IF (is_root_prc) THEN
2174	CALL ioconf_setatt_p('UNITS', 'd')
2175	CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
2176	ENDIF
2177	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
2178	!
2179	var_name= 'qsintveg'
2180	IF (is_root_prc) THEN
2181	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
2182	CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
2183	ENDIF
2184	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
2185
2186	var_name= 'evap_bare_lim_ns'
2187	IF (is_root_prc) THEN
2188	CALL ioconf_setatt_p('UNITS', '?')
2189	CALL ioconf_setatt_p('LONG_NAME','?')
2190	ENDIF
2191	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., evap_bare_lim_ns, "gather", nbp_glo, index_g)
2192	CALL setvar_p (evap_bare_lim_ns, val_exp, 'NO_KEYWORD', 0.0)
2193
2194	var_name= 'resdist'
2195	IF (is_root_prc) THEN
2196	CALL ioconf_setatt_p('UNITS', '-')
2197	CALL ioconf_setatt_p('LONG_NAME','soiltile values from previous time-step')
2198	ENDIF
2199	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
2200
2201	var_name= 'vegtot_old'
2202	IF (is_root_prc) THEN
2203	CALL ioconf_setatt_p('UNITS', '-')
2204	CALL ioconf_setatt_p('LONG_NAME','vegtot from previous time-step')
2205	ENDIF
2206	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_old, "gather", nbp_glo, index_g)
2207
2208	! Read drysoil_frac. It will be initalized later in hydrol_var_init if the varaible is not find in restart file.
2209	IF (is_root_prc) THEN
2210	CALL ioconf_setatt_p('UNITS', '')
2211	CALL ioconf_setatt_p('LONG_NAME','Function of litter wetness')
2212	ENDIF
2213	CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1 , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
2214
2215
2216	!! 5 get restart values if none were found in the restart file
2217	!
2218	!Config Key = HYDROL_MOISTURE_CONTENT
2219	!Config Desc = Soil moisture on each soil tile and levels
2220	!Config If = HYDROL_CWRR
2221	!Config Def = 0.3
2222	!Config Help = The initial value of mc if its value is not found
2223	!Config in the restart file. This should only be used if the model is
2224	!Config started without a restart file.
2225	!Config Units = [m3/m3]
2226	!
2227
2228	CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
2229
2230	!Initialize mcl as mc if it is not found in the restart file
2231	!IF ( ALL(mcl(:,:,:)==val_exp) ) THEN
2232	! init_tile4_moisture = mc(1,1,1) !TVIGEM
2233	! CALL getin_p("HYDROL_MOISTURE_CONTENT_TILE4",init_tile4_moisture)
2234	! mc(:,:,4) = init_tile4_moisture
2235	! mcl(:,:,:) = mc(:,:,:)
2236	!END IF
2237	!End TVIGEM
2238
2239
2240	!Config Key = US_INIT
2241	!Config Desc = US_NVM_NSTM_NSLM
2242	!Config If = HYDROL_CWRR
2243	!Config Def = 0.0
2244	!Config Help = The initial value of us (relative moisture) if its value is not found
2245	!Config in the restart file. This should only be used if the model is
2246	!Config started without a restart file.
2247	!Config Units = [-]
2248	!
2249	DO jsl=1,nslm
2250	CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
2251	ENDDO
2252	!
2253	!Config Key = ZWT_FORCE
2254	!Config Desc = Prescribed water depth, dimension nstm
2255	!Config If = HYDROL_CWRR
2256	!Config Def = undef undef undef
2257	!Config Help = The initial value of zwt_force if its value is not found
2258	!Config in the restart file. undef corresponds to a case whith no forced WT.
2259	!Config This should only be used if the model is started without a restart file.
2260	!Config Units = [m]
2261
2262	ALLOCATE (zwt_default(nstm),stat=ier)
2263	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_default','','')
2264	zwt_default(:) = undef_sechiba
2265	CALL setvar_p (zwt_force, val_exp, 'ZWT_FORCE', zwt_default , .TRUE.) !TVIGEM2018 (.TRUE.)
2266
2267	zforce = .FALSE.
2268	DO jst=1,nstm
2269	IF (zwt_force(1,jst) <= zmaxh) zforce = .TRUE. ! AD16*** check if OK with vertical_soil
2270	ENDDO
2271	!
2272	!Config Key = FREE_DRAIN_COEF
2273	!Config Desc = Coefficient for free drainage at bottom, dimension nstm
2274	!Config If = HYDROL_CWRR
2275	!Config Def = 1.0 1.0 1.0 0.0 IGEM (tile 4 , free_drain_coef=0) IGEM
2276	!Config Help = The initial value of free drainage coefficient if its value is not found
2277	!Config in the restart file. This should only be used if the model is
2278	!Config started without a restart file.
2279	!Config Units = [-]
2280
2281	ALLOCATE (free_drain_max(nstm),stat=ier)
2282	! ALLOCATE (free_drain_max(kjpindex,nstm),stat=ier)
2283	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_max','','')
2284	free_drain_max(:) = undef_sechiba !1.0
2285	CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max, .TRUE.) !TVIGEM2018 (.TRUE.)
2286
2287	!! CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
2288	!IF (printlev>=2) WRITE (numout,*) ' hydrol_init => free_drain_coef = ',free_drain_coef(1,:)
2289	DEALLOCATE(free_drain_max)
2290
2291
2292	! CALL getin_p("FREEDRAIN1",free_drain_val)
2293	! free_drain_coef(:,1) = free_drain_val
2294	! CALL getin_p("FREEDRAIN2",free_drain_val)
2295	! free_drain_coef(:,2) = free_drain_val
2296	! CALL getin_p("FREEDRAIN3",free_drain_val)
2297	! free_drain_coef(:,3) = free_drain_val
2298	! CALL getin_p("FREEDRAIN4",free_drain_val)
2299	! free_drain_coef(:,4) = free_drain_val
2300
2301	!write(numout,*) 'FREEDRAIN1',free_drain_coef(:,1)
2302	!write(numout,*) 'FREEDRAIN2',free_drain_coef(:,2)
2303	!write(numout,*) 'FREEDRAIN3',free_drain_coef(:,3)
2304	!write(numout,*) 'FREEDRAIN4',free_drain_coef(:,4)
2305
2306	!IGEM:
2307	!Correction provisoire, peut-etre une erreur dans le parallelisme lors de
2308	!la lecture du run.def. Lerreur semble etre corrigee pour 127 proc avec l'ajout de .TRUE.
2309	!dans setvar_p mais pas sur a 100% que ca marche quelque soit le nombre de
2310	!proc. Par prudence pour IGEM on force les valeurs qui nous interesse.
2311	!Verif complete a faire pour la version finale!
2312	!free_drain_coef(:,1) = 1.0
2313	!free_drain_coef(:,2) = 1.0
2314	!free_drain_coef(:,3) = 1.0
2315	!free_drain_coef(:,4) = 0.0
2316	!End IGEM
2317
2318	!
2319	!Config Key = WATER_TO_INFILT
2320	!Config Desc = Water to be infiltrated on top of the soil
2321	!Config If = HYDROL_CWRR
2322	!Config Def = 0.0
2323	!Config Help = The initial value of free drainage if its value is not found
2324	!Config in the restart file. This should only be used if the model is
2325	!Config started without a restart file.
2326	!Config Units = [mm]
2327	!
2328	CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
2329	!
2330	!Config Key = EVAPNU_SOIL
2331	!Config Desc = Bare soil evap on each soil if not found in restart
2332	!Config If = HYDROL_CWRR
2333	!Config Def = 0.0
2334	!Config Help = The initial value of bare soils evap if its value is not found
2335	!Config in the restart file. This should only be used if the model is
2336	!Config started without a restart file.
2337	!Config Units = [mm]
2338	!
2339	CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
2340	!
2341	!Config Key = HYDROL_SNOW
2342	!Config Desc = Initial snow mass if not found in restart
2343	!Config If = OK_SECHIBA
2344	!Config Def = 0.0
2345	!Config Help = The initial value of snow mass if its value is not found
2346	!Config in the restart file. This should only be used if the model is
2347	!Config started without a restart file.
2348	!Config Units =
2349	!
2350	CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
2351	!
2352	!Config Key = HYDROL_SNOWAGE
2353	!Config Desc = Initial snow age if not found in restart
2354	!Config If = OK_SECHIBA
2355	!Config Def = 0.0
2356	!Config Help = The initial value of snow age if its value is not found
2357	!Config in the restart file. This should only be used if the model is
2358	!Config started without a restart file.
2359	!Config Units = ***
2360	!
2361	CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
2362	!
2363	!Config Key = HYDROL_SNOW_NOBIO
2364	!Config Desc = Initial snow amount on ice, lakes, etc. if not found in restart
2365	!Config If = OK_SECHIBA
2366	!Config Def = 0.0
2367	!Config Help = The initial value of snow if its value is not found
2368	!Config in the restart file. This should only be used if the model is
2369	!Config started without a restart file.
2370	!Config Units = [mm]
2371	!
2372	CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
2373	!
2374	!Config Key = HYDROL_SNOW_NOBIO_AGE
2375	!Config Desc = Initial snow age on ice, lakes, etc. if not found in restart
2376	!Config If = OK_SECHIBA
2377	!Config Def = 0.0
2378	!Config Help = The initial value of snow age if its value is not found
2379	!Config in the restart file. This should only be used if the model is
2380	!Config started without a restart file.
2381	!Config Units = ***
2382	!
2383	CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
2384	!
2385	!Config Key = HYDROL_QSV
2386	!Config Desc = Initial water on canopy if not found in restart
2387	!Config If = OK_SECHIBA
2388	!Config Def = 0.0
2389	!Config Help = The initial value of moisture on canopy if its value
2390	!Config is not found in the restart file. This should only be used if
2391	!Config the model is started without a restart file.
2392	!Config Units = [mm]
2393	!
2394	CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
2395
2396	!! 6 Vegetation array
2397	!
2398	! If resdist is not in restart file, initialize with soiltile
2399	IF ( MINVAL(resdist) .EQ. MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
2400	resdist(:,:) = soiltile(:,:)
2401	ENDIF
2402
2403	!
2404	! Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
2405	!
2406	IF ( ALL(vegtot_old(:) == val_exp) ) THEN
2407	! vegtot_old was not found in restart file
2408	DO ji = 1, kjpindex
2409	vegtot_old(ji) = SUM(veget_max(ji,:))
2410	ENDDO
2411	ENDIF
2412
2413	! In the initialization phase, vegtot must take the value from previous time-step.
2414	! This is because hydrol_main is done before veget_max is updated in the end of the time step.
2415	vegtot(:) = vegtot_old(:)
2416
2417	!
2418	!
2419	! compute the masks for veget
2420
2421	mask_veget(:,:) = 0
2422	mask_soiltile(:,:) = 0
2423
2424	DO jst=1,nstm
2425	DO ji = 1, kjpindex
2426	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
2427	mask_soiltile(ji,jst) = 1
2428	ENDIF
2429	END DO
2430	ENDDO
2431
2432	DO jv = 1, nvm
2433	DO ji = 1, kjpindex
2434	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
2435	mask_veget(ji,jv) = 1
2436	ENDIF
2437	END DO
2438	END DO
2439
2440	humrelv(:,:,:) = SUM(us,dim=4)
2441
2442
2443	!! 7a. Set vegstress
2444
2445	var_name= 'vegstress'
2446	IF (is_root_prc) THEN
2447	CALL ioconf_setatt_p('UNITS', '-')
2448	CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
2449	ENDIF
2450	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
2451
2452	vegstressv(:,:,:) = humrelv(:,:,:)
2453	! Calculate vegstress if it is not found in restart file
2454	IF (ALL(vegstress(:,:)==val_exp)) THEN
2455	DO jst=1,nstm !IGEM
2456	DO jv=1,nvm
2457	DO ji=1,kjpindex
2458	vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,jst)*ratio_soil(ji,jv,jst) !IGEM
2459	END DO
2460	END DO
2461	END DO !IGEM
2462	END IF
2463	!! 7b. Set humrel
2464	! Read humrel from restart file
2465	var_name= 'humrel'
2466	IF (is_root_prc) THEN
2467	CALL ioconf_setatt_p('UNITS', '')
2468	CALL ioconf_setatt_p('LONG_NAME','Relative humidity')
2469	ENDIF
2470	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
2471
2472	! Calculate humrel if it is not found in restart file
2473	IF (ALL(humrel(:,:)==val_exp)) THEN
2474	! set humrel from humrelv, assuming equi-repartition for the first time step
2475	humrel(:,:) = zero
2476	DO jst=1,nstm !IGEM
2477	DO jv=1,nvm
2478	DO ji=1,kjpindex
2479	humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,jst)*ratio_soil(ji,jv,jst) !IGEM
2480	END DO
2481	END DO
2482	END DO !IGEM
2483	END IF
2484
2485	! Read evap_bare_lim from restart file
2486	var_name= 'evap_bare_lim'
2487	IF (is_root_prc) THEN
2488	CALL ioconf_setatt_p('UNITS', '')
2489	CALL ioconf_setatt_p('LONG_NAME','Limitation factor for bare soil evaporation')
2490	ENDIF
2491	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evap_bare_lim, "gather", nbp_glo, index_g)
2492
2493	! Calculate evap_bare_lim if it was not found in the restart file.
2494	IF ( ALL(evap_bare_lim(:) == val_exp) ) THEN
2495	DO ji = 1, kjpindex
2496	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
2497	ENDDO
2498	END IF
2499
2500
2501	! Read from restart file
2502	! The variables tot_watsoil_beg, tot_watsoil_beg and snwo_beg will be initialized in the end of
2503	! hydrol_initialize if they were not found in the restart file.
2504
2505	var_name= 'tot_watveg_beg'
2506	IF (is_root_prc) THEN
2507	CALL ioconf_setatt_p('UNITS', '?')
2508	CALL ioconf_setatt_p('LONG_NAME','?')
2509	ENDIF
2510	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watveg_beg, "gather", nbp_glo, index_g)
2511
2512	var_name= 'tot_watsoil_beg'
2513	IF (is_root_prc) THEN
2514	CALL ioconf_setatt_p('UNITS', '?')
2515	CALL ioconf_setatt_p('LONG_NAME','?')
2516	ENDIF
2517	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watsoil_beg, "gather", nbp_glo, index_g)
2518
2519	var_name= 'snow_beg'
2520	IF (is_root_prc) THEN
2521	CALL ioconf_setatt_p('UNITS', '?')
2522	CALL ioconf_setatt_p('LONG_NAME','?')
2523	ENDIF
2524	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., snow_beg, "gather", nbp_glo, index_g)
2525
2526
2527	! Initialize variables for explictsnow module by reading restart file
2528	IF (ok_explicitsnow) THEN
2529	CALL explicitsnow_initialize( kjit, kjpindex, rest_id, snowrho, &
2530	snowtemp, snowdz, snowheat, snowgrain)
2531	END IF
2532
2533
2534	! Initialize soil moisture for nudging if not found in restart file
2535	IF (ok_nudge_mc) THEN
2536	IF ( ALL(mc_read_next(:,:,:)==val_exp) ) mc_read_next(:,:,:) = mc(:,:,:)
2537	END IF
2538
2539	! Initialize snow variables for nudging if not found in restart file
2540	IF (ok_nudge_snow) THEN
2541	IF ( ALL(snowdz_read_next(:,:)==val_exp) ) snowdz_read_next(:,:) = snowdz(:,:)
2542	IF ( ALL(snowrho_read_next(:,:)==val_exp) ) snowrho_read_next(:,:) = snowrho(:,:)
2543	IF ( ALL(snowtemp_read_next(:,:)==val_exp) ) snowtemp_read_next(:,:) = snowtemp(:,:)
2544	END IF
2545
2546
2547	IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
2548
2549	END SUBROUTINE hydrol_init
2550
2551
2552	!! ================================================================================================================================
2553	!! SUBROUTINE : hydrol_clear
2554	!!
2555	!>\BRIEF Deallocate arrays
2556	!!
2557	!_ ================================================================================================================================
2558	!_ hydrol_clear
2559
2560	SUBROUTINE hydrol_clear()
2561
2562	! Allocation for soiltile related parameters
2563	IF ( ALLOCATED (nvan)) DEALLOCATE (nvan)
2564	IF ( ALLOCATED (avan)) DEALLOCATE (avan)
2565	IF ( ALLOCATED (mcr)) DEALLOCATE (mcr)
2566	IF ( ALLOCATED (mcs)) DEALLOCATE (mcs)
2567	IF ( ALLOCATED (ks)) DEALLOCATE (ks)
2568	IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
2569	IF ( ALLOCATED (mcfc)) DEALLOCATE (mcfc)
2570	IF ( ALLOCATED (mcw)) DEALLOCATE (mcw)
2571	IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
2572	IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
2573	! Other arrays
2574	IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
2575	IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
2576	IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
2577	IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
2578	IF (ALLOCATED (us)) DEALLOCATE (us)
2579	IF (ALLOCATED (precisol)) DEALLOCATE (precisol)
2580	IF (ALLOCATED (throughfall)) DEALLOCATE (throughfall)
2581	IF (ALLOCATED (precisol_ns)) DEALLOCATE (precisol_ns)
2582	IF (ALLOCATED (free_drain_coef)) DEALLOCATE (free_drain_coef)
2583	IF (ALLOCATED (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
2584	IF (ALLOCATED (water2infilt)) DEALLOCATE (water2infilt)
2585	IF (ALLOCATED (ae_ns)) DEALLOCATE (ae_ns)
2586	!!$ IF (ALLOCATED (evap_bare_lim_ns)) DEALLOCATE (evap_bare_lim_ns)
2587	IF (ALLOCATED (rootsink)) DEALLOCATE (rootsink)
2588	IF (ALLOCATED (subsnowveg)) DEALLOCATE (subsnowveg)
2589	IF (ALLOCATED (subsnownobio)) DEALLOCATE (subsnownobio)
2590	IF (ALLOCATED (icemelt)) DEALLOCATE (icemelt)
2591	IF (ALLOCATED (subsinksoil)) DEALLOCATE (subsinksoil)
2592	IF (ALLOCATED (mx_eau_var)) DEALLOCATE (mx_eau_var)
2593	IF (ALLOCATED (vegtot)) DEALLOCATE (vegtot)
2594	IF (ALLOCATED (vegtot_old)) DEALLOCATE (vegtot_old)
2595	IF (ALLOCATED (resdist)) DEALLOCATE (resdist)
2596	IF (ALLOCATED (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
2597	IF (ALLOCATED (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
2598	IF (ALLOCATED (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
2599	IF (ALLOCATED (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
2600	IF (ALLOCATED (delsoilmoist)) DEALLOCATE (delsoilmoist)
2601	IF (ALLOCATED (delintercept)) DEALLOCATE (delintercept)
2602	IF (ALLOCATED (snow_beg)) DEALLOCATE (snow_beg)
2603	IF (ALLOCATED (snow_end)) DEALLOCATE (snow_end)
2604	IF (ALLOCATED (delswe)) DEALLOCATE (delswe)
2605	IF (ALLOCATED (undermcr)) DEALLOCATE (undermcr)
2606	IF (ALLOCATED (v1)) DEALLOCATE (v1)
2607	IF (ALLOCATED (humtot)) DEALLOCATE (humtot)
2608	IF (ALLOCATED (humtot_ns)) DEALLOCATE (humtot_ns) !IGEM
2609	IF (ALLOCATED (resolv)) DEALLOCATE (resolv)
2610	IF (ALLOCATED (k)) DEALLOCATE (k)
2611	IF (ALLOCATED (kk)) DEALLOCATE (kk)
2612	IF (ALLOCATED (kk_moy)) DEALLOCATE (kk_moy)
2613	IF (ALLOCATED (avan_mod_tab)) DEALLOCATE (avan_mod_tab)
2614	IF (ALLOCATED (nvan_mod_tab)) DEALLOCATE (nvan_mod_tab)
2615	IF (ALLOCATED (a)) DEALLOCATE (a)
2616	IF (ALLOCATED (b)) DEALLOCATE (b)
2617	IF (ALLOCATED (d)) DEALLOCATE (d)
2618	IF (ALLOCATED (e)) DEALLOCATE (e)
2619	IF (ALLOCATED (f)) DEALLOCATE (f)
2620	IF (ALLOCATED (g1)) DEALLOCATE (g1)
2621	IF (ALLOCATED (ep)) DEALLOCATE (ep)
2622	IF (ALLOCATED (fp)) DEALLOCATE (fp)
2623	IF (ALLOCATED (gp)) DEALLOCATE (gp)
2624	IF (ALLOCATED (rhs)) DEALLOCATE (rhs)
2625	IF (ALLOCATED (srhs)) DEALLOCATE (srhs)
2626	IF (ALLOCATED (tmc)) DEALLOCATE (tmc)
2627	IF (ALLOCATED (tmcs)) DEALLOCATE (tmcs)
2628	IF (ALLOCATED (tmcr)) DEALLOCATE (tmcr)
2629	IF (ALLOCATED (tmcfc)) DEALLOCATE (tmcfc)
2630	IF (ALLOCATED (tmcw)) DEALLOCATE (tmcw)
2631	IF (ALLOCATED (tmc_litter)) DEALLOCATE (tmc_litter)
2632	IF (ALLOCATED (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
2633	IF (ALLOCATED (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
2634	IF (ALLOCATED (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
2635	IF (ALLOCATED (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
2636	IF (ALLOCATED (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
2637	IF (ALLOCATED (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
2638	IF (ALLOCATED (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
2639	IF (ALLOCATED (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
2640	IF (ALLOCATED (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
2641	IF (ALLOCATED (ru_ns)) DEALLOCATE (ru_ns)
2642	IF (ALLOCATED (dr_ns)) DEALLOCATE (dr_ns)
2643	IF (ALLOCATED (tr_ns)) DEALLOCATE (tr_ns)
2644	IF (ALLOCATED (vegetmax_soil)) DEALLOCATE (vegetmax_soil)
2645	IF (ALLOCATED (mc)) DEALLOCATE (mc)
2646	IF (ALLOCATED (soilmoist)) DEALLOCATE (soilmoist)
2647	IF (ALLOCATED (soilmoist_liquid)) DEALLOCATE (soilmoist_liquid)
2648	IF (ALLOCATED (soil_wet_ns)) DEALLOCATE (soil_wet_ns)
2649	IF (ALLOCATED (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
2650	IF (ALLOCATED (qflux)) DEALLOCATE (qflux)
2651	IF (ALLOCATED (tmat)) DEALLOCATE (tmat)
2652	IF (ALLOCATED (stmat)) DEALLOCATE (stmat)
2653	IF (ALLOCATED (nroot)) DEALLOCATE (nroot)
2654	IF (ALLOCATED (kfact_root)) DEALLOCATE (kfact_root)
2655	IF (ALLOCATED (kfact)) DEALLOCATE (kfact)
2656	IF (ALLOCATED (zz)) DEALLOCATE (zz)
2657	IF (ALLOCATED (dz)) DEALLOCATE (dz)
2658	IF (ALLOCATED (dh)) DEALLOCATE (dh)
2659	IF (ALLOCATED (mc_lin)) DEALLOCATE (mc_lin)
2660	IF (ALLOCATED (k_lin)) DEALLOCATE (k_lin)
2661	IF (ALLOCATED (d_lin)) DEALLOCATE (d_lin)
2662	IF (ALLOCATED (a_lin)) DEALLOCATE (a_lin)
2663	IF (ALLOCATED (b_lin)) DEALLOCATE (b_lin)
2664	IF (ALLOCATED (ratio_soil)) DEALLOCATE (ratio_soil) !IGEM
2665	IF (ALLOCATED (lateral_sink)) DEALLOCATE (lateral_sink) !IGEM
2666	END SUBROUTINE hydrol_clear
2667
2668	!! ================================================================================================================================
2669	!! SUBROUTINE : hydrol_tmc_update
2670	!!
2671	!>\BRIEF This routine updates the soil moisture profiles when the vegetation fraction have changed.
2672	!!
2673	!! DESCRIPTION :
2674	!!
2675	!! This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
2676	!!
2677	!!
2678	!!
2679	!!
2680	!! RECENT CHANGE(S) : Adaptation to excluding nobio from soiltile(1)
2681	!!
2682	!! MAIN OUTPUT VARIABLE(S) :
2683	!!
2684	!! REFERENCE(S) :
2685	!!
2686	!! FLOWCHART : None
2687	!! \n
2688	!_ ================================================================================================================================
2689	!_ hydrol_tmc_update
2690	SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
2691
2692	!! 0.1 Input variables
2693	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
2694	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! max fraction of vegetation type
2695	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile (0-1, unitless)
2696
2697	!! 0.2 Output variables
2698	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
2699	!! on mc [kg/m2/dt]
2700	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
2701	!! on water2infilt[kg/m2/dt]
2702
2703	!! 0.3 Modified variables
2704	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Amount of water in the canopy interception
2705
2706	!! 0.4 Local variables
2707	INTEGER(i_std) :: ji, jv, jst,jsl
2708	LOGICAL :: soil_upd !! True if soiltile changed since last time step
2709	LOGICAL :: vegtot_upd !! True if vegtot changed since last time step
2710	LOGICAL :: error=.FALSE. !! If true, exit in the end of subroutine
2711	REAL(r_std), DIMENSION(kjpindex,nstm) :: vmr !! Change in soiltile (within vegtot)
2712	REAL(r_std), DIMENSION(kjpindex) :: vmr_sum
2713	REAL(r_std), DIMENSION(kjpindex) :: delvegtot
2714	REAL(r_std), DIMENSION(kjpindex,nslm) :: mc_dilu !! Total loss of moisture content
2715	REAL(r_std), DIMENSION(kjpindex) :: infil_dilu !! Total loss for water2infilt
2716	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_old !! tmc before calculations
2717	REAL(r_std), DIMENSION(kjpindex,nstm) :: water2infilt_old!! water2infilt before calculations
2718	REAL(r_std), DIMENSION (kjpindex,nvm) :: qsintveg_old !! qsintveg before calculations
2719	REAL(r_std), DIMENSION(kjpindex) :: test
2720	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mcaux !! serves to hold the chnage in mc when vegtot decreases
2721
2722	!! 0. For checks
2723
2724	IF (check_cwrr) THEN
2725	! Save soil moisture for later use
2726	tmc_old(:,:) = tmc(:,:)
2727	water2infilt_old(:,:) = water2infilt(:,:)
2728	qsintveg_old(:,:) = qsintveg(:,:)
2729	ENDIF
2730
2731	!! 1. If a PFT has disapperead as result from a veget_max change,
2732	!! then add canopy water to surface water.
2733	! Other adaptations of qsintveg are delt by the normal functioning of hydrol_canop
2734
2735	DO ji=1,kjpindex
2736	IF (vegtot_old(ji) .GT.min_sechiba) THEN
2737	DO jv=1,nvm
2738	IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
2739	jst=pref_soil_veg(jv) ! soil tile index
2740	water2infilt(ji,jst) = water2infilt(ji,jst) + ratio_soil(ji,jv,jst)qsintveg(ji,jv)/(resdist(ji,jst)vegtot_old(ji))!IGEM
2741	water2infilt(ji,4) = water2infilt(ji,4) + ratio_soil(ji,jv,4)qsintveg(ji,jv)/(resdist(ji,4)vegtot_old(ji))!IGEM
2742	qsintveg(ji,jv) = zero
2743	ENDIF
2744	ENDDO
2745	ENDIF
2746	ENDDO
2747
2748
2749
2750
2751	!DO ji=1,kjpindex
2752	! IF (vegtot_old(ji) .GT.min_sechiba) THEN
2753	! DO jv=1,nvm
2754	! IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
2755	! jst=pref_soil_veg(jv) ! soil tile index
2756	! water2infilt(ji,jst) = water2infilt(ji,jst) + qsintveg(ji,jv)/(resdist(ji,jst)*vegtot_old(ji))
2757	! qsintveg(ji,jv) = zero
2758	! ENDIF
2759	! ENDDO
2760	! ENDIF
2761	!ENDDO
2762
2763	!! 2. We now deal with the changes of soiltile and corresponding soil moistures
2764	!! Because sum(soiltile)=1 whatever vegtot, we need to distinguish two cases:
2765	!! - when vegtot changes (meaning that the nobio fraction changes too),
2766	!! - and when vegtot does not changes (a priori the most frequent case)
2767
2768	vegtot_upd = SUM(ABS((vegtot(:)-vegtot_old(:)))) .GT. zero ! True if at least one land point with a vegtot change
2769	runoff_upd(:) = zero
2770	drain_upd(:) = zero
2771	IF (vegtot_upd) THEN
2772	! We find here the processing specific to the chnages of nobio fraction and vegtot
2773
2774	delvegtot(:) = vegtot(:) - vegtot_old(:)
2775
2776	DO jst=1,nstm
2777	DO ji=1,kjpindex
2778
2779	IF (delvegtot(ji) .GT. min_sechiba) THEN
2780
2781	!! 2.1. If vegtot increases (nobio decreases), then the mc in each soiltile is decreased
2782	!! assuming the same proportions for each soiltile, and each soil layer
2783
2784	mc(ji,:,jst) = mc(ji,:,jst) * vegtot_old(ji)/vegtot(ji) ! vegtot cannot be zero as > vegtot_old
2785	water2infilt(ji,jst) = water2infilt(ji,jst) * vegtot_old(ji)/vegtot(ji)
2786
2787	ELSE
2788
2789	!! 2.2 If vegtot decreases (nobio increases), then the mc in each soiltile should increase,
2790	!! but should not exceed mcs
2791	!! For simplicity, we choose to send the corresponding water volume to drainage
2792	!! We do the same for water2infilt but send the excess to surface runoff
2793
2794	IF (vegtot(ji) .GT.min_sechiba) THEN
2795	mcaux(ji,:,jst) = mc(ji,:,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji) ! mcaux is the delta mc
2796	ELSE ! we just have nobio in the grid-cell
2797	mcaux(ji,:,jst) = mc(ji,:,jst)
2798	ENDIF
2799
2800	drain_upd(ji) = drain_upd(ji) + dz(2) * ( trois*mcaux(ji,1,jst) + mcaux(ji,2,jst) )/huit
2801	DO jsl = 2,nslm-1
2802	drain_upd(ji) = drain_upd(ji) + dz(jsl) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl-1,jst))/huit &
2803	+ dz(jsl+1) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl+1,jst))/huit
2804	ENDDO
2805	drain_upd(ji) = drain_upd(ji) + dz(nslm) * (trois*mcaux(ji,nslm,jst) + mcaux(ji,nslm-1,jst))/huit
2806
2807	IF (vegtot(ji) .GT.min_sechiba) THEN
2808	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji)
2809	ELSE ! we just have nobio in the grid-cell
2810	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst)
2811	ENDIF
2812
2813	ENDIF
2814
2815	ENDDO
2816	ENDDO
2817
2818	ENDIF
2819
2820	!! 3. At the end of step 2, we are back to a case where vegtot changes are treated, so we can use soiltile
2821	!! as a fraction of vegtot to process the mc transfers between soil tiles due to the changes of vegetation map
2822
2823	!! 3.1 Check if soiltiles changed since last time step
2824	soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
2825	IF (printlev>=3) WRITE (numout,*) 'soil_upd ', soil_upd
2826
2827	IF (soil_upd) THEN
2828
2829	!! 3.2 Define the change in soiltile
2830	vmr(:,:) = soiltile(:,:) - resdist(:,:) ! resdist is the previous values of soiltiles, previous timestep, so before new map
2831
2832	! Total area loss by the three soil tiles
2833	DO ji=1,kjpindex
2834	vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
2835	ENDDO
2836
2837	!! 3.3 Shrinking soil tiles
2838	!! 3.3.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
2839	mc_dilu(:,:)=zero
2840	DO jst=1,nstm
2841	DO jsl = 1, nslm
2842	DO ji=1,kjpindex
2843	IF ( vmr(ji,jst) < -min_sechiba ) THEN
2844	mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * vmr(ji,jst) / vmr_sum(ji)
2845	ENDIF
2846	ENDDO
2847	ENDDO
2848	ENDDO
2849
2850	!! 3.3.2 Total loss of water2inft from the shrinking soil tiles
2851	infil_dilu(:)=zero
2852	DO jst=1,nstm
2853	DO ji=1,kjpindex
2854	IF ( vmr(ji,jst) < -min_sechiba ) THEN
2855	infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * vmr(ji,jst) / vmr_sum(ji)
2856	ENDIF
2857	ENDDO
2858	ENDDO
2859
2860	!! 3.4 Each gaining soil tile gets moisture proportionally to both the total loss and its areal increase
2861
2862	! As the original mc from each soil tile are in [mcr,mcs] and we do weighted avrage, the new mc are in [mcr,mcs]
2863	! The case where the soiltile is created (soiltile_old=0) works as the other cases
2864
2865	! 3.4.1 Update mc(kjpindex,nslm,nstm) !m3/m3
2866	DO jst=1,nstm
2867	DO jsl = 1, nslm
2868	DO ji=1,kjpindex
2869	IF ( vmr(ji,jst) > min_sechiba ) THEN
2870	mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
2871	! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
2872	ENDIF
2873	ENDDO
2874	ENDDO
2875	ENDDO
2876
2877	! 3.4.2 Update water2inft
2878	DO jst=1,nstm
2879	DO ji=1,kjpindex
2880	IF ( vmr(ji,jst) > min_sechiba ) THEN !donc soiltile>0
2881	water2infilt(ji,jst) = ( water2infilt(ji,jst) * resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / soiltile(ji,jst)
2882	ENDIF !donc resdist>0
2883	ENDDO
2884	ENDDO
2885
2886	! 3.4.3 Case where soiltile < min_sechiba
2887	DO jst=1,nstm
2888	DO ji=1,kjpindex
2889	IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
2890	water2infilt(ji,jst) = zero
2891	mc(ji,:,jst) = zero
2892	ENDIF
2893	ENDDO
2894	ENDDO
2895
2896	ENDIF ! soil_upd
2897
2898	!! 4. Update tmc and humtot
2899
2900	DO jst=1,nstm
2901	DO ji=1,kjpindex
2902	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
2903	DO jsl = 2,nslm-1
2904	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
2905	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
2906	ENDDO
2907	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
2908	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
2909	! WARNING tmc is increased by includes water2infilt(ji,jst)
2910	ENDDO
2911	ENDDO
2912
2913	humtot(:) = zero
2914	DO jst=1,nstm
2915	DO ji=1,kjpindex
2916	humtot(ji) = humtot(ji) + vegtot(ji) * soiltile(ji,jst) * tmc(ji,jst) ! average over grid-cell (i.e. total land)
2917	ENDDO
2918	ENDDO
2919
2920	!! 5. Check
2921	IF (check_cwrr) THEN
2922	DO ji=1,kjpindex
2923	test(ji) = SUM(tmc(ji,:)soiltile(ji,:)vegtot(ji)) - SUM(tmc_old(ji,:)resdist(ji,:)vegtot_old(ji)) + &
2924	SUM(qsintveg(ji,:)) - SUM(qsintveg_old(ji,:)) + (drain_upd(ji) + runoff_upd(ji))
2925	IF ( ABS(test(ji)) .GT. 10.*allowed_err ) THEN
2926	WRITE(numout,*) 'tmc update WRONG: ji',ji
2927	WRITE(numout,) 'tot water avant:',SUM(tmc_old(ji,:)resdist(ji,:)*vegtot_old(ji)) + SUM(qsintveg_old(ji,:))
2928	WRITE(numout,) 'tot water apres:',SUM(tmc(ji,:)soiltile(ji,:)*vegtot(ji)) + SUM(qsintveg(ji,:))
2929	WRITE(numout,*) 'err:',test(ji)
2930	WRITE(numout,*) 'allowed_err:',allowed_err
2931	WRITE(numout,*) 'tmc:',tmc(ji,:)
2932	WRITE(numout,*) 'tmc_old:',tmc_old(ji,:)
2933	WRITE(numout,*) 'qsintveg:',qsintveg(ji,:)
2934	WRITE(numout,*) 'qsintveg_old:',qsintveg_old(ji,:)
2935	WRITE(numout,*) 'SUMqsintveg:',SUM(qsintveg(ji,:))
2936	WRITE(numout,*) 'SUMqsintveg_old:',SUM(qsintveg_old(ji,:))
2937	WRITE(numout,*) 'veget_max:',veget_max(ji,:)
2938	WRITE(numout,*) 'soiltile:',soiltile(ji,:)
2939	WRITE(numout,*) 'resdist:',resdist(ji,:)
2940	WRITE(numout,*) 'vegtot:',vegtot(ji)
2941	WRITE(numout,*) 'vegtot_old:',vegtot_old(ji)
2942	WRITE(numout,*) 'drain_upd:',drain_upd(ji)
2943	WRITE(numout,*) 'runoff_upd:',runoff_upd(ji)
2944	WRITE(numout,*) 'vmr:',vmr(ji,:)
2945	WRITE(numout,*) 'vmr_sum:',vmr_sum(ji)
2946	DO jst=1,nstm
2947	WRITE(numout,*) 'mc(',jst,'):',mc(ji,:,jst)
2948	ENDDO
2949	WRITE(numout,*) 'water2infilt:',water2infilt(ji,:)
2950	WRITE(numout,*) 'water2infilt_old:',water2infilt_old(ji,:)
2951	WRITE(numout,*) 'infil_dilu:',infil_dilu(ji)
2952	WRITE(numout,*) 'mc_dilu:',mc_dilu(ji,:)
2953
2954	error=.TRUE.
2955	!CALL ipslerr_p(2, 'hydrol_tmc_update', 'Error in water balance', 'We STOP in the end of this subroutine','')
2956	CALL ipslerr_p(3, 'hydrol_tmc_update', 'Error in water balance','We STOP in the end of this subroutine','') !IGEM19
2957	ENDIF
2958	ENDDO
2959	ENDIF
2960
2961	!! Now that the work is done, update resdist
2962	resdist(:,:) = soiltile(:,:)
2963
2964	!
2965	!! Exit if error was found previously in this subroutine
2966	!
2967	IF ( error ) THEN
2968	WRITE(numout,*) 'One or more errors have been detected in hydrol_tmc_update. Model stops.'
2969	CALL ipslerr_p(3, 'hydrol_tmc_update', 'We will STOP now.',&
2970	& 'One or several fatal errors were found previously.','')
2971	END IF
2972
2973	IF (printlev>=3) WRITE (numout,*) ' hydrol_tmc_update done '
2974
2975	END SUBROUTINE hydrol_tmc_update
2976
2977	!! ================================================================================================================================
2978	!! SUBROUTINE : hydrol_var_init
2979	!!
2980	!>\BRIEF This routine initializes hydrologic parameters to define K and D, and diagnostic hydrologic variables.
2981	!!
2982	!! DESCRIPTION :
2983	!! - 1 compute the depths
2984	!! - 2 compute the profile for roots
2985	!! - 3 compute the profile for a and n Van Genuchten parameter
2986	!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
2987	!! - 5 water reservoirs initialisation
2988	!!
2989	!! RECENT CHANGE(S) : None
2990	!!
2991	!! MAIN OUTPUT VARIABLE(S) :
2992	!!
2993	!! REFERENCE(S) :
2994	!!
2995	!! FLOWCHART : None
2996	!! \n
2997	!_ ================================================================================================================================
2998	!_ hydrol_var_init
2999
3000	SUBROUTINE hydrol_var_init (kjpindex, veget, veget_max, soiltile, njsc, &
3001	mx_eau_var, shumdiag_perma, &
3002	drysoil_frac, qsintveg, mc_layh, mcl_layh)
3003
3004	! interface description
3005
3006	!! 0. Variable and parameter declaration
3007
3008	!! 0.1 Input variables
3009
3010	! input scalar
3011	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size (number of grid cells) (1)
3012	! input fields
3013	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! PFT fractions within grid-cells (1; 1)
3014	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Effective fraction of vegetation by PFT (1; 1)
3015	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
3016	!! in the grid cell (1-nscm, unitless)
3017	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3018
3019	!! 0.2 Output variables
3020
3021	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mx_eau_var !! Maximum water content of the soil
3022	!! @tex $(kg m^{-2})$ @endtex
3023	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma!! Percent of porosity filled with water (mc/mcs)
3024	!! used for the thermal computations
3025	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: drysoil_frac !! function of litter humidity
3026	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mc_layh !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
3027	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mcl_layh !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
3028
3029	!! 0.3 Modified variables
3030	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on vegetation due to interception
3031	!! @tex $(kg m^{-2})$ @endtex
3032
3033	!! 0.4 Local variables
3034
3035	INTEGER(i_std) :: ji, jv !! Grid-cell and PFT indices (1)
3036	INTEGER(i_std) :: jst, jsc, jsl !! Soiltile, Soil Texture, and Soil layer indices (1)
3037	INTEGER(i_std) :: i !! Index (1)
3038	REAL(r_std) :: m !! m=1-1/n (unitless)
3039	REAL(r_std) :: frac !! Relative linearized VWC (unitless)
3040	REAL(r_std) :: avan_mod !! VG parameter a modified from exponantial profile
3041	!! @tex $(mm^{-1})$ @endtex
3042	REAL(r_std) :: nvan_mod !! VG parameter n modified from exponantial profile
3043	!! (unitless)
3044	REAL(r_std), DIMENSION(nslm,nscm) :: afact, nfact !! Multiplicative factor for decay of a and n with depth
3045	!! (unitless)
3046	! parameters for "soil densification" with depth
3047	REAL(r_std) :: dp_comp !! Depth at which the 'compacted' value of ksat
3048	!! is reached (m)
3049	REAL(r_std) :: f_ks !! Exponential factor for decay of ksat with depth
3050	!! @tex $(m^{-1})$ @endtex
3051	! Fixed parameters from fitted relationships
3052	REAL(r_std) :: n0 !! fitted value for relation log((n-n0)/(n_ref-n0)) =
3053	!! nk_rel * log(k/k_ref)
3054	!! (unitless)
3055	REAL(r_std) :: nk_rel !! fitted value for relation log((n-n0)/(n_ref-n0)) =
3056	!! nk_rel * log(k/k_ref)
3057	!! (unitless)
3058	REAL(r_std) :: a0 !! fitted value for relation log((a-a0)/(a_ref-a0)) =
3059	!! ak_rel * log(k/k_ref)
3060	!! @tex $(mm^{-1})$ @endtex
3061	REAL(r_std) :: ak_rel !! fitted value for relation log((a-a0)/(a_ref-a0)) =
3062	!! ak_rel * log(k/k_ref)
3063	!! (unitless)
3064	REAL(r_std) :: kfact_max !! Maximum factor for Ks decay with depth (unitless)
3065	REAL(r_std) :: k_tmp, tmc_litter_ratio
3066	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
3067	!! Switch to 2 tu turn fatal errors into warnings
3068	REAL(r_std), DIMENSION (kjpindex,nslm) :: alphavg !! VG param a modified with depth at each node
3069	!! @tex $(mm^{-1})$ @endtexe
3070	REAL(r_std), DIMENSION (kjpindex,nslm) :: nvg !! VG param n modified with depth at each node
3071	!! (unitless)
3072	INTEGER(i_std) :: jiref !! To identify the mc_lins where k_lin and d_lin
3073	!! need special treatment
3074
3075	!_ ================================================================================================================================
3076
3077	!!??Aurelien: Les 3 parametres qui suivent pourait peut-Ãªtre mis dans hydrol_init?
3078	!
3079	!
3080	!Config Key = CWRR_NKS_N0
3081	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
3082	!Config Def = 0.0
3083	!Config If = HYDROL_CWRR
3084	!Config Help =
3085	!Config Units = [-]
3086	n0 = 0.0
3087	CALL getin_p("CWRR_NKS_N0",n0)
3088
3089	!! Check parameter value (correct range)
3090	IF ( n0 < zero ) THEN
3091	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3092	& "Wrong parameter value for CWRR_NKS_N0.", &
3093	& "This parameter should be non-negative. ", &
3094	& "Please, check parameter value in run.def. ")
3095	END IF
3096
3097
3098	!Config Key = CWRR_NKS_POWER
3099	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
3100	!Config Def = 0.0
3101	!Config If = HYDROL_CWRR
3102	!Config Help =
3103	!Config Units = [-]
3104	nk_rel = 0.0
3105	CALL getin_p("CWRR_NKS_POWER",nk_rel)
3106
3107	!! Check parameter value (correct range)
3108	IF ( nk_rel < zero ) THEN
3109	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3110	& "Wrong parameter value for CWRR_NKS_POWER.", &
3111	& "This parameter should be non-negative. ", &
3112	& "Please, check parameter value in run.def. ")
3113	END IF
3114
3115
3116	!Config Key = CWRR_AKS_A0
3117	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
3118	!Config Def = 0.0
3119	!Config If = HYDROL_CWRR
3120	!Config Help =
3121	!Config Units = [1/mm]
3122	a0 = 0.0
3123	CALL getin_p("CWRR_AKS_A0",a0)
3124
3125	!! Check parameter value (correct range)
3126	IF ( a0 < zero ) THEN
3127	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3128	& "Wrong parameter value for CWRR_AKS_A0.", &
3129	& "This parameter should be non-negative. ", &
3130	& "Please, check parameter value in run.def. ")
3131	END IF
3132
3133
3134	!Config Key = CWRR_AKS_POWER
3135	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
3136	!Config Def = 0.0
3137	!Config If = HYDROL_CWRR
3138	!Config Help =
3139	!Config Units = [-]
3140	ak_rel = 0.0
3141	CALL getin_p("CWRR_AKS_POWER",ak_rel)
3142
3143	!! Check parameter value (correct range)
3144	IF ( nk_rel < zero ) THEN
3145	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3146	& "Wrong parameter value for CWRR_AKS_POWER.", &
3147	& "This parameter should be non-negative. ", &
3148	& "Please, check parameter value in run.def. ")
3149	END IF
3150
3151
3152	!Config Key = KFACT_DECAY_RATE
3153	!Config Desc = Factor for Ks decay with depth
3154	!Config Def = 2.0
3155	!Config If = HYDROL_CWRR
3156	!Config Help =
3157	!Config Units = [1/m]
3158	f_ks = 2.0
3159	CALL getin_p ("KFACT_DECAY_RATE", f_ks)
3160
3161	!! Check parameter value (correct range)
3162	IF ( f_ks < zero ) THEN
3163	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3164	& "Wrong parameter value for KFACT_DECAY_RATE.", &
3165	& "This parameter should be positive. ", &
3166	& "Please, check parameter value in run.def. ")
3167	END IF
3168
3169
3170	!Config Key = KFACT_STARTING_DEPTH
3171	!Config Desc = Depth for compacted value of Ks
3172	!Config Def = 0.3
3173	!Config If = HYDROL_CWRR
3174	!Config Help =
3175	!Config Units = [m]
3176	dp_comp = 0.3
3177	CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
3178
3179	!! Check parameter value (correct range)
3180	IF ( dp_comp <= zero ) THEN
3181	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3182	& "Wrong parameter value for KFACT_STARTING_DEPTH.", &
3183	& "This parameter should be positive. ", &
3184	& "Please, check parameter value in run.def. ")
3185	END IF
3186
3187
3188	!Config Key = KFACT_MAX
3189	!Config Desc = Maximum Factor for Ks increase due to vegetation
3190	!Config Def = 10.0
3191	!Config If = HYDROL_CWRR
3192	!Config Help =
3193	!Config Units = [-]
3194	kfact_max = 10.0
3195	CALL getin_p ("KFACT_MAX", kfact_max)
3196
3197	!! Check parameter value (correct range)
3198	IF ( kfact_max < 10. ) THEN
3199	CALL ipslerr_p(error_level, "hydrol_var_init.", &
3200	& "Wrong parameter value for KFACT_MAX.", &
3201	& "This parameter should be greater than 10. ", &
3202	& "Please, check parameter value in run.def. ")
3203	END IF
3204
3205
3206	!-
3207	!! 1 Create local variables in mm for the vertical depths
3208	!! Vertical depth variables (znh, dnh, dlh) are stored in module vertical_soil_var in m.
3209	DO jsl=1,nslm
3210	zz(jsl) = znh(jsl)*mille
3211	dz(jsl) = dnh(jsl)*mille
3212	dh(jsl) = dlh(jsl)*mille
3213	ENDDO
3214
3215	!-
3216	!! 2 Compute the root density profile if not ok_dynroot
3217	!! For the case with ok_dynroot, the calculations are done at each time step in hydrol_soil
3218	IF (.NOT. ok_dynroot) THEN
3219	DO ji=1, kjpindex
3220	!-
3221	!! The three following equations concerning nroot computation are derived from the integrals
3222	!! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158).
3223	!! The occasional absence of minus sign before humcste parameter is correct.
3224	DO jv = 1,nvm
3225	DO jsl = 2, nslm-1
3226	nroot(ji,jv,jsl) = (EXP(-humcste(jv)zz(jsl)/mille)) &
3227	& (EXP(humcste(jv)*dz(jsl)/mille/deux) - &
3228	& EXP(-humcste(jv)*dz(jsl+1)/mille/deux))/ &
3229	& (EXP(-humcste(jv)*dz(2)/mille/deux) &
3230	& -EXP(-humcste(jv)*zz(nslm)/mille))
3231	ENDDO
3232	nroot(ji,jv,1) = zero
3233
3234	nroot(ji,jv,nslm) = (EXP(humcste(jv)dz(nslm)/mille/deux) -un) &
3235	& EXP(-humcste(jv)*zz(nslm)/mille) / &
3236	& (EXP(-humcste(jv)*dz(2)/mille/deux) &
3237	& -EXP(-humcste(jv)*zz(nslm)/mille))
3238	ENDDO
3239	ENDDO
3240	END IF
3241
3242	!-
3243	!! 3 Compute the profile for a and n
3244	!-
3245
3246	! For every soil texture
3247	DO jsc = 1, nscm
3248	DO jsl=1,nslm
3249	! PhD thesis of d'Orgeval, 2006, p81, Eq. 4.38; d'Orgeval et al. 2008, Eq. 2
3250	! Calibrated against Hapex-Sahel measurements
3251	kfact(jsl,jsc) = MIN(MAX(EXP(- f_ks * (zz(jsl)/mille - dp_comp)), un/kfact_max),un)
3252	! PhD thesis of d'Orgeval, 2006, p81, Eqs. 4.39; 4.42, and Fig 4.14
3253
3254	nfact(jsl,jsc) = ( kfact(jsl,jsc) )**nk_rel
3255	afact(jsl,jsc) = ( kfact(jsl,jsc) )**ak_rel
3256	ENDDO
3257	ENDDO
3258
3259	! For every soil texture
3260	DO jsc = 1, nscm
3261	!-
3262	!! 4 Compute the linearized values of k, a, b and d
3263	!! The effect of kfact_root on ks thus on k, a, n and d, is taken into account further in the code,
3264	!! in hydrol_soil_coef.
3265	!-
3266	! Calculate the matrix coef for Dublin model (de Rosnay, 1999; p149)
3267	! piece-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
3268	! and diffusivity d_lin in each interval of mc, called mc_lin,
3269	! between imin, for residual mcr, and imax for saturation mcs.
3270
3271	! We define 51 bounds for 50 bins of mc between mcr and mcs
3272	mc_lin(imin,jsc)=mcr(jsc)
3273	mc_lin(imax,jsc)=mcs(jsc)
3274	DO ji= imin+1, imax-1 ! ji=2,50
3275	mc_lin(ji,jsc) = mcr(jsc) + (ji-imin)*(mcs(jsc)-mcr(jsc))/(imax-imin)
3276	ENDDO
3277
3278	DO jsl = 1, nslm
3279	! From PhD thesis of d'Orgeval, 2006, p81, Eq. 4.42
3280	nvan_mod = n0 + (nvan(jsc)-n0) * nfact(jsl,jsc)
3281	avan_mod = a0 + (avan(jsc)-a0) * afact(jsl,jsc)
3282	m = un - un / nvan_mod
3283	! Creation of arrays for SP-MIP output by landpoint
3284	nvan_mod_tab(jsl,jsc) = nvan_mod
3285	avan_mod_tab(jsl,jsc) = avan_mod
3286	! We apply Van Genuchten equation for K(theta) based on Ks(z)=ks(jsc) * kfact(jsl,jsc)
3287	DO ji = imax,imin,-1
3288	frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
3289	k_lin(ji,jsl,jsc) = ks(jsc) * kfact(jsl,jsc) * (frac*0.5) ( un - ( un - frac (un/m)) m )**2
3290	ENDDO
3291
3292	! k_lin should not be zero, nor too small
3293	! We track jiref, the bin under which mc is too small and we may get zero k_lin
3294	ji=imax-1
3295	DO WHILE ((k_lin(ji,jsl,jsc) > 1.e-32) .and. (ji>0))
3296	jiref=ji
3297	ji=ji-1
3298	ENDDO
3299	DO ji=jiref-1,imin,-1
3300	k_lin(ji,jsl,jsc)=k_lin(ji+1,jsl,jsc)/10.
3301	ENDDO
3302
3303	DO ji = imin,imax-1 ! ji=1,50
3304	! We deduce a_lin and b_lin based on continuity between segments k_lin = a_lin*mc-lin+b_lin
3305	a_lin(ji,jsl,jsc) = (k_lin(ji+1,jsl,jsc)-k_lin(ji,jsl,jsc)) / (mc_lin(ji+1,jsc)-mc_lin(ji,jsc))
3306	b_lin(ji,jsl,jsc) = k_lin(ji,jsl,jsc) - a_lin(ji,jsl,jsc)*mc_lin(ji,jsc)
3307
3308	! We calculate the d_lin for each mc bin, from Van Genuchten equation for D(theta)
3309	! d_lin is constant and taken as the arithmetic mean between the values at the bounds of each bin
3310	IF (ji.NE.imin .AND. ji.NE.imax-1) THEN
3311	frac=MIN(un,(mc_lin(ji,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
3312	d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_modmnvan_mod)) * &
3313	( (frac*(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) &
3314	( frac(-un/m) -un ) (-m)
3315	frac=MIN(un,(mc_lin(ji+1,jsc)-mcr(jsc))/(mcs(jsc)-mcr(jsc)))
3316	d_lin(ji+1,jsl,jsc) =(k_lin(ji+1,jsl,jsc) / (avan_modmnvan_mod))*&
3317	( (frac*(-un/m))/(mc_lin(ji+1,jsc)-mcr(jsc)) ) &
3318	( frac(-un/m) -un ) (-m)
3319	d_lin(ji,jsl,jsc) = undemi * (d_lin(ji,jsl,jsc)+d_lin(ji+1,jsl,jsc))
3320	ELSE IF(ji.EQ.imax-1) THEN
3321	d_lin(ji,jsl,jsc) =(k_lin(ji,jsl,jsc) / (avan_modmnvan_mod)) * &
3322	( (frac*(-un/m))/(mc_lin(ji,jsc)-mcr(jsc)) ) &
3323	( frac(-un/m) -un ) (-m)
3324	ENDIF
3325	ENDDO
3326
3327	! Special case for ji=imin
3328	d_lin(imin,jsl,jsc) = d_lin(imin+1,jsl,jsc)/1000.
3329
3330	! We adjust d_lin where k_lin was previously adjusted otherwise we might get non-monotonous variations
3331	! We don't want d_lin = zero
3332	DO ji=jiref-1,imin,-1
3333	d_lin(ji,jsl,jsc)=d_lin(ji+1,jsl,jsc)/10.
3334	ENDDO
3335
3336	ENDDO
3337	ENDDO
3338
3339	! Output of alphavg and nvg at each node for SP-MIP
3340	DO jsl = 1, nslm
3341	alphavg(:,jsl) = avan_mod_tab(jsl,njsc(:))*1000. ! from mm-1 to m-1
3342	nvg(:,jsl) = nvan_mod_tab(jsl,njsc(:))
3343	ENDDO
3344	CALL xios_orchidee_send_field("alphavg",alphavg) ! in m-1
3345	CALL xios_orchidee_send_field("nvg",nvg) ! unitless
3346
3347	!! 5 Water reservoir initialisation
3348	!
3349	!!$ DO jst = 1,nstm
3350	!!$ DO ji = 1, kjpindex
3351	!!$ mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
3352	!!$ & zmaxhmillemcs(njsc(ji))
3353	!!$ END DO
3354	!!$ END DO
3355	!!$ IF (check_CWRR) THEN
3356	!!$ IF ( ANY ( ABS( mx_eau_var(:) - zmaxhmillemcs(njsc(:)) ) > min_sechiba ) ) THEN
3357	!!$ ji=MAXLOC ( ABS( mx_eau_var(:) - zmaxhmillemcs(njsc(:)) ) , 1)
3358	!!$ WRITE(numout, ) "Erreur formule simplifiÃÂ©e mx_eau_var ! ", mx_eau_var(ji), zmaxhmille*mcs(njsc(ji))
3359	!!$ WRITE(numout, ) "err = ",ABS(mx_eau_var(ji) - zmaxhmille*mcs(njsc(ji)))
3360	!!$ STOP 1
3361	!!$ ENDIF
3362	!!$ ENDIF
3363
3364	mx_eau_var(:) = zero
3365	mx_eau_var(:) = zmaxhmillemcs(njsc(:))
3366
3367	DO ji = 1,kjpindex
3368	IF (vegtot(ji) .LE. zero) THEN
3369	mx_eau_var(ji) = mx_eau_nobio*zmaxh
3370	! Aurelien: what does vegtot=0 mean? is it like frac_nobio=1? But if 0<frac_nobio<1 ???
3371	ENDIF
3372
3373	END DO
3374
3375	! Compute the litter humidity, shumdiag and fry
3376	shumdiag_perma(:,:) = zero
3377	humtot(:) = zero
3378	tmc(:,:) = zero
3379
3380	! Loop on soiltiles to compute the variables (ji,jst)
3381	DO jst=1,nstm
3382	DO ji = 1, kjpindex
3383	tmcs(ji,jst)=zmaxh* mille*mcs(njsc(ji))
3384	tmcr(ji,jst)=zmaxh* mille*mcr(njsc(ji))
3385	tmcfc(ji,jst)=zmaxh* mille*mcfc(njsc(ji))
3386	tmcw(ji,jst)=zmaxh* mille*mcw(njsc(ji))
3387	ENDDO
3388	ENDDO
3389
3390	! The total soil moisture for each soiltile:
3391	DO jst=1,nstm
3392	DO ji=1,kjpindex
3393	tmc(ji,jst)= dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
3394	END DO
3395	ENDDO
3396
3397	DO jst=1,nstm
3398	DO jsl=2,nslm-1
3399	DO ji=1,kjpindex
3400	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
3401	& + dz(jsl+1)(troismc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
3402	END DO
3403	END DO
3404	ENDDO
3405
3406	DO jst=1,nstm
3407	DO ji=1,kjpindex
3408	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3409	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
3410	ENDDO
3411	END DO
3412
3413	!JG: hydrol_tmc_update should not be called in the initialization phase. Call of hydrol_tmc_update makes the model restart differenlty.
3414	! ! If veget has been updated before restart (with LAND USE or DGVM),
3415	! ! tmc and mc must be modified with respect to humtot conservation.
3416	! CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg)
3417
3418	! The litter variables:
3419	! level 1
3420	DO jst=1,nstm
3421	DO ji=1,kjpindex
3422	tmc_litter(ji,jst) = dz(2) * (trois*mcl(ji,1,jst)+mcl(ji,2,jst))/huit
3423	tmc_litter_wilt(ji,jst) = dz(2) * mcw(njsc(ji)) / deux
3424	tmc_litter_res(ji,jst) = dz(2) * mcr(njsc(ji)) / deux
3425	tmc_litter_field(ji,jst) = dz(2) * mcfc(njsc(ji)) / deux
3426	tmc_litter_sat(ji,jst) = dz(2) * mcs(njsc(ji)) / deux
3427	tmc_litter_awet(ji,jst) = dz(2) * mc_awet(njsc(ji)) / deux
3428	tmc_litter_adry(ji,jst) = dz(2) * mc_adry(njsc(ji)) / deux
3429	ENDDO
3430	END DO
3431	! sum from level 2 to 4
3432	DO jst=1,nstm
3433	DO jsl=2,4
3434	DO ji=1,kjpindex
3435	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
3436	& ( trois*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
3437	& + dz(jsl+1)(troismcl(ji,jsl,jst) + mcl(ji,jsl+1,jst))/huit
3438	tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
3439	&(dz(jsl)+ dz(jsl+1))*&
3440	& mcw(njsc(ji))/deux
3441	tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
3442	&(dz(jsl)+ dz(jsl+1))*&
3443	& mcr(njsc(ji))/deux
3444	tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
3445	&(dz(jsl)+ dz(jsl+1))* &
3446	& mcs(njsc(ji))/deux
3447	tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
3448	& (dz(jsl)+ dz(jsl+1))* &
3449	& mcfc(njsc(ji))/deux
3450	tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
3451	&(dz(jsl)+ dz(jsl+1))* &
3452	& mc_awet(njsc(ji))/deux
3453	tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
3454	& (dz(jsl)+ dz(jsl+1))* &
3455	& mc_adry(njsc(ji))/deux
3456	END DO
3457	END DO
3458	END DO
3459
3460
3461	DO jst=1,nstm
3462	DO ji=1,kjpindex
3463	! here we set that humrelv=0 in PFT1
3464	humrelv(ji,1,jst) = zero
3465	ENDDO
3466	END DO
3467
3468
3469	! Calculate shumdiag_perma for thermosoil
3470	! Use resdist instead of soiltile because we here need to have
3471	! shumdiag_perma at the value from previous time step.
3472	! Here, soilmoist is only used as a temporary variable to calculate shumdiag_perma
3473	! (based on resdist=soiltile from previous timestep, but normally equal to soiltile)
3474	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3475	soilmoist(:,:) = zero
3476	DO jst=1,nstm
3477	DO ji=1,kjpindex
3478	soilmoist(ji,1) = soilmoist(ji,1) + resdist(ji,jst) * &
3479	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
3480	DO jsl = 2,nslm-1
3481	soilmoist(ji,jsl) = soilmoist(ji,jsl) + resdist(ji,jst) * &
3482	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
3483	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
3484	END DO
3485	soilmoist(ji,nslm) = soilmoist(ji,nslm) + resdist(ji,jst) * &
3486	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3487	ENDDO
3488	ENDDO
3489	DO ji=1,kjpindex
3490	soilmoist(ji,:) = soilmoist(ji,:) * vegtot_old(ji) ! grid cell average
3491	ENDDO
3492
3493	! -- shumdiag_perma for restart
3494	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3495	DO jsl = 1, nslm
3496	DO ji=1,kjpindex
3497	shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(njsc(ji)))
3498	shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), un), zero)
3499	ENDDO
3500	ENDDO
3501
3502	! Calculate drysoil_frac if it was not found in the restart file
3503	! For simplicity, we set drysoil_frac to 0.5 in this case
3504	IF (ALL(drysoil_frac(:) == val_exp)) THEN
3505	DO ji=1,kjpindex
3506	drysoil_frac(ji) = 0.5
3507	END DO
3508	END IF
3509
3510	!! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
3511	!! thermosoil for the thermal conductivity.
3512	! These values are only used in thermosoil_init in absence of a restart file
3513	mc_layh(:,:) = zero
3514	mcl_layh(:,:) = zero
3515	DO jst=1,nstm
3516	DO jsl=1,nslm
3517	DO ji=1,kjpindex
3518	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * resdist(ji,jst) * vegtot_old(ji)
3519	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * resdist(ji,jst) * vegtot_old(ji)
3520	ENDDO
3521	END DO
3522	END DO
3523
3524	IF (printlev>=3) WRITE (numout,*) ' hydrol_var_init done '
3525
3526	END SUBROUTINE hydrol_var_init
3527
3528
3529	!! ================================================================================================================================
3530	!! SUBROUTINE : hydrol_snow
3531	!!
3532	!>\BRIEF This routine computes snow processes.
3533	!!
3534	!! DESCRIPTION :
3535	!! - 0 initialisation
3536	!! - 1 On vegetation
3537	!! - 1.1 Compute snow masse
3538	!! - 1.2 Sublimation
3539	!! - 1.2.1 Check that sublimation on the vegetated fraction is possible.
3540	!! - 1.3. snow melt only if temperature positive
3541	!! - 1.3.1 enough snow for melting or not
3542	!! - 1.3.2 not enough snow
3543	!! - 1.3.3 negative snow - now snow melt
3544	!! - 1.4 Snow melts only on weight glaciers
3545	!! - 2 On Land ice
3546	!! - 2.1 Compute snow
3547	!! - 2.2 Sublimation
3548	!! - 2.3 Snow melt only for continental ice fraction
3549	!! - 2.3.1 If there is snow on the ice-fraction it can melt
3550	!! - 2.4 Snow melts only on weight glaciers
3551	!! - 3 On other surface types - not done yet
3552	!! - 4 computes total melt (snow and ice)
3553	!! - 5 computes snow age on veg and ice (for albedo)
3554	!! - 5.1 Snow age on vegetation
3555	!! - 5.2 Snow age on ice
3556	!! - 6 Diagnose the depth of the snow layer
3557	!!
3558	!! RECENT CHANGE(S) : None
3559	!!
3560	!! MAIN OUTPUT VARIABLE(S) :
3561	!!
3562	!! REFERENCE(S) :
3563	!!
3564	!! FLOWCHART : None
3565	!! \n
3566	!_ ================================================================================================================================
3567	!_ hydrol_snow
3568
3569	SUBROUTINE hydrol_snow (kjpindex, precip_rain, precip_snow , temp_sol_new, soilcap,&
3570	& frac_nobio, totfrac_nobio, vevapsno, snow, snow_age, snow_nobio, snow_nobio_age, &
3571	& tot_melt, snowdepth,snowmelt)
3572
3573	!
3574	! interface description
3575
3576	!! 0. Variable and parameter declaration
3577
3578	!! 0.1 Input variables
3579
3580	! input scalar
3581	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
3582	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rainfall
3583	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
3584	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: temp_sol_new !! New soil temperature
3585	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: soilcap !! Soil capacity
3586	REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio !! Fraction of continental ice, lakes, ...
3587	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: totfrac_nobio !! Total fraction of continental ice+lakes+ ...
3588
3589	!! 0.2 Output variables
3590
3591	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: tot_melt !! Total melt from snow and ice
3592	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: snowmelt !! Snow melt
3593	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: snowdepth !! Snow depth
3594
3595	!! 0.3 Modified variables
3596
3597	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapsno !! Snow evaporation
3598	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: snow !! Snow mass [Kg/m^2]
3599	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: snow_age !! Snow age
3600	REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout) :: snow_nobio !! Ice water balance
3601	REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT(inout) :: snow_nobio_age!! Snow age on ice, lakes, ...
3602
3603	!! 0.4 Local variables
3604
3605	INTEGER(i_std) :: ji, jv
3606	REAL(r_std), DIMENSION (kjpindex) :: d_age !! Snow age change
3607	REAL(r_std), DIMENSION (kjpindex) :: xx !! temporary
3608	REAL(r_std) :: snowmelt_tmp !! The name says it all !
3609	REAL(r_std) :: snow_d1k !! The amount of snow that corresponds to a 1K cooling
3610
3611	!_ ================================================================================================================================
3612
3613	!
3614	! for continental points
3615	!
3616
3617	!
3618	!!_0 initialisation
3619	!
3620	DO jv = 1, nnobio
3621	DO ji=1,kjpindex
3622	subsnownobio(ji,jv) = zero
3623	ENDDO
3624	ENDDO
3625	DO ji=1,kjpindex
3626	subsnowveg(ji) = zero
3627	snowmelt(ji) = zero
3628	icemelt(ji) = zero
3629	subsinksoil(ji) = zero
3630	tot_melt(ji) = zero
3631	ENDDO
3632	!
3633	!! 1 On vegetation
3634	!
3635	DO ji=1,kjpindex
3636	!
3637	!! 1.1 Compute snow masse
3638	!
3639	snow(ji) = snow(ji) + (un - totfrac_nobio(ji))*precip_snow(ji)
3640	!
3641	!
3642	!! 1.2 Sublimation
3643	! Separate between vegetated and no-veget fractions
3644	! Care has to be taken as we might have sublimation from the
3645	! the frac_nobio while there is no snow on the rest of the grid.
3646	!
3647	IF ( snow(ji) > snowcri ) THEN
3648	subsnownobio(ji,iice) = frac_nobio(ji,iice)*vevapsno(ji)
3649	subsnowveg(ji) = vevapsno(ji) - subsnownobio(ji,iice)
3650	ELSE
3651	! Correction Nathalie - Juillet 2006.
3652	! On doit d'abord tester s'il existe un frac_nobio!
3653	! Pour le moment je ne regarde que le iice
3654	IF ( frac_nobio(ji,iice) .GT. min_sechiba) THEN
3655	subsnownobio(ji,iice) = vevapsno(ji)
3656	subsnowveg(ji) = zero
3657	ELSE
3658	subsnownobio(ji,iice) = zero
3659	subsnowveg(ji) = vevapsno(ji)
3660	ENDIF
3661	ENDIF
3662	! here vevapsno bas been separated into a bio and nobio fractions, without changing the total
3663	!
3664	!
3665	!! 1.2.1 Check that sublimation on the vegetated fraction is possible.
3666	!
3667	IF (subsnowveg(ji) .GT. snow(ji)) THEN
3668	! What could not be sublimated goes into subsinksoil
3669	IF( (un - totfrac_nobio(ji)).GT.min_sechiba) THEN
3670	subsinksoil (ji) = (subsnowveg(ji) - snow(ji))/ (un - totfrac_nobio(ji))
3671	END IF
3672	! Sublimation is thus limited to what is available
3673	! Then, evavpsnow is reduced, of subsinksoil
3674	subsnowveg(ji) = snow(ji)
3675	snow(ji) = zero
3676	vevapsno(ji) = subsnowveg(ji) + subsnownobio(ji,iice)
3677	ELSE
3678	snow(ji) = snow(ji) - subsnowveg(ji)
3679	ENDIF
3680	!
3681	!! 1.3. snow melt only if temperature positive
3682	!
3683	IF (temp_sol_new(ji).GT.tp_00) THEN
3684	!
3685	IF (snow(ji).GT.sneige) THEN
3686	!
3687	snowmelt(ji) = (un - frac_nobio(ji,iice))(temp_sol_new(ji) - tp_00) soilcap(ji) / chalfu0
3688	!
3689	!! 1.3.1 enough snow for melting or not
3690	!
3691	IF (snowmelt(ji).LT.snow(ji)) THEN
3692	snow(ji) = snow(ji) - snowmelt(ji)
3693	ELSE
3694	snowmelt(ji) = snow(ji)
3695	snow(ji) = zero
3696	END IF
3697	!
3698	ELSEIF (snow(ji).GE.zero) THEN
3699	!
3700	!! 1.3.2 not enough snow
3701	!
3702	snowmelt(ji) = snow(ji)
3703	snow(ji) = zero
3704	ELSE
3705	!
3706	!! 1.3.3 negative snow - now snow melt
3707	!
3708	snow(ji) = zero
3709	snowmelt(ji) = zero
3710	WRITE(numout,*) 'hydrol_snow: WARNING! snow was negative and was reset to zero. '
3711	!
3712	END IF
3713
3714	ENDIF
3715	!! 1.4 Snow melts above a threshold
3716	! Ice melt only if there is more than a given mass : maxmass_snow,
3717	! But the snow cannot melt more in one time step to what corresponds to
3718	! a 1K cooling. This will lead to a progressive melting of snow above
3719	! maxmass_snow but it is needed as a too strong cooling can destabilise the model.
3720	IF ( snow(ji) .GT. maxmass_snow ) THEN
3721	snow_d1k = un * soilcap(ji) / chalfu0
3722	snowmelt(ji) = snowmelt(ji) + MIN((snow(ji) - maxmass_snow),snow_d1k)
3723	snow(ji) = snow(ji) - snowmelt(ji)
3724	IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow (", maxmass_snow,") and we melted ", snowmelt(ji)
3725	ENDIF
3726
3727	END DO
3728	!
3729	!! 2 On Land ice
3730	!
3731	DO ji=1,kjpindex
3732	!
3733	!! 2.1 Compute snow
3734	!
3735	!!??Aurelien: pkoi mettre precip_rain en dessous? We considere liquid precipitations becomes instantly snow?
3736	snow_nobio(ji,iice) = snow_nobio(ji,iice) + frac_nobio(ji,iice)*precip_snow(ji) + &
3737	& frac_nobio(ji,iice)*precip_rain(ji)
3738	!
3739	!! 2.2 Sublimation
3740	! Was calculated before it can give us negative snow_nobio but that is OK
3741	! Once it goes below a certain values (-maxmass_snow for instance) we should kill
3742	! the frac_nobio(ji,iice) !
3743	!
3744	snow_nobio(ji,iice) = snow_nobio(ji,iice) - subsnownobio(ji,iice)
3745	!
3746	!! 2.3 Snow melt only for continental ice fraction
3747	!
3748	snowmelt_tmp = zero
3749	IF (temp_sol_new(ji) .GT. tp_00) THEN
3750	!
3751	!! 2.3.1 If there is snow on the ice-fraction it can melt
3752	!
3753	snowmelt_tmp = frac_nobio(ji,iice)(temp_sol_new(ji) - tp_00) soilcap(ji) / chalfu0
3754	!
3755	IF ( snowmelt_tmp .GT. snow_nobio(ji,iice) ) THEN
3756	snowmelt_tmp = MAX( zero, snow_nobio(ji,iice))
3757	ENDIF
3758	snowmelt(ji) = snowmelt(ji) + snowmelt_tmp
3759	snow_nobio(ji,iice) = snow_nobio(ji,iice) - snowmelt_tmp
3760	!
3761	ENDIF
3762	!
3763	!! 2.4 Snow melts over a threshold
3764	! Ice melt only if there is more than a given mass : maxmass_snow,
3765	! But the snow cannot melt more in one time step to what corresponds to
3766	! a 1K cooling. This will lead to a progressive melting of snow above
3767	! maxmass_snow but it is needed as a too strong cooling can destabilise the model.
3768	!
3769	IF ( snow_nobio(ji,iice) .GT. maxmass_snow ) THEN
3770	snow_d1k = un * soilcap(ji) / chalfu0
3771	icemelt(ji) = MIN((snow_nobio(ji,iice) - maxmass_snow),snow_d1k)
3772	snow_nobio(ji,iice) = snow_nobio(ji,iice) - icemelt(ji)
3773
3774	IF ( printlev >= 3 ) WRITE (numout,*) "Snow was above maxmass_snow ON ICE (", maxmass_snow,") and we melted ", icemelt(ji)
3775	ENDIF
3776
3777	END DO
3778
3779	!
3780	!! 3 On other surface types - not done yet
3781	!
3782	IF ( nnobio .GT. 1 ) THEN
3783	WRITE(numout,*) 'WE HAVE',nnobio-1,' SURFACE TYPES I DO NOT KNOW'
3784	WRITE(numout,*) 'CANNOT TREAT SNOW ON THESE SURFACE TYPES'
3785	CALL ipslerr_p(3,'hydrol_snow','nnobio > 1 not allowded','Cannot treat snow on these surface types.','')
3786	ENDIF
3787
3788	!
3789	!! 4 computes total melt (snow and ice)
3790	!
3791	DO ji = 1, kjpindex
3792	tot_melt(ji) = icemelt(ji) + snowmelt(ji)
3793	ENDDO
3794
3795	!
3796	!! 5 computes snow age on veg and ice (for albedo)
3797	!
3798	DO ji = 1, kjpindex
3799	!
3800	!! 5.1 Snow age on vegetation
3801	!
3802	IF (snow(ji) .LE. zero) THEN
3803	snow_age(ji) = zero
3804	ELSE
3805	snow_age(ji) =(snow_age(ji) + (un - snow_age(ji)/max_snow_age) * dt_sechiba/one_day) &
3806	& * EXP(-precip_snow(ji) / snow_trans)
3807	ENDIF
3808	!
3809	!! 5.2 Snow age on ice
3810	!
3811	! age of snow on ice: a little bit different because in cold regions, we really
3812	! cannot negect the effect of cold temperatures on snow metamorphism any more.
3813	!
3814	IF (snow_nobio(ji,iice) .LE. zero) THEN
3815	snow_nobio_age(ji,iice) = zero
3816	ELSE
3817	!
3818	d_age(ji) = ( snow_nobio_age(ji,iice) + &
3819	& (un - snow_nobio_age(ji,iice)/max_snow_age) * dt_sechiba/one_day ) * &
3820	& EXP(-precip_snow(ji) / snow_trans) - snow_nobio_age(ji,iice)
3821	IF (d_age(ji) .GT. min_sechiba ) THEN
3822	xx(ji) = MAX( tp_00 - temp_sol_new(ji), zero )
3823	xx(ji) = ( xx(ji) / 7._r_std ) ** 4._r_std
3824	d_age(ji) = d_age(ji) / (un+xx(ji))
3825	ENDIF
3826	snow_nobio_age(ji,iice) = MAX( snow_nobio_age(ji,iice) + d_age(ji), zero )
3827	!
3828	ENDIF
3829
3830	ENDDO
3831
3832	!
3833	!! 6 Diagnose the depth of the snow layer
3834	!
3835
3836	DO ji = 1, kjpindex
3837	snowdepth(ji) = snow(ji) /sn_dens
3838	ENDDO
3839
3840	IF (printlev>=3) WRITE (numout,*) ' hydrol_snow done '
3841
3842	END SUBROUTINE hydrol_snow
3843
3844
3845	!! ================================================================================================================================
3846	!! SUBROUTINE : hydrol_canop
3847	!!
3848	!>\BRIEF This routine computes canopy processes.
3849	!!
3850	!! DESCRIPTION :
3851	!! - 1 evaporation off the continents
3852	!! - 1.1 The interception loss is take off the canopy.
3853	!! - 1.2 precip_rain is shared for each vegetation type
3854	!! - 1.3 Limits the effect and sum what receives soil
3855	!! - 1.4 swap qsintveg to the new value
3856	!!
3857	!! RECENT CHANGE(S) : None
3858	!!
3859	!! MAIN OUTPUT VARIABLE(S) :
3860	!!
3861	!! REFERENCE(S) :
3862	!!
3863	!! FLOWCHART : None
3864	!! \n
3865	!_ ================================================================================================================================
3866	!_ hydrol_canop
3867
3868	SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
3869	& qsintveg,precisol,tot_melt)
3870
3871	!
3872	! interface description
3873	!
3874
3875	!! 0. Variable and parameter declaration
3876
3877	!! 0.1 Input variables
3878
3879	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
3880	! input fields
3881	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
3882	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: vevapwet !! Interception loss
3883	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max !! max fraction of vegetation type
3884	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget !! Fraction of vegetation type
3885	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: qsintmax !! Maximum water on vegetation for interception
3886	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: tot_melt !! Total melt
3887
3888	!! 0.2 Output variables
3889
3890	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: precisol !! Water fallen onto the ground (throughfall+Totmelt)
3891
3892	!! 0.3 Modified variables
3893
3894	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg !! Water on vegetation due to interception
3895
3896	!! 0.4 Local variables
3897
3898	INTEGER(i_std) :: ji, jv
3899	REAL(r_std), DIMENSION (kjpindex,nvm) :: zqsintvegnew
3900
3901	!_ ================================================================================================================================
3902
3903	! boucle sur les points continentaux
3904	! calcul de qsintveg au pas de temps suivant
3905	! par ajout du flux interception loss
3906	! calcule par enerbil en fonction
3907	! des calculs faits dans diffuco
3908	! calcul de ce qui tombe sur le sol
3909	! avec accumulation dans precisol
3910	! essayer d'harmoniser le traitement du sol nu
3911	! avec celui des differents types de vegetation
3912	! fait si on impose qsintmax ( ,1) = 0.0
3913	!
3914	! loop for continental subdomain
3915	!
3916	!
3917	!! 1 evaporation off the continents
3918	!
3919	!! 1.1 The interception loss is take off the canopy.
3920	DO jv=2,nvm
3921	qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
3922	END DO
3923
3924	! It is raining :
3925	!! 1.2 precip_rain is shared for each vegetation type
3926	!
3927	qsintveg(:,1) = zero
3928	DO jv=2,nvm
3929	qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
3930	END DO
3931
3932	!
3933	!! 1.3 Limits the effect and sum what receives soil
3934	!
3935	precisol(:,1)=veget_max(:,1)*precip_rain(:)
3936	DO jv=2,nvm
3937	DO ji = 1, kjpindex
3938	zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv))
3939	precisol(ji,jv) = (veget(ji,jv)throughfall_by_pft(jv)precip_rain(ji)) + &
3940	qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
3941	(veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
3942	ENDDO
3943	END DO
3944
3945	! Precisol is currently the same as throughfall, save it for diagnostics
3946	throughfall(:,:) = precisol(:,:)
3947
3948	DO jv=1,nvm
3949	DO ji = 1, kjpindex
3950	IF (vegtot(ji).GT.min_sechiba) THEN
3951	precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
3952	ENDIF
3953	ENDDO
3954	END DO
3955	!
3956	!
3957	!! 1.4 swap qsintveg to the new value
3958	!
3959	DO jv=2,nvm
3960	qsintveg(:,jv) = zqsintvegnew (:,jv)
3961	END DO
3962
3963	IF (printlev>=3) WRITE (numout,*) ' hydrol_canop done '
3964
3965	END SUBROUTINE hydrol_canop
3966
3967
3968	!! ================================================================================================================================
3969	!! SUBROUTINE : hydrol_vegupd
3970	!!
3971	!>\BRIEF Vegetation update
3972	!!
3973	!! DESCRIPTION :
3974	!! The vegetation cover has changed and we need to adapt the reservoir distribution
3975	!! and the distribution of plants on different soil types.
3976	!! You may note that this occurs after evaporation and so on have been computed. It is
3977	!! not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
3978	!! evaporation. If this is not the case it should have been caught above.
3979	!!
3980	!! - 1 Update of vegetation is it needed?
3981	!! - 2 calculate water mass that we have to redistribute
3982	!! - 3 put it into reservoir of plant whose surface area has grown
3983	!! - 4 Soil tile gestion
3984	!! - 5 update the corresponding masks
3985	!!
3986	!! RECENT CHANGE(S) : None
3987	!!
3988	!! MAIN OUTPUT VARIABLE(S) :
3989	!!
3990	!! REFERENCE(S) :
3991	!!
3992	!! FLOWCHART : None
3993	!! \n
3994	!_ ================================================================================================================================
3995	!_ hydrol_vegupd
3996
3997	SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, ratio_tile, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)!IGEM
3998
3999
4000	!! 0. Variable and parameter declaration
4001
4002	!! 0.1 Input variables
4003
4004	! input scalar
4005	INTEGER(i_std), INTENT(in) :: kjpindex
4006	! input fields
4007	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget !! New vegetation map
4008	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type
4009	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
4010	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: ratio_tile !!IGEM
4011
4012	!! 0.2 Output variables
4013	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: frac_bare !! Fraction(of veget_max) of bare soil
4014	!! in each vegetation type
4015	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
4016	!! on mc [kg/m2/dt]
4017	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
4018	!! on water2infilt[kg/m2/dt]
4019
4020
4021	!! 0.3 Modified variables
4022
4023	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on old vegetation
4024
4025	!! 0.4 Local variables
4026
4027	INTEGER(i_std) :: ji,jv,jst
4028
4029	!_ ================================================================================================================================
4030
4031	!! 1 If veget has been updated at last time step (with LAND USE or DGVM),
4032	!! tmc and mc must be modified with respect to humtot conservation.
4033	CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
4034
4035
4036	! Compute the masks for veget
4037
4038	mask_veget(:,:) = 0
4039	mask_soiltile(:,:) = 0
4040
4041	DO jst=1,nstm
4042	DO ji = 1, kjpindex
4043	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
4044	mask_soiltile(ji,jst) = 1
4045	ENDIF
4046	END DO
4047	ENDDO
4048
4049	DO jv = 1, nvm
4050	DO ji = 1, kjpindex
4051	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
4052	mask_veget(ji,jv) = 1
4053	ENDIF
4054	END DO
4055	END DO
4056
4057	! Compute vegetmax_soil
4058	vegetmax_soil(:,:,:) = zero
4059	ratio_soil(:,:,:) = zero !IGEM
4060	DO jv = 1, nvm
4061	jst = pref_soil_veg(jv)
4062	DO ji=1,kjpindex
4063	! for veget distribution used in sechiba via humrel
4064	IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
4065	vegetmax_soil(ji,jv,jst)=ratio_tile(ji,jst)*veget_max(ji,jv)/soiltile(ji,jst)!IGEM
4066	ratio_soil(ji,jv,jst) = ratio_tile(ji,jst) !IGEM
4067	ENDIF
4068	ENDDO
4069
4070
4071	jst = 4 !IGEM
4072	DO ji=1,kjpindex
4073	! for veget distribution used in sechiba via humrel
4074	IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
4075	vegetmax_soil(ji,jv,jst)=ratio_tile(ji,jst)*veget_max(ji,jv)/soiltile(ji,jst)
4076	ratio_soil(ji,jv,jst) = ratio_tile(ji,jst)
4077	ENDIF
4078	ENDDO !IGEM
4079	ENDDO
4080
4081
4082	! Calculate frac_bare (previosly done in slowproc_veget)
4083	DO ji =1, kjpindex
4084	IF( veget_max(ji,1) .GT. min_sechiba ) THEN
4085	frac_bare(ji,1) = un
4086	ELSE
4087	frac_bare(ji,1) = zero
4088	ENDIF
4089	ENDDO
4090	DO jv = 2, nvm
4091	DO ji =1, kjpindex
4092	IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
4093	frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
4094	ELSE
4095	frac_bare(ji,jv) = zero
4096	ENDIF
4097	ENDDO
4098	ENDDO
4099
4100	! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes
4101	! suivantes et le calcul de frac_bare:
4102	frac_bare_ns(:,:) = zero
4103	DO jst = 1, nstm
4104	DO jv = 1, nvm
4105	DO ji =1, kjpindex
4106	IF(vegtot(ji) .GT. min_sechiba) THEN
4107	frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + vegetmax_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
4108	ENDIF
4109	END DO
4110	ENDDO
4111	END DO
4112
4113	IF (printlev>=3) WRITE (numout,*) ' hydrol_vegupd done '
4114
4115	END SUBROUTINE hydrol_vegupd
4116
4117
4118	!! ================================================================================================================================
4119	!! SUBROUTINE : hydrol_flood
4120	!!
4121	!>\BRIEF This routine computes the evolution of the surface reservoir (floodplain).
4122	!!
4123	!! DESCRIPTION :
4124	!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
4125	!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
4126	!! - 3 Discriminate between precip over land and over floodplain
4127	!!
4128	!! RECENT CHANGE(S) : None
4129	!!
4130	!! MAIN OUTPUT VARIABLE(S) :
4131	!!
4132	!! REFERENCE(S) :
4133	!!
4134	!! FLOWCHART : None
4135	!! \n
4136	!_ ================================================================================================================================
4137	!_ hydrol_flood
4138
4139	SUBROUTINE hydrol_flood (kjpindex, vevapflo, flood_frac, flood_res, floodout)
4140
4141	!! 0. Variable and parameter declaration
4142
4143	!! 0.1 Input variables
4144
4145	! input scalar
4146	INTEGER(i_std), INTENT(in) :: kjpindex !!
4147	! input fields
4148	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flood_frac !! Fraction of floodplains in grid box
4149
4150	!! 0.2 Output variables
4151
4152	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: floodout !! Flux to take out from floodplains
4153
4154	!! 0.3 Modified variables
4155
4156	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: flood_res !! Floodplains reservoir estimate
4157	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapflo !! Evaporation over floodplains
4158
4159	!! 0.4 Local variables
4160
4161	INTEGER(i_std) :: ji, jv !! Indices
4162	REAL(r_std), DIMENSION (kjpindex) :: temp !!
4163
4164	!_ ================================================================================================================================
4165	!-
4166	!! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
4167	!-
4168	DO ji = 1,kjpindex
4169	temp(ji) = MIN(flood_res(ji), vevapflo(ji))
4170	ENDDO
4171	DO ji = 1,kjpindex
4172	flood_res(ji) = flood_res(ji) - temp(ji)
4173	subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
4174	vevapflo(ji) = temp(ji)
4175	ENDDO
4176
4177	!-
4178	!! 2 Compute the total flux from floodplain floodout (transfered to routing)
4179	!-
4180	DO ji = 1,kjpindex
4181	floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
4182	ENDDO
4183
4184	!-
4185	!! 3 Discriminate between precip over land and over floodplain
4186	!-
4187	DO jv=1, nvm
4188	DO ji = 1,kjpindex
4189	precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
4190	ENDDO
4191	ENDDO
4192
4193	IF (printlev>=3) WRITE (numout,*) ' hydrol_flood done'
4194
4195	END SUBROUTINE hydrol_flood
4196
4197
4198	!! ================================================================================================================================
4199	!! SUBROUTINE : hydrol_soil
4200	!!
4201	!>\BRIEF This routine computes soil processes with CWRR scheme (Richards equation solved by finite differences).
4202	!! Note that the water fluxes are in kg/m2/dt_sechiba.
4203	!!
4204	!! DESCRIPTION :
4205	!! 0. Initialisation, and split 2d variables to 3d variables, per soil tile
4206	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
4207	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
4208	!! 1.1 Reduces water2infilt and water2extract to their difference
4209	!! 1.2 To remove water2extract (including bare soilevaporation) from top layer
4210	!! 1.3 Infiltration
4211	!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
4212	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
4213	!! This will act on mcl (liquid water content) only
4214	!! 2.1 K and D are recomputed after infiltration
4215	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
4216	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
4217	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
4218	!! 2.5 Defining where diffusion is solved : everywhere
4219	!! 2.6 We define the system of linear equations for mcl redistribution
4220	!! 2.7 Solves diffusion equations
4221	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
4222	!! 2.9 For water conservation check during redistribution, we calculate the total liquid SM
4223	!! at the end of the routine tridiag, and we compare the difference with the flux...
4224	!! 3. AFTER DIFFUSION/REDISTRIBUTION
4225	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
4226	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
4227	!! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
4228	!! 3.3 Negative runoff is reported to drainage
4229	!! 3.4 Optional block to force saturation below zwt_force
4230	!! 3.5 Diagnosing the effective water table depth
4231	!! 3.6 Diagnose under_mcr to adapt water stress calculation below
4232	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
4233	!! 4.1 Total soil moisture content (water2infilt added below)
4234	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
4235	!! 5. Optional check of the water balance of soil column (if check_cwrr)
4236	!! 5.1 Computation of the vertical water fluxes
4237	!! 5.2 Total mc conservation
4238	!! 5.3 Total mc should not reach zero, or the tridiag solver will have problems
4239	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
4240	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
4241	!! 6.2 We need to turn off evaporation when is_under_mcr
4242	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in thermosoil
4243	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
4244	!! -- ENDING THE MAIN LOOP ON SOILTILES
4245	!! 7. Summing 3d variables into 2d variables
4246	!! 8. XIOS export of local variables, including water conservation checks
4247	!! 9. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
4248	!! The principle is to run a dummy integration of the water redistribution scheme
4249	!! to check if the SM profile can sustain a potential evaporation.
4250	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
4251	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
4252	!! 10. evap_bar_lim is the grid-cell scale beta
4253	!! 11. Exit if error was found previously in this subroutine
4254	!!
4255	!! RECENT CHANGE(S) : 2016 by A. Ducharne
4256	!!
4257	!! MAIN OUTPUT VARIABLE(S) :
4258	!!
4259	!! REFERENCE(S) :
4260	!!
4261	!! FLOWCHART : Non
4262	!! \n
4263	!_ ================================================================================================================================
4264	!_ hydrol_soil
4265
4266	SUBROUTINE hydrol_soil (kjpindex, veget_max, ratio_tile, soiltile, njsc, reinf_slope, &!IGEM
4267	& transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
4268	& returnflow, reinfiltration, irrigation, flowtowtd, qtot_to_river, reinf_from_fast,& !IGEM
4269	& tot_melt, evap_bare_lim, evap_bare_lim_ns, shumdiag, shumdiag_perma,&
4270	& k_litt, litterhumdiag, humrel,vegstress, drysoil_frac, &
4271	& stempdiag,snow, &
4272	& snowdz, tot_bare_soil, u, v, tq_cdrag, mc_layh, mcl_layh)
4273	!
4274	! interface description
4275
4276	!! 0. Variable and parameter declaration
4277
4278	!! 0.1 Input variables
4279
4280	INTEGER(i_std), INTENT(in) :: kjpindex
4281	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Map of max vegetation types [-]
4282	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
4283	!! in the grid cell (1-nscm, unitless)
4284	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
4285	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: ratio_tile !!IGEM
4286
4287	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: transpir !! Transpiration
4288	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4289	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Fraction of surface runoff that reinfiltrates
4290	!! (unitless, [0-1])
4291	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the soil from the bottom
4292	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4293	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
4294	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4295	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinf_from_fast !IGEM [kg/m2(grid)/dtsechiba]
4296
4297	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Irrigation
4298	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4299	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flowtowtd !! IGEM fastflow in kg/m2(grid)/dt_sechiba
4300	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !! Potential evaporation
4301	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4302	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot_penm !! Potential evaporation "Penman" (Milly's correction)
4303	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4304	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !! Total melt from snow and ice
4305	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4306	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
4307	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: snow !! Snow mass
4308	!! @tex $(kg m^{-2})$ @endtex
4309	REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in) :: snowdz !! Snow depth (m)
4310	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
4311	!! (unitless, [0-1])
4312	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
4313	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient
4314
4315	!! 0.2 Output variables
4316
4317	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! Surface runoff
4318	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4319	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
4320	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4321	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
4322	!! on each soil column (unitless, [0-1])
4323	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out) :: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation
4324	!! on each soil column (unitless, [0-1])
4325	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag !! Relative soil moisture in each diag soil layer
4326	!! with respect to (mcfc-mcw) (unitless, [0-1])
4327	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs)
4328	!! in each diag soil layer (for the thermal computations)
4329	!! (unitless, [0-1])
4330	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: k_litt !! Litter approximated hydraulic conductivity
4331	!! @tex $(mm d^{-1})$ @endtex
4332	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! Mean of soil_wet_litter across soil tiles
4333	!! (unitless, [0-1])
4334	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation
4335	!! growth) (unitless, [0-1])
4336	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of the litter humidity
4337	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric water content (liquid + ice) for each soil layer
4338	!! averaged over the mesh (for thermosoil)
4339	!! @tex $(m^{3} m^{-3})$ @endtex
4340	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric liquid water content for each soil layer
4341	!! averaged over the mesh (for thermosoil)
4342	!! @tex $(m^{3} m^{-3})$ @endtex
4343
4344	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: qtot_to_river !! IGEM [kg/m2/dtsechiba]
4345	!! sometimes in m2(tile), sometimes in m2(grid)
4346
4347	!! 0.3 Modified variables
4348
4349	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !! Bare soil evaporation
4350	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4351	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel !! Relative humidity (0-1, dimensionless)
4352
4353	!! 0.4 Local variables
4354
4355	INTEGER(i_std) :: ji, jv, jsl, jst !! Indices
4356	REAL(r_std), PARAMETER :: frac_mcs = 0.66 !! Temporary depth
4357	REAL(r_std), DIMENSION(kjpindex) :: temp !! Temporary value for fluxes
4358	REAL(r_std), DIMENSION(kjpindex) :: tmcold !! Total SM at beginning of hydrol_soil (kg/m2)
4359	REAL(r_std), DIMENSION(kjpindex) :: tmcint !! Ancillary total SM (kg/m2)
4360	REAL(r_std), DIMENSION(kjpindex,nslm) :: mcint !! To save mc values for future use
4361	REAL(r_std), DIMENSION(kjpindex,nslm) :: mclint !! To save mcl values for future use
4362	LOGICAL, DIMENSION(kjpindex,nstm) :: is_under_mcr !! Identifies under residual soil moisture points
4363	LOGICAL, DIMENSION(kjpindex) :: is_over_mcs !! Identifies over saturated soil moisture points
4364	REAL(r_std), DIMENSION(kjpindex) :: deltahum,diff,diff2 !!
4365	LOGICAL(r_std), DIMENSION(kjpindex) :: test !!
4366	REAL(r_std), DIMENSION(kjpindex) :: water2extract !! Water flux to be extracted at the soil surface
4367	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4368	REAL(r_std), DIMENSION(kjpindex) :: returnflow_soil !! Water from the routing back to the bottom of
4369	!! the soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4370	REAL(r_std), DIMENSION(kjpindex) :: reinfiltration_soil !! Water from the routing back to the top of the
4371	!! soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4372	REAL(r_std), DIMENSION(kjpindex) :: irrigation_soil !! Water from irrigation returning to soil moisture
4373	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4374	REAL(r_std), DIMENSION(kjpindex,nstm) :: flux_infilt !! Water to infiltrate (IGEM -> nstm)
4375	!! @tex $(kg m^{-2})$ @endtex
4376	REAL(r_std), DIMENSION(kjpindex) :: flux_bottom !! Flux at bottom of the soil column
4377	!! @tex $(kg m^{-2})$ @endtex
4378	REAL(r_std), DIMENSION(kjpindex) :: flux_top !! Flux at top of the soil column (for bare soil evap)
4379	!! @tex $(kg m^{-2})$ @endtex
4380	REAL(r_std), DIMENSION (kjpindex,nstm) :: qinfilt_ns !! Effective infiltration flux per soil tile
4381	!! @tex $(kg m^{-2})$ @endtex
4382	REAL(r_std), DIMENSION (kjpindex) :: qinfilt !! Effective infiltration flux
4383	!! @tex $(kg m^{-2})$ @endtex
4384	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_infilt_ns !! Surface runoff from hydrol_soil_infilt per soil tile
4385	!! @tex $(kg m^{-2})$ @endtex
4386	REAL(r_std), DIMENSION (kjpindex) :: ru_infilt !! Surface runoff from hydrol_soil_infilt
4387	!! @tex $(kg m^{-2})$ @endtex
4388	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr_ns !! Surface runoff produced to correct excess per soil tile
4389	!! @tex $(kg m^{-2})$ @endtex
4390	REAL(r_std), DIMENSION (kjpindex) :: ru_corr !! Surface runoff produced to correct excess
4391	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4392	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr2_ns !! Correction of negative surface runoff per soil tile
4393	!! @tex $(kg m^{-2})$ @endtex
4394	REAL(r_std), DIMENSION (kjpindex) :: ru_corr2 !! Correction of negative surface runoff
4395	!! @tex $(kg m^{-2})$ @endtex
4396	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corr_ns !! Drainage produced to correct excess
4397	!! @tex $(kg m^{-2})$ @endtex
4398	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corrnum_ns !! Drainage produced to correct numerical errors in tridiag
4399	!! @tex $(kg m^{-2})$ @endtex
4400	REAL(r_std), DIMENSION (kjpindex) :: dr_corr !! Drainage produced to correct excess
4401	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4402	REAL(r_std), DIMENSION (kjpindex) :: dr_corrnum !! Drainage produced to correct numerical errors in tridiag
4403	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
4404	REAL(r_std), DIMENSION (kjpindex,nslm) :: dmc !! Delta mc when forcing saturation (zwt_force)
4405	!! @tex $(m^{3} m^{-3})$ @endtex
4406	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_force_ns !! Delta drainage when forcing saturation (zwt_force)
4407	!! per soil tile @tex $(kg m^{-2})$ @endtex
4408	REAL(r_std), DIMENSION (kjpindex) :: dr_force !! Delta drainage when forcing saturation (zwt_force)
4409	!! @tex $(kg m^{-2})$ @endtex
4410	REAL(r_std), DIMENSION (kjpindex,nstm) :: wtd_ns !! Effective water table depth (m)
4411	REAL(r_std), DIMENSION (kjpindex) :: wtd !! Mean water table depth in the grid-cell (m)
4412	LOGICAL :: error=.FALSE. !! If true, exit in the end of subroutine
4413
4414	! For the calculation of soil_wet_ns and us/humrel/vegstress
4415	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm !! Soil moisture of each layer (liquid phase)
4416	!! @tex $(kg m^{-2})$ @endtex
4417	REAL(r_std), DIMENSION (kjpindex,nslm) :: smt !! Soil moisture of each layer (liquid+solid phase)
4418	!! @tex $(kg m^{-2})$ @endtex
4419	REAL(r_std), DIMENSION (kjpindex,nslm) :: smw !! Soil moisture of each layer at wilting point
4420	!! @tex $(kg m^{-2})$ @endtex
4421	REAL(r_std), DIMENSION (kjpindex,nslm) :: smf !! Soil moisture of each layer at field capacity
4422	!! @tex $(kg m^{-2})$ @endtex
4423	REAL(r_std), DIMENSION (kjpindex,nslm) :: sms !! Soil moisture of each layer at saturation
4424	!! @tex $(kg m^{-2})$ @endtex
4425	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm_nostress !! Soil moisture of each layer at which us reaches 1
4426	!! @tex $(kg m^{-2})$ @endtex
4427	! For water conservation checks (in mm/dtstep unless otherwise mentioned)
4428	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_infilt_ns !! Water conservation diagnostic at routine scale
4429	REAL(r_std), DIMENSION (kjpindex,nstm) :: check1_ns !! Water conservation diagnostic at routine scale
4430	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_tr_ns !! Water conservation diagnostic at routine scale
4431	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_over_ns !! Water conservation diagnostic at routine scale
4432	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_under_ns !! Water conservation diagnostic at routine scale
4433	REAL(r_std), DIMENSION (kjpindex) :: check_wtd !! IGEM
4434	REAL(r_std), DIMENSION(kjpindex) :: tmci !! Total soil moisture at beginning of routine (kg/m2)
4435	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! Total soil moisture at end of routine (kg/m2)
4436	REAL(r_std), DIMENSION(kjpindex) :: diag_tr !! Transpiration flux
4437	REAL(r_std), DIMENSION(kjpindex) :: diag_lat !! IGEM lateral flux
4438	REAL(r_std), DIMENSION (kjpindex) :: check_infilt !! Water conservation diagnostic at routine scale
4439	REAL(r_std), DIMENSION (kjpindex) :: check1 !! Water conservation diagnostic at routine scale
4440	REAL(r_std), DIMENSION (kjpindex) :: check_tr !! Water conservation diagnostic at routine scale
4441	REAL(r_std), DIMENSION (kjpindex) :: check_over !! Water conservation diagnostic at routine scale
4442	REAL(r_std), DIMENSION (kjpindex) :: check_under !! Water conservation diagnostic at routine scale
4443
4444	! Variables for calculation of a soil resistance, option do_rsoil (following the formulation of Sellers et al 1992, implemented in Oleson et al. 2008)
4445	REAL(r_std) :: speed !! magnitude of wind speed required for Aerodynamic resistance
4446	REAL(r_std) :: ra !! diagnosed aerodynamic resistance
4447	REAL(r_std), DIMENSION(kjpindex) :: mc_rel !! first layer relative soil moisture, required for rsoil
4448	REAL(r_std), DIMENSION(kjpindex) :: evap_soil !! soil evaporation from Oleson et al 2008
4449	REAL(r_std), DIMENSION(kjpindex,nstm) :: r_soil_ns !! soil resistance from Oleson et al 2008
4450	REAL(r_std), DIMENSION(kjpindex) :: r_soil !! soil resistance from Oleson et al 2008
4451	REAL(r_std), DIMENSION(kjpindex) :: tmcs_litter !! Saturated soil moisture in the 4 "litter" soil layers
4452	REAL(r_std), DIMENSION(nslm) :: nroot_tmp !! Temporary variable to calculate the nroot
4453
4454	! For CMIP6 and SP-MIP : ksat and matric pressure head psi(theta)
4455	REAL(r_std) :: mc_ratio, mvg, avg
4456	REAL(r_std) :: psi !! Matric head (per soil layer and soil tile) [mm=kg/m2]
4457	REAL(r_std), DIMENSION (kjpindex,nslm) :: psi_moy !! Mean matric head per soil layer [mm=kg/m2]
4458	REAL(r_std), DIMENSION (kjpindex,nslm) :: ksat !! Saturated hydraulic conductivity at each node (mm/d)
4459
4460	!Local variables for IGEM diagnose
4461	REAL(r_std), DIMENSION(kjpindex) :: ru_wtd !(mm/dt_sechiba) IGEM water not infiltrated from the bottom
4462	REAL(r_std), DIMENSION(kjpindex) :: influx_from_bottom !(mm/dt_sechiba) !IGEM
4463	REAL(r_std), DIMENSION(kjpindex) :: influx_from_top !(mm/dt_sechiba) !IGEM !AD2
4464	REAL(r_std) :: gradient !(unitless) !IGEM
4465	REAL(r_std), DIMENSION(kjpindex,nstm) :: water2infilt_int !IGEM variable tampon pour que check_cwrr fonctionne
4466	REAL(r_std), DIMENSION(kjpindex,nstm) :: swbr_ns !IGEM
4467	REAL(r_std), DIMENSION(kjpindex) :: ddens
4468	REAL(r_std), DIMENSION(kjpindex) :: b_lowland
4469	REAL(r_std), DIMENSION(kjpindex) :: dr_to_river
4470	REAL(r_std), DIMENSION(kjpindex) :: ru_to_river
4471	REAL(r_std), DIMENSION(kjpindex) :: qlat
4472	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_before_corr
4473	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_after_corr
4474	REAL(r_std), DIMENSION(kjpindex,nstm) :: check_resolv !IGEM19
4475	REAL(r_std), DIMENSION(kjpindex,nstm) :: check_fluxtop !IGEM19
4476	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmat_diag !IGEM19pourtest
4477	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_before_diag !IGEM19pourtest
4478	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_after_diag !IGEM19pourtest
4479	REAL(r_std), DIMENSION(kjpindex,nstm) :: qlat_ns_diag !IGEM19pourtest
4480	REAL(r_std), DIMENSION(kjpindex,nstm) :: flxbot_diag !IGEM19pourtest
4481	REAL(r_std), DIMENSION(kjpindex,nstm) :: flxtop_diag !IGEM19pourtest
4482	INTEGER(i_std), DIMENSION(kjpindex) :: nstnowtd !AD19
4483
4484
4485	!_ ================================================================================================================================
4486
4487	!! 0.1 Arrays with DIMENSION(kjpindex)
4488
4489	returnflow_soil(:) = zero
4490	reinfiltration_soil(:) = zero
4491	irrigation_soil(:) = zero
4492	qflux(:,:,:) = zero
4493	mc_layh(:,:) = zero ! for thermosoil
4494	mcl_layh(:,:) = zero ! for thermosoil
4495	kk(:,:,:) = zero
4496	kk_moy(:,:) = zero
4497	undermcr(:) = zero ! needs to be initialized outside from jst loop
4498	ksat(:,:) = zero
4499	psi_moy(:,:) = zero
4500	!AD3: the initialization is tricky... not sure it's correct
4501	qtot_to_river(:) = zero !IGEM initialization OK, is only incremented in jst=4
4502	!dr_to_river(:) = zero ! IGEN initialization OK since no need to initialize
4503	!ru_to_river(:) = zero !IGEM initialization OK since no need to initialize
4504	!ru_wtd(:) = zero !IGEM initialization OK since no need to initialize
4505	!swbr_ns(:,:) = zero !IGEM initialization OK since no need to initialize
4506	wtd_ns(:,:) = xios_default_val !IGEM
4507	rootsink(:,:,:) = zero !IGEM new
4508	check_resolv(:,:) = undef_sechiba !IGEM19
4509	check_fluxtop(:,:) = undef_sechiba !IGEM19
4510
4511	IF (ok_freeze_cwrr) THEN
4512
4513	! 0.1 Calculate the temperature and fozen fraction at the hydrological levels
4514
4515	! AD16*** This subroutine could probably be simplified massively given
4516	! that hydro and T share the same vertical discretization
4517	! Here stempdiag is in from thermosoil and temp_hydro is out
4518	CALL hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
4519
4520	! Calculates profil_froz_hydro_ns as a function of temp_hydro, and mc if ok_thermodynamical_freezing
4521	! These values will be kept till the end of the prognostic loop
4522	DO jst=1,nstm
4523	CALL hydrol_soil_froz(kjpindex,jst,njsc)
4524	ENDDO
4525
4526	ELSE
4527
4528	profil_froz_hydro_ns(:,:,:) = zero
4529
4530	ENDIF
4531
4532	!! 0.2 Split 2d variables to 3d variables, per soil tile
4533	! Here, the evaporative fluxes are distributed over the soiltiles as a function of the
4534	! corresponding control factors; they are normalized to vegtot
4535	! At step 7, the reverse transformation is used for the fluxes produced in hydrol_soil
4536	! flux_cell(ji)=sum(flux_ns(ji,jst)soiltile(ji,jst)vegtot(ji))
4537	CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, &
4538	evap_bare_lim, evap_bare_lim_ns, tot_bare_soil)
4539
4540	!! 0.3 Common variables related to routing, with all return flow applied to the soil surface
4541	! The fluxes coming from the routing are uniformly splitted into the soiltiles,
4542	! but are normalized to vegtot like the above fluxes:
4543	! flux_ns(ji,jst)=flux_cell(ji)/vegtot(ji)
4544	! It is the case for : irrigation_soil(ji) and reinfiltration_soil(ji) cf below
4545	! It is also the case for subsinksoil(ji), which is divided by (1-tot_frac_nobio) at creation in hydrol_snow
4546	! AD16*** The transformation in 0.2 and 0.3 is likely to induce conservation problems
4547	! when tot_frac_nobio NE 0, since sum(soiltile) NE vegtot in this case
4548
4549
4550	DO ji=1,kjpindex
4551	IF(vegtot(ji).GT.min_sechiba) THEN
4552	! returnflow_soil is assumed to enter from the bottom, but it is not possible with CWRR
4553	returnflow_soil(ji) = zero
4554	reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
4555	irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
4556	ELSE
4557	returnflow_soil(ji) = zero
4558	reinfiltration_soil(ji) = zero
4559	irrigation_soil(ji) = zero
4560	ENDIF
4561	ENDDO
4562
4563	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
4564	!! The called subroutines work on arrays with DIMENSION(kjpindex),
4565	!! recursively used for each soiltile jst
4566
4567	DO jst = 1,nstm
4568
4569	IF (printlev>=3) WRITE (numout,*) 'hydrol_soil for jst =', jst
4570
4571	is_under_mcr(:,jst) = .FALSE.
4572	is_over_mcs(:) = .FALSE.
4573
4574	!! 0.4. Keep initial values for future check-up
4575
4576	! Total moisture content (including water2infilt) is saved for balance checks at the end
4577	! In hydrol_tmc_update, tmc is increased by water2infilt(ji,jst), but mc is not modified !
4578	tmcold(:) = tmc(:,jst)
4579
4580	!IGEM: the value of water2infilt is added to tmc at the end of hydrol_soil
4581	! teh value of the previous time step is saved here if needed to test conservation
4582	water2infilt_int(:,jst) = water2infilt(:,jst)
4583
4584	! The value of mc is kept in mcint (nstm dimension removed), in case needed for water balance checks
4585	DO jsl = 1, nslm
4586	DO ji = 1, kjpindex
4587	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
4588	ENDDO
4589	ENDDO
4590	!
4591	! Initial total moisture content : tmcint does not include water2infilt, contrarily to tmcold
4592	DO ji = 1, kjpindex
4593	tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit
4594	ENDDO
4595	DO jsl = 2,nslm-1
4596	DO ji = 1, kjpindex
4597	tmcint(ji) = tmcint(ji) + dz(jsl) &
4598	& * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
4599	& + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
4600	ENDDO
4601	ENDDO
4602	DO ji = 1, kjpindex
4603	tmcint(ji) = tmcint(ji) + dz(nslm) &
4604	& * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
4605	ENDDO
4606
4607	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
4608	!! Input = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) + precisol_ns(ji,jst)
4609	!! - negative evaporation fluxes (MIN(ae_ns(ji,jst),zero)+ MIN(subsinksoil(ji),zero))
4610	!! Output = MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) = positive evaporation flux = water2extract
4611	! In practice, negative subsinksoil(ji) is not possible
4612
4613	!! 1.0 IGEM: We process the fluxes from upland tiles/routing to lowland tile (jst=4)
4614
4615
4616	!flowtowtd(:) = zero !TEST
4617	!reinf_from_fast(:) = zero !TEST
4618
4619	DO ji = 1, kjpindex
4620	IF(jst.EQ.4)THEN !IGEM
4621	! AD2: we concentrate the fluxes from routing, in (kg/m2tile/dtsechiba), over the lowland area
4622	influx_from_bottom(ji) = flowtowtd(ji)/(soiltile(ji,jst)*vegtot(ji)) !IGEM(kg/m2tile/dtsechiba)
4623	influx_from_top(ji) = reinf_from_fast(ji)/(soiltile(ji,jst)*vegtot(ji)) !AD2
4624
4625	IF (soiltile(ji,jst) .GT. min_sechiba) THEN ! for infiltration
4626	reinfiltration_soil(ji) = reinfiltration_soil(ji) &
4627	+ influx_from_top(ji) !IGEM(kg/m2tile/dtsechiba)
4628	ELSE
4629	!If no lowlands, inputs from uplands are directly add to the qtot_to_river flow,
4630	!and no infiltration is done in lowlands. These inflow will be
4631	!added to qtot_to_river in hydrol_diag_soil().
4632	influx_from_top(ji) = zero ! This will be dealt with in hydrol_diag, it's simpler like this
4633	influx_from_bottom(ji) = zero
4634	reinfiltration_soil(ji) = zero ! very likely useless
4635	ENDIF
4636	ELSE !AD2 upland tiles
4637	influx_from_bottom(ji) = zero
4638	influx_from_top(ji) = zero ! probably useless
4639	ENDIF !IGEM
4640
4641	!! 1.1 Reduces water2infilt and water2extract to their difference
4642	! Compares water2infilt and water2extract to keep only difference
4643	! Here, temp is used as a temporary variable to store the min of water to infiltrate vs evaporate
4644
4645	temp(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
4646	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst), &
4647	MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) )
4648	ENDDO
4649
4650	! The water to infiltrate at the soil surface is either 0, or the difference to what has to be evaporated
4651	! - the initial water2infilt (right hand side) results from qsintveg changes with vegetation updates
4652	! - irrigation_soil is the input flux to the soil surface from irrigation
4653	! - reinfiltration_soil is the input flux to the soil surface from routing 'including returnflow)
4654	! - eventually, water2infilt holds all fluxes to the soil surface except precisol (reduced by water2extract)
4655	DO ji = 1, kjpindex
4656	water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
4657	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst) &
4658	- temp(ji)
4659	ENDDO
4660
4661	! The water to evaporate from the sol surface is either the difference to what has to be infiltrated, or 0
4662	! - subsinksoil is the residual from sublimation is the snowpack is not sufficient
4663	! - how are the negative values of ae_ns taken into account ???
4664	DO ji = 1, kjpindex
4665	water2extract(ji) = MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) - temp(ji)
4666	ENDDO
4667
4668	! Here we acknowledge that subsinksoil is part of ae_ns, but ae_ns is not used further
4669	ae_ns(:,jst) = ae_ns(:,jst) + subsinksoil(:)
4670
4671	!! 1.2 To remove water2extract (including bare soil) from top layer
4672	flux_top(:) = water2extract(:)
4673
4674	!! 1.3 Infiltration
4675
4676	!! Definition of flux_infilt
4677	DO ji = 1, kjpindex
4678	! Initialise the flux to be infiltrated
4679	flux_infilt(ji,jst) = water2infilt(ji,jst)
4680	ENDDO
4681
4682	!! K and D are computed for the profile of mc before infiltration
4683	!! They depend on the fraction of soil ice, given by profil_froz_hydro_ns
4684	CALL hydrol_soil_coef(kjpindex,jst,njsc)
4685
4686	!! Infiltration and surface runoff are computed
4687	!! Infiltration stems from comparing liquid water2infilt to initial total mc (liquid+ice)
4688	!! The conductivity comes from hydrol_soil_coef and relates to the liquid phase only
4689	! This seems consistent with ok_freeze
4690	CALL hydrol_soil_infilt(kjpindex, jst, njsc, flux_infilt, qinfilt_ns, ru_infilt_ns, &
4691	check_infilt_ns)
4692	ru_ns(:,jst) = ru_infilt_ns(:,jst)
4693
4694	! to comment if water2infilt_int in test(ji) check_cwrr
4695	! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
4696	! Evrything here is liquid
4697	! RK: water2infilt is both a volume for future reinfiltration (in mm)
4698	! and a correction term for surface runoff (in mm/dt_sechiba)
4699	IF ( .NOT. doponds ) THEN ! this is the general case...
4700	DO ji = 1, kjpindex
4701	water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
4702	ENDDO
4703	ELSE
4704	DO ji = 1, kjpindex
4705	water2infilt(ji,jst) = zero
4706	ENDDO
4707	ENDIF
4708	DO ji = 1, kjpindex
4709	ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
4710	END DO
4711
4712
4713	!! 1.5 IGEM:
4714	!! Flow from the slow reservoir (routing) is distributed from the bottom to
4715	!! the surface in the soil column. At first time, each layer is filled
4716	!! simply without any resistance (like the infiltration of the first layer)
4717	!! until total consumption of the influx_from_bottom
4718
4719	IF (jst.EQ.4) THEN !IGEM
4720	check_wtd(:) = zero
4721	IF(zwt_force(1,4) .GT. zmaxh) CALL hydrol_soil_wtd(kjpindex,njsc,soiltile,influx_from_bottom,ru_wtd,check_wtd)
4722	! ru_wtd is the part of influx_from_bottom that cannot enter the soiltile
4723	! it is written with xios in hydrol_soil_wtd (very small)
4724	IF (check_cwrr2) THEN
4725	CALL xios_orchidee_send_field("check_wtd",check_wtd/dt_sechiba)!IGEM
4726	ENDIF
4727	CALL xios_orchidee_send_field("ru_wtd",(ru_wtd*soiltile(:,jst))/dt_sechiba) !kg/m2grid/s
4728	qtot_to_river(:) = qtot_to_river(:) + ru_wtd(:)
4729
4730
4731	!IGEM 2018 diagnose WTD in tile 4 to calculate lateral sink
4732	! The water table depth corresponds to the soil depth zz(jsl)
4733	! below which the layer are very close to saturation.
4734	! The mc(ji,jsl-1,4)*dh(jsl-1)) term is just here to give
4735	! a wtd independent from the vertical resolution.
4736	DO ji = 1, kjpindex
4737	jsl=nslm
4738	DO WHILE((mc(ji,jsl,4) .GE. 0.98*mcs(njsc(ji))) .AND. (jsl > 1))
4739	!wtd_ns(ji,4) = zlh(jsl)
4740	!wtd_ns(ji,4) = zlh(jsl-1)-mc(ji,jsl-1,4)dh(jsl-1)/(mcs(njsc(ji))mille)
4741	! TV2018: Negative values possible for wtd_ns with the previous
4742	! line. Solution: Not include the top layer in wtd (ie MAX(zlh(1),wtd)) or MAX(0,wtd)
4743	wtd_ns(ji,4) = MAX(zlh(1),zlh(jsl-1)-mc(ji,jsl-1,4)dh(jsl-1)/(mcs(njsc(ji))mille))
4744	! dh is layer height; division by mcs because the water table height depends on porosity
4745	! AD18: you would probably have a better WTD estimation by testing if smt EQ mcs*dh;
4746	! this implies to recalculate smt before this test + sm and
4747	! smw for the test on lateral_sink
4748	jsl=jsl-1
4749	ENDDO
4750	ENDDO
4751
4752	ENDIF !IGEM
4753
4754	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
4755	!! This will act on mcl only
4756
4757	!! 2.1 K and D are recomputed after infiltration
4758	!! They depend on the fraction of soil ice, still given by profil_froz_hydro_ns
4759	CALL hydrol_soil_coef(kjpindex,jst,njsc)
4760
4761	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
4762	!! This process will further act on mcl only, based on a, b, d from hydrol_soil_coef
4763	CALL hydrol_soil_setup(kjpindex,jst)
4764
4765	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
4766	DO jsl = 1, nslm
4767	DO ji =1, kjpindex
4768	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
4769	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))))
4770	! we always have mcl<=mc
4771	! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then mcl<mcr
4772	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4773	ENDDO
4774	ENDDO
4775	! The value of mcl is kept in mclint (nstm dimension removed), used in the flux computation after diffusion
4776	DO jsl = 1, nslm
4777	DO ji = 1, kjpindex
4778	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
4779	ENDDO
4780	ENDDO
4781
4782	!! IGEM: Calculate sink term due to lateral flux from lowland tile (jst=4) to river
4783
4784	lateral_sink(:,:,:) = zero ! for upland soiltiles, and top and bottom layers of lowland tile
4785	! mettre cette inititialisation en dehors de la boucle si indice jst pour
4786	! laterral!!
4787	IF (jst .EQ. 4) THEN
4788
4789	DO ji=1,kjpindex
4790	IF (soiltile(ji,jst).GT.min_sechiba) THEN
4791
4792	! Calculation of the lateral sink for each layer
4793	DO jsl=2,nslm-1 !no lateral flow for the top and bottom layers
4794
4795	IF ((wtd_ns(ji,jst).LT.zmaxh) .AND. (zlh(jsl).GT.wtd_ns(ji,jst))) THEN
4796
4797	! We first need to define the geometry of the lowland aquifer
4798	! We need the drainage density dd in km-1, and the river
4799	! length vanishes from the equations
4800	ddens(ji) = 0.535 ! in km-1, prescribed until we read it from a map
4801	! value from Ardalan, average in the Seine
4802	b_lowland(ji) = 1000.0/(2.0*(ddens(ji)+min_sechiba))
4803	! ddens in km-1, b_lowland in m for mean aquifer breadth in lowland tile
4804
4805	! zmaxh in m ; wtd_ns in m ; b_lowland(ji) in m
4806	gradient = (zmaxh-wtd_ns(ji,jst))/b_lowland(ji) ! no dim
4807
4808	! Darcy flux
4809	! k in mm/d ; dh in mm so dh/1000 in m ; length_hillslope in m
4810	! RC_fac is inserted as a non dimensional factor to
4811	! account for variations of K along the horizontal
4812	! (Kh increased from anisotropy or increased from clogging of river bed sediment)
4813	lateral_sink(ji,jsl,jst) = RC_fac * (pi/2.0)*(pi/2.0) & ! pi^2/4 = numerical factor from Brutsaert p 401
4814	* k(ji,jsl)(dt_sechiba/one_day) (dh(jsl)/mille) * gradient &
4815	/ b_lowland(ji) ! flux in mm/dt_sechiba
4816	! This is very close to the long-term solution of the linearized Boussinesq equation
4817	! at catchment scale stating q = S/tau with S the aquifer volume expressed in mm
4818	! and 1/tau = (pipi)Tdddd/ne
4819	! ne = porosity so S/ne gives wtd ; T is the sum of k(jsl)(dh(jsl)/mille) ; dd = 1/(2b)
4820
4821	! If the lateral sink (demand) is higher than the water content (mm) of the layer (supply),
4822	! the lateral sink is just equal the extractable water of the layer
4823
4824	! Update of sm (liquid) after infiltration from top and bottom
4825	sm(ji,jsl) = dz(jsl) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl-1,jst))/huit &
4826	+ dz(jsl+1) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl+1,jst))/huit
4827	lateral_sink(ji,jsl,jst) = MAX(0.0,MIN((sm(ji,jsl)-smw(ji,jsl)),lateral_sink(ji,jsl,jst)))
4828	ENDIF
4829	ENDDO
4830	ENDIF
4831	ENDDO
4832
4833	CALL xios_orchidee_send_field("lateral_sink",lateral_sink(:,:,4)/dt_sechiba)!IGEM (mm/s)
4834	ENDIF !IGEM
4835
4836	DO jsl = 1, nslm
4837	DO ji =1, kjpindex
4838	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
4839	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))))
4840	! we always have mcl<=mc
4841	! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then
4842	! mcl<mcr
4843	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep
4844	! mcl=mc
4845	ENDDO
4846	ENDDO
4847
4848	CALL hydrol_soil_coef(kjpindex,jst,njsc)
4849	CALL hydrol_soil_setup(kjpindex,jst)
4850
4851
4852	!! 2.3bis Diagnostic of the matric potential used for redistribution by Richards/tridiag (in m)
4853	! We use VG relationship giving psi as a function of mc (mcl in our case)
4854	! With patches against numerical pbs when (mc_ratio - un) becomes very slightly negative (gives NaN)
4855	! or if psi become too strongly negative (pbs with xios output)
4856	DO jsl=1, nslm
4857	DO ji = 1, kjpindex
4858	IF (soiltile(ji,jst) .GT. min_sechiba) THEN
4859	mvg = un - un / nvan_mod_tab(jsl,njsc(ji))
4860	avg = avan_mod_tab(jsl,njsc(ji))*1000. ! to convert in m-1
4861	mc_ratio = MAX( 10.*(-14mvg), (mcl(ji,jsl,jst) - mcr(njsc(ji)))/(mcs(njsc(ji)) - mcr(njsc(ji))) )**(-un/mvg)
4862	psi = - MAX(zero,(mc_ratio - un))**(un/nvan_mod_tab(jsl,njsc(ji))) / avg ! in m
4863	psi_moy(ji,jsl) = psi_moy(ji,jsl) + soiltile(ji,jst) * psi ! average across soil tiles
4864	ENDIF
4865	ENDDO
4866	ENDDO
4867
4868
4869	!mc_before_corr(:,:,jst) = mc(:,:,jst)
4870
4871	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
4872	! (on mcl only, since the diffusion only modifies mcl)
4873	tmci(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
4874	DO jsl = 2,nslm-1
4875	tmci(:) = tmci(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4876	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4877	ENDDO
4878	tmci(:) = tmci(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4879
4880	!! 2.5 Defining where diffusion is solved : everywhere
4881	!! Since mc>mcs is not possible after infiltration, and we accept that mc<mcr
4882	!! (corrected later by shutting off all evaporative fluxes in this case)
4883	! Nothing is done if resolv=F
4884	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
4885
4886	!! 2.6 We define the system of linear equations for mcl redistribution,
4887	!! based on the matrix coefficients from hydrol_soil_setup
4888	!! following the PhD thesis of de Rosnay (1999), p155-157
4889	!! The bare soil evaporation (subtracted from infiltration) is used directly as flux_top
4890	! rhs for right-hand side term; fp for f'; gp for g'; ep for e'; with flux=0 !
4891
4892	!- First layer
4893	DO ji = 1, kjpindex
4894	tmat(ji,1,1) = zero
4895	tmat(ji,1,2) = f(ji,1)
4896	tmat(ji,1,3) = g1(ji,1)
4897	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
4898	& - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) &
4899	& - rootsink(ji,1,jst) - lateral_sink(ji,1,jst) !IGEM=0
4900	ENDDO
4901	!- soil body
4902	DO jsl=2, nslm-1
4903	DO ji = 1, kjpindex
4904	tmat(ji,jsl,1) = e(ji,jsl)
4905	tmat(ji,jsl,2) = f(ji,jsl)
4906	tmat(ji,jsl,3) = g1(ji,jsl)
4907	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4908	& + gp(ji,jsl) * mcl(ji,jsl+1,jst) &
4909	& + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux &
4910	& - rootsink(ji,jsl,jst) - lateral_sink(ji,jsl,jst) !IGEM
4911	ENDDO
4912	ENDDO
4913	!- Last layer, including drainage
4914	DO ji = 1, kjpindex
4915	jsl=nslm
4916	tmat(ji,jsl,1) = e(ji,jsl)
4917	tmat(ji,jsl,2) = f(ji,jsl)
4918	tmat(ji,jsl,3) = zero
4919	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4920	& + (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
4921	& - rootsink(ji,jsl,jst) - lateral_sink(ji,jsl,jst) !IGEM=0
4922	ENDDO
4923	!- Store the equations in case needed again
4924	DO jsl=1,nslm
4925	DO ji = 1, kjpindex
4926	srhs(ji,jsl) = rhs(ji,jsl)
4927	stmat(ji,jsl,1) = tmat(ji,jsl,1)
4928	stmat(ji,jsl,2) = tmat(ji,jsl,2)
4929	stmat(ji,jsl,3) = tmat(ji,jsl,3)
4930	ENDDO
4931	ENDDO
4932
4933	!! 2.7 Solves diffusion equations, but only in grid-cells where resolv is true, i.e. everywhere (cf 2.2)
4934	!! The result is an updated mcl profile
4935
4936
4937	CALL hydrol_soil_tridiag(kjpindex,jst)
4938
4939
4940	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
4941	! dr_ns in mm/dt_sechiba, from k in mm/d
4942	! This should be done where resolv=T, like tridiag (drainage is part of the linear system !)
4943	DO ji = 1, kjpindex
4944	IF (resolv(ji)) THEN
4945	dr_ns(ji,jst) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst)*(dt_sechiba/one_day)
4946	ELSE
4947	dr_ns(ji,jst) = zero
4948	ENDIF
4949	ENDDO
4950
4951	!! 2.9 For water conservation check during redistribution AND CORRECTION,
4952	!! we calculate the total liquid SM at the end of the routine tridiag
4953	tmcf(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
4954	DO jsl = 2,nslm-1
4955	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4956	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4957	ENDDO
4958	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4959
4960	!! And we compare the difference with the flux...
4961	! Normally, tcmf=tmci-flux_top(ji)-transpir-dr_ns
4962	DO ji=1,kjpindex
4963	diag_tr(ji)=SUM(rootsink(ji,:,jst))
4964	diag_lat(ji)=SUM(lateral_sink(ji,:,jst)) !IGEM, it is zero outside of lowland
4965	ENDDO
4966
4967	qtot_to_river(:) = qtot_to_river(:) + diag_lat(:) !IGEM
4968
4969	! Here, check_tr_ns holds the inaccuracy during the redistribution phase
4970	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:)-diag_lat(:)) !IGEM
4971
4972	!! We solve here the numerical errors that happen when the soil is close to saturation
4973	!! and drainage very high, and which lead to negative check_tr_ns: the soil dries more
4974	!! than what is demanded by the fluxes, so we need to increase the fluxes.
4975	!! This is done by increasing the drainage.
4976	!! There are also instances of positive check_tr_ns, larger when the drainage is high
4977	!! They are similarly corrected by a decrease of dr_ns, in the limit of keeping a positive drainage.
4978	DO ji=1,kjpindex
4979	IF ( check_tr_ns(ji,jst) .LT. zero ) THEN
4980	dr_corrnum_ns(ji,jst) = -check_tr_ns(ji,jst) ! dr_corrnum_ns >0
4981	ELSE
4982	dr_corrnum_ns(ji,jst) = -MIN(dr_ns(ji,jst),check_tr_ns(ji,jst)) !dr_corrnum_ns <0
4983	! AD18: on est nÃ©gatif donc on passe ici
4984	! pourquoi de telles valeurs negatives alors que dr_ns devrait etre nul, donc dr_corrnum_ns aussi...?
4985	! docn est-ce que free_drain_coef est bien nul dans la tile 4???
4986	ENDIF
4987	dr_ns(ji,jst) = dr_ns(ji,jst) + dr_corrnum_ns(ji,jst) ! dr_ns increases/decrease if check_tr negative/positive
4988	ENDDO
4989	!! For water conservation check during redistribution
4990	IF (check_cwrr2) THEN
4991	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:)-diag_lat(:)) !IGEM
4992	ENDIF
4993
4994	!! 3. AFTER DIFFUSION/REDISTRIBUTION
4995
4996	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
4997	! The frozen fraction is constant, so that any water flux to/from a layer changes
4998	! both mcl and the ice amount. The assumption behind this is that water entering/leaving
4999	! a soil layer immediately freezes/melts with the proportion profil_froz_hydro_ns/(1-profil_...)
5000	DO jsl = 1, nslm
5001	DO ji =1, kjpindex
5002	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
5003	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
5004	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
5005	ENDDO
5006	ENDDO
5007
5008	DO jsl = 1, nslm
5009	DO ji =1, kjpindex
5010	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
5011	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))))
5012	! we always have mcl<=mc
5013	! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then
5014	! mcl<mcr
5015	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep
5016	! mcl=mc
5017	ENDDO
5018	ENDDO
5019
5020	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
5021	! Oversaturation results from numerical inaccuracies and can be frequent if free_drain_coef=0
5022	! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
5023	! The former routine hydrol_soil_smooth_over_mcs, which keeps most of the excess in the soiltile
5024	! after smoothing, first downward then upward, is kept in the module but not used here
5025	dr_corr_ns(:,jst) = zero
5026	ru_corr_ns(:,jst) = zero
5027	IF(jst.EQ.4)THEN
5028	call hydrol_soil_smooth_over_mcs(kjpindex, jst, njsc, is_over_mcs, ru_corr_ns, check_over_ns)
5029	ELSE
5030	CALL hydrol_soil_smooth_over_mcs2(kjpindex, jst, njsc, is_over_mcs,ru_corr_ns, check_over_ns)
5031	ENDIF
5032
5033	! In absence of freezing, if F is large enough, the correction of oversaturation is sent to drainage
5034	DO ji = 1, kjpindex
5035	IF ((free_drain_coef(ji,jst) .GE. 0.5) .AND. (.NOT. ok_freeze_cwrr) ) THEN
5036	dr_corr_ns(ji,jst) = ru_corr_ns(ji,jst)
5037	ru_corr_ns(ji,jst) = zero
5038	ENDIF
5039	ENDDO
5040	dr_ns(:,jst) = dr_ns(:,jst) + dr_corr_ns(:,jst)
5041	ru_ns(:,jst) = ru_ns(:,jst) + ru_corr_ns(:,jst)
5042
5043	!! 3.3 Negative runoff is reported to drainage
5044	! Since we computed ru_ns directly from hydrol_soil_infilt, ru_ns should not be negative
5045
5046	ru_corr2_ns(:,jst) = zero
5047	DO ji = 1, kjpindex
5048	IF (ru_ns(ji,jst) .LT. zero) THEN
5049	IF (printlev>=3) WRITE (numout,*) 'NEGATIVE RU_NS: runoff and drainage before correction',&
5050	ru_ns(ji,jst),dr_ns(ji,jst)
5051	dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
5052	ru_corr2_ns(ji,jst) = -ru_ns(ji,jst)
5053	ru_ns(ji,jst)= 0.
5054	END IF
5055	ENDDO
5056
5057	!! 3.5 Diagnose under_mcr to adapt water stress calculation below
5058	! This routine does not change tmc but decides where
5059	! we should turn off ET to prevent further mc decrease
5060	! Like above, the tests are made on total mc, compared to mcr
5061	CALL hydrol_soil_smooth_under_mcr(kjpindex, jst, njsc, is_under_mcr, check_under_ns)
5062
5063	!! 3.6 Diagnosing the effective water table depth:
5064	!! Defined as as the smallest jsl value when mc(jsl) is no more at saturation (mcs),
5065	!! starting from the bottom
5066	! If there is a part of the soil which is saturated but underlain with unsaturated nodes,
5067	! this is not considered as a water table
5068	!TV2018 IGEM: Second calculation of wtd for output (after redistribution
5069	!and oversaturation correction)
5070	IF (jst.EQ.4) THEN !IGEM
5071	DO ji = 1, kjpindex
5072	jsl=nslm
5073	DO WHILE((mc(ji,jsl,4) .GE. 0.98*mcs(njsc(ji))) .AND. (jsl > 1))
5074	wtd_ns(ji,4) = MAX(zlh(1),zlh(jsl-1)-mc(ji,jsl-1,4)dh(jsl-1)/(mcs(njsc(ji))mille))
5075	jsl=jsl-1
5076	ENDDO
5077	ENDDO
5078	ENDIF !IGEM
5079
5080	!! IGEM: Total output fluxes from the lowland tile
5081	IF (jst.EQ.4) THEN
5082	DO ji = 1,kjpindex
5083	qtot_to_river(ji) = qtot_to_river(ji)+dr_ns(ji,jst)+ru_ns(ji,jst) ! still in kg/m2tile/dt
5084	! qtot-to_tiver exported in kg/m2(grid)/s in hydrol_diag_soil ; holds ru_wtd and diaglat
5085	dr_to_river(ji) = (ru_wtd(ji)+diag_lat(ji)+dr_ns(ji,jst))soiltile(ji,jst)vegtot(ji)
5086	ru_to_river(ji) = ru_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
5087	qlat(ji) = diag_lat(ji)soiltile(ji,jst)vegtot(ji)
5088	dr_ns(ji,jst) = zero ! to avoid recycling
5089	ru_ns(ji,jst) = zero ! to avoid recycling
5090	ENDDO
5091	ENDIF
5092
5093	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
5094
5095	!! 4.1 Total soil moisture content (water2infilt added below)
5096	DO ji = 1, kjpindex
5097	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
5098	ENDDO
5099	DO jsl = 2,nslm-1
5100	DO ji = 1, kjpindex
5101	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
5102	& * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
5103	& + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
5104	ENDDO
5105	ENDDO
5106	DO ji = 1, kjpindex
5107	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
5108	& * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
5109	END DO
5110
5111	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
5112	!! and in case we would like to export it (xios)
5113	DO jsl = 1, nslm
5114	DO ji =1, kjpindex
5115	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
5116	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
5117	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
5118	ENDDO
5119	ENDDO
5120
5121	!! 5. Optional check of the water balance of soil column (if check_cwrr)
5122
5123	IF (check_cwrr2) THEN
5124
5125	!! 5.1 Computation of the vertical water fluxes
5126	!CALL hydrol_soil_flux(kjpindex,jst,mclint,flux_top) !AD18: lateral_sink are missing here!!
5127
5128	!! 5.2 Total mc conservation
5129	DO ji = 1,kjpindex
5130
5131	! Former Case:
5132	!deltahum(ji) = (tmc(ji,jst) - tmcold(ji))
5133	!diff(ji) = flux_infilt(ji,jst) + influx_from_bottom(ji) - flux_top(ji) &!IGEM
5134	! - diag_tr(ji) - qtot_to_river(ji) - ru_ns(ji,jst) - dr_ns(ji,jst) - ru_wtd(ji)& !IGEM
5135	! - water2infilt_int(ji,jst) !IGEM
5136
5137	!Case 1: works! same stwbr and twbr than case 2 and 3
5138	deltahum(ji) = (tmc(ji,jst) - tmcint(ji)) + (water2infilt(ji,jst) - water2infilt_int(ji,jst))
5139	diff(ji) = reinfiltration_soil(ji) + irrigation_soil(ji) + influx_from_bottom(ji) + precisol_ns(ji,jst) &
5140	- ae_ns(ji,jst) - diag_tr(ji) - qtot_to_river(ji) - ru_ns(ji,jst) - dr_ns(ji,jst)
5141	! when ru_ns and dr_ns are added to qtot_to_river (lowland), they are then set zero afterwards
5142
5143	swbr_ns(ji,jst) = deltahum(ji)-diff(ji)
5144	test(ji) = (ABS(swbr_ns(ji,jst))*mask_soiltile(ji,jst) .GT. allowed_err)
5145
5146	IF (test(ji)) THEN
5147	WRITE (numout,*)'CWRR water conservation pb:',ji,jst,njsc(ji),deltahum(ji)-diff(ji)
5148	WRITE(numout,*) 'water2infilt_int',water2infilt_int(ji,jst)
5149	WRITE(numout,*) 'water2infilt',water2infilt(ji,jst)
5150	WRITE(numout,*) 'qinfilt_ns',qinfilt_ns(ji,jst)
5151	WRITE(numout,*) 'ru_infilt_ns',ru_infilt_ns(ji,jst)
5152	WRITE(numout,*) 'ru_ns',ru_ns(ji,jst)
5153	WRITE(numout,*) 'dr_ns',dr_ns(ji,jst)
5154	WRITE(numout,*) 'ru_corr_ns',ru_ns(ji,jst)
5155	WRITE(numout,*) 'ru_corr2_ns',ru_ns(ji,jst)
5156	WRITE(numout,*) 'dr_corr_ns',dr_corr_ns(ji,jst)
5157	WRITE(numout,*) 'dr_corrnum_ns',dr_ns(ji,jst)
5158	WRITE(numout,*) 'influx_from_bottom',influx_from_bottom(ji)
5159	WRITE(numout,*) 'SUM(rootsink),SUM(latsink)',diag_tr(ji), diag_lat(ji)
5160	WRITE (numout,*)'ru_wtd',ru_wtd(ji)
5161	WRITE(numout,*) 'flux_infilt',flux_infilt(ji,jst)
5162	WRITE (numout,*)'precisol_ns',precisol_ns(ji,jst)
5163	WRITE (numout,*)'irrigation, returnflow, reinfiltration', &
5164	irrigation_soil(ji),returnflow_soil(ji),reinfiltration_soil(ji)
5165	WRITE (numout,*)'influx_from_bottom,influx_from_top' , & !IGEM(kg/m2tile/dtsechiba)
5166	influx_from_bottom(ji), influx_from_top(ji)
5167	!WRITE (numout,*)'mc',mc(ji,:,jst) ! along jsl
5168	!WRITE (numout,*)'qflux',qflux(ji,:,jst) ! along jsl
5169	!WRITE (numout,*)'k', k(ji,:) ! along jsl
5170	!WRITE (numout,*)'soiltile',soiltile(ji,jst)
5171	!WRITE (numout,*)'veget_max', veget_max(ji,:)
5172
5173	!error=.TRUE.
5174	!CALL ipslerr_p(2, 'hydrol_soil', 'We will STOP in the end of this subroutine.',&
5175	! & 'CWRR water balance check','')
5176	ENDIF
5177	ENDDO
5178
5179	ENDIF
5180
5181	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
5182	! Starting here, mc and mcl should not change anymore
5183
5184	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
5185	!! (based on mc)
5186
5187	!! In output, tmc includes water2infilt(ji,jst)
5188	DO ji=1,kjpindex
5189	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
5190	END DO
5191
5192	! The litter is the 4 top levels of the soil
5193	! Compute various field of soil moisture for the litter (used for stomate and for albedo)
5194	! We exclude the frozen water from the calculation
5195	DO ji=1,kjpindex
5196	tmc_litter(ji,jst) = dz(2) * ( trois*mcl(ji,1,jst)+ mcl(ji,2,jst))/huit
5197	END DO
5198	! sum from level 1 to 4
5199	DO jsl=2,4
5200	DO ji=1,kjpindex
5201	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
5202	& ( trois*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
5203	& + dz(jsl+1)(troismcl(ji,jsl,jst) + mcl(ji,jsl+1,jst))/huit
5204	END DO
5205	END DO
5206
5207	! Subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcfc-tmcw)
5208	! Based on liquid water content
5209	DO ji=1,kjpindex
5210	soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
5211	& (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
5212	& (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
5213	END DO
5214
5215	! Preliminary calculation of various soil moistures (for each layer, in kg/m2)
5216	sm(:,1) = dz(2) * (trois*mcl(:,1,jst) + mcl(:,2,jst))/huit
5217	smt(:,1) = dz(2) * (trois*mc(:,1,jst) + mc(:,2,jst))/huit
5218	smw(:,1) = dz(2) * (quatre*mcw(njsc(:)))/huit
5219	smf(:,1) = dz(2) * (quatre*mcfc(njsc(:)))/huit
5220	sms(:,1) = dz(2) * (quatre*mcs(njsc(:)))/huit
5221	DO jsl = 2,nslm-1
5222	sm(:,jsl) = dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
5223	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
5224	smt(:,jsl) = dz(jsl) * (trois*mc(:,jsl,jst)+mc(:,jsl-1,jst))/huit &
5225	+ dz(jsl+1) * (trois*mc(:,jsl,jst)+mc(:,jsl+1,jst))/huit
5226	smw(:,jsl) = dz(jsl) * ( quatre*mcw(njsc(:)) )/huit &
5227	+ dz(jsl+1) * ( quatre*mcw(njsc(:)) )/huit
5228	smf(:,jsl) = dz(jsl) * ( quatre*mcfc(njsc(:)) )/huit &
5229	+ dz(jsl+1) * ( quatre*mcfc(njsc(:)) )/huit
5230	sms(:,jsl) = dz(jsl) * ( quatre*mcs(njsc(:)) )/huit &
5231	+ dz(jsl+1) * ( quatre*mcs(njsc(:)) )/huit
5232	ENDDO
5233	sm(:,nslm) = dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
5234	smt(:,nslm) = dz(nslm) * (trois*mc(:,nslm,jst) + mc(:,nslm-1,jst))/huit
5235	smw(:,nslm) = dz(nslm) * (quatre*mcw(njsc(:)))/huit
5236	smf(:,nslm) = dz(nslm) * (quatre*mcfc(njsc(:)))/huit
5237	sms(:,nslm) = dz(nslm) * (quatre*mcs(njsc(:)))/huit
5238	! sm_nostress = soil moisture of each layer at which us reaches 1, here at the middle of [smw,smf]
5239	DO jsl = 1,nslm
5240	sm_nostress(:,jsl) = smw(:,jsl) + pcent(njsc(:)) * (smf(:,jsl)-smw(:,jsl))
5241	END DO
5242
5243	! Saturated litter soil moisture for rsoil
5244	tmcs_litter(:) = zero
5245	DO jsl = 1,4
5246	tmcs_litter(:) = tmcs_litter(:) + sms(:,jsl)
5247	END DO
5248
5249	! Soil wetness profiles (W-Ww)/(Ws-Ww)
5250	! soil_wet_ns is the ratio of available soil moisture to max available soil moisture
5251	! (ie soil moisture at saturation minus soil moisture at wilting point).
5252	! soil wet is a water stress for stomate, to control C decomposition
5253	! Based on liquid water content
5254	DO jsl=1,nslm
5255	DO ji=1,kjpindex
5256	soil_wet_ns(ji,jsl,jst) = MIN(un, MAX(zero, &
5257	(sm(ji,jsl)-smw(ji,jsl))/(sms(ji,jsl)-smw(ji,jsl)) ))
5258	END DO
5259	END DO
5260
5261	! Compute us and the new humrelv to use in sechiba (with loops on the vegetation types)
5262	! This is the water stress for transpiration (diffuco) and photosynthesis (diffuco)
5263	! humrel is never used in stomate
5264	! Based on liquid water content
5265
5266	! -- PFT1
5267	humrelv(:,1,jst) = zero
5268	! -- Top layer
5269	DO jv = 2,nvm
5270	DO ji=1,kjpindex
5271	!- Here we make the assumption that roots do not take water from the 1st layer.
5272	us(ji,jv,jst,1) = zero
5273	humrelv(ji,jv,jst) = zero ! initialisation of the sum
5274	END DO
5275	ENDDO
5276
5277	!! Dynamic nroot to optimize water use: the root profile used to weight the water stress function
5278	!! of each soil layer is updated at each time step in order to match the soil water profile
5279	!! (the soil water content of each layer available for transpiration)
5280	IF (ok_dynroot) THEN
5281	DO jv = 1, nvm
5282	IF ( is_tree(jv) ) THEN
5283	DO ji = 1, kjpindex
5284	nroot_tmp(:) = zero
5285	DO jsl = 2, nslm
5286	nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) )
5287	ENDDO
5288	IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN
5289	nroot(ji,jv,:) = nroot_tmp(:)/SUM(nroot_tmp(:))
5290	ELSE
5291	nroot(ji,jv,:) = zero
5292	END IF
5293	ENDDO
5294	ELSE
5295	! Specific case for grasses where we only consider the first 1m of soil.
5296	DO ji = 1, kjpindex
5297	nroot_tmp(:) = zero
5298	DO jsl = 2, nslm
5299	IF (znt(jsl) .LT. un) THEN
5300	nroot_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) )
5301	END IF
5302	ENDDO
5303
5304	IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN
5305	DO jsl = 2,nslm
5306	IF (znt(jsl) .LT. un) THEN
5307	nroot(ji,jv,jsl) = nroot_tmp(jsl)/SUM(nroot_tmp(:))
5308	ELSE
5309	nroot(ji,jv,jsl) = zero
5310	END IF
5311	ENDDO
5312	nroot(ji,jv,1) = zero
5313	END IF
5314	ENDDO
5315	END IF
5316	ENDDO
5317	ENDIF
5318
5319	! -- Intermediate and bottom layers
5320	DO jsl = 2,nslm
5321	DO jv = 2, nvm
5322	DO ji=1,kjpindex
5323	! AD16*** Although plants can only withdraw liquid water, we compute here the water stress
5324	! based on mc and the corresponding thresholds mcs, pcent, or potentially mcw and mcfc
5325	! This is consistent with assuming that ice is uniformly distributed within the poral space
5326	! In such a case, freezing makes mcl and the "liquid" porosity smaller than the "total" values
5327	! And it is the same for all the moisture thresholds, which are proportional to porosity.
5328	! Since the stress is based on relative moisture, it could thus independent from the porosity
5329	! at first order, thus independent from freezing.
5330	! 26-07-2017: us and humrel now based on liquid soil moisture, so the stress is stronger
5331	IF(new_watstress) THEN
5332	IF((sm(ji,jsl)-smw(ji,jsl)) .GT. min_sechiba) THEN
5333	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
5334	(EXP(- alpha_watstress * &
5335	( (smf(ji,jsl) - smw(ji,jsl)) / ( sm_nostress(ji,jsl) - smw(ji,jsl)) ) * &
5336	( (sm_nostress(ji,jsl) - sm(ji,jsl)) / ( sm(ji,jsl) - smw(ji,jsl)) ) ) ) ))&
5337	* nroot(ji,jv,jsl)
5338	ELSE
5339	us(ji,jv,jst,jsl) = 0.
5340	ENDIF
5341	ELSE
5342	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
5343	(sm(ji,jsl)-smw(ji,jsl))/(sm_nostress(ji,jsl)-smw(ji,jsl)) )) * nroot(ji,jv,jsl)
5344	ENDIF
5345	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)
5346	END DO
5347	END DO
5348	END DO
5349
5350	!! vegstressv is the water stress for phenology in stomate
5351	!! It varies linearly from zero at wilting point to 1 at field capacity
5352	vegstressv(:,:,jst) = zero
5353	DO jv = 2, nvm
5354	DO ji=1,kjpindex
5355	DO jsl=1,nslm
5356	vegstressv(ji,jv,jst) = vegstressv(ji,jv,jst) + &
5357	MIN(un, MAX(zero, (sm(ji,jsl)-smw(ji,jsl))/(smf(ji,jsl)-smw(ji,jsl)) )) &
5358	* nroot(ji,jv,jsl)
5359	END DO
5360	END DO
5361	END DO
5362
5363
5364	! -- If the PFT is absent, the corresponding humrelv and vegstressv = 0
5365	DO jv = 2, nvm
5366	DO ji = 1, kjpindex
5367	IF (vegetmax_soil(ji,jv,jst) .LT. min_sechiba) THEN
5368	humrelv(ji,jv,jst) = zero
5369	vegstressv(ji,jv,jst) = zero
5370	us(ji,jv,jst,:) = zero
5371	ENDIF
5372	END DO
5373	END DO
5374
5375	!! 6.2 We need to turn off evaporation when is_under_mcr
5376	!! We set us, humrelv and vegstressv to zero in this case
5377	!! WARNING: It's different from having locally us=0 in the soil layers(s) where mc<mcr
5378	!! This part is crucial to preserve water conservation
5379	DO jsl = 1,nslm
5380	DO jv = 2, nvm
5381	WHERE (is_under_mcr(:,jst))
5382	us(:,jv,jst,jsl) = zero
5383	ENDWHERE
5384	ENDDO
5385	ENDDO
5386	DO jv = 2, nvm
5387	WHERE (is_under_mcr(:,jst))
5388	humrelv(:,jv,jst) = zero
5389	ENDWHERE
5390	ENDDO
5391
5392	! For consistency in stomate, we also set moderwilt and soil_wet_ns to zero in this case.
5393	! They are used later for shumdiag and shumdiag_perma
5394	DO jsl = 1,nslm
5395	WHERE (is_under_mcr(:,jst))
5396	soil_wet_ns(:,jsl,jst) = zero
5397	ENDWHERE
5398	ENDDO
5399
5400	! Counting the nb of under_mcr occurences in each grid-cell
5401	WHERE (is_under_mcr(:,jst))
5402	undermcr = undermcr + un
5403	ENDWHERE
5404
5405	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
5406	!! thermosoil for the thermal conductivity.
5407	!! The multiplication by vegtot creates grid-cell average values
5408	! *** To be checked for consistency with the use of nobio properties in thermosoil
5409	DO jsl=1,nslm
5410	DO ji=1,kjpindex
5411	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
5412	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
5413	ENDDO
5414	END DO
5415
5416	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
5417	! (no call of hydrol_soil_coef since 2.1)
5418	! We average the values of each soiltile and keep the specific value (no multiplication by vegtot)
5419	DO ji = 1, kjpindex
5420	kk_moy(ji,:) = kk_moy(ji,:) + soiltile(ji,jst) * k(ji,:)
5421	kk(ji,:,jst) = k(ji,:)
5422	ENDDO
5423
5424	!! 6.5 We also want to export ksat at each node for CMIP6
5425	! (In the output, done only once according to field_def_orchidee.xml; same averaging as for kk)
5426	DO jsl = 1, nslm
5427	ksat(:,jsl) = ksat(:,jsl) + soiltile(:,jst) * &
5428	( ks(njsc(:)) * kfact(jsl,njsc(:)) * kfact_root(:,jsl,jst) )
5429	ENDDO
5430
5431	IF (printlev>=3) WRITE (numout,*) ' prognostic/diagnostic part of hydrol_soil done for jst =', jst
5432
5433	END DO ! end of loop on soiltile
5434
5435	!! -- ENDING THE MAIN LOOP ON SOILTILES
5436
5437	!! 7. Summing 3d variables into 2d variables
5438	CALL hydrol_diag_soil (kjpindex, veget_max, ratio_tile, soiltile, njsc, runoff, drainage, qtot_to_river,&!IGEM
5439	& evapot, vevapnu, returnflow, reinfiltration, irrigation, reinf_from_fast, flowtowtd,&!IGEM
5440	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,tot_melt)
5441
5442
5443	! Means of wtd, runoff and drainage corrections, across soiltiles
5444	wtd(:) = zero
5445	nstnowtd(:) = 0 !AD19
5446	ru_corr(:) = zero
5447	ru_corr2(:) = zero
5448	dr_corr(:) = zero
5449	dr_corrnum(:) = zero
5450	dr_force(:) = zero
5451	DO jst = 1, nstm
5452	DO ji = 1, kjpindex
5453	!wtd(ji) = wtd(ji) + soiltile(ji,jst) * wtd_ns(ji,jst) ! average over vegtot only !AD19
5454	IF (wtd_ns(ji,jst) .EQ. xios_default_val) nstnowtd(ji) = nstnowtd(ji)+1 !AD19
5455
5456	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
5457	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
5458	ru_corr(ji) = ru_corr(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr_ns(ji,jst)
5459	ru_corr2(ji) = ru_corr2(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr2_ns(ji,jst)
5460	dr_corr(ji) = dr_corr(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corr_ns(ji,jst)
5461	dr_corrnum(ji) = dr_corrnum(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corrnum_ns(ji,jst)
5462	dr_force(ji) = dr_force(ji) - vegtot(ji) * soiltile(ji,jst) * dr_force_ns(ji,jst)
5463	! the sign is OK to get a negative drainage flux
5464	ENDIF
5465	ENDDO
5466	ENDDO
5467
5468	!AD19 mean of wtd, with xios_default_val
5469	!the mean is not weighted by vegtot
5470	! we need to start the loop on ji
5471	DO ji = 1, kjpindex
5472	IF (nstnowtd(ji) .EQ. nstm) THEN
5473	wtd(ji) = xios_default_val
5474	ELSE
5475	DO jst = 1, nstm
5476	IF (wtd_ns(ji,jst) .NE. xios_default_val) THEN
5477	wtd(ji) = wtd(ji) + soiltile(ji,jst) * wtd_ns(ji,jst) ! average over vegtot only
5478	ENDIF
5479	ENDDO
5480	ENDIF
5481	ENDDO
5482
5483	! Means local variables, including water conservation checks
5484	ru_infilt(:)=0.
5485	qinfilt(:)=0.
5486	check_infilt(:)=0.
5487	check_tr(:)=0.
5488	check_over(:)=0.
5489	check_under(:)=0.
5490	DO jst = 1, nstm
5491	DO ji = 1, kjpindex
5492	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
5493	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
5494	ru_infilt(ji) = ru_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * ru_infilt_ns(ji,jst)
5495	qinfilt(ji) = qinfilt(ji) + vegtot(ji) * soiltile(ji,jst) * qinfilt_ns(ji,jst)
5496	ENDIF
5497	ENDDO
5498	ENDDO
5499
5500	IF (check_cwrr2) THEN
5501	DO jst = 1, nstm
5502	DO ji = 1, kjpindex
5503	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
5504	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
5505	check_infilt(ji) = check_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * check_infilt_ns(ji,jst)
5506	check_tr(ji) = check_tr(ji) + vegtot(ji) * soiltile(ji,jst) * check_tr_ns(ji,jst)
5507	check_over(ji) = check_over(ji) + vegtot(ji) * soiltile(ji,jst) * check_over_ns(ji,jst)
5508	check_under(ji) = check_under(ji) + vegtot(ji) * soiltile(ji,jst) * check_under_ns(ji,jst)
5509	ENDIF
5510	ENDDO
5511	ENDDO
5512	END IF
5513
5514	!! 8. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
5515	!! The principle is to run a dummy integration of the water redistribution scheme
5516	!! to check if the SM profile can sustain a potential evaporation.
5517	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
5518	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
5519
5520	! evap_bare_lim = beta factor for bare soil evaporation
5521	evap_bare_lim(:) = zero
5522	evap_bare_lim_ns(:,:) = zero
5523
5524	! Loop on soil tiles
5525	DO jst = 1,nstm
5526
5527	!! 8.1 Save actual mc, mcl, and tmc for restoring at the end of the time step
5528	!! and calculate tmcint corresponding to mc without water2infilt
5529	DO jsl = 1, nslm
5530	DO ji = 1, kjpindex
5531	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
5532	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
5533	ENDDO
5534	ENDDO
5535
5536	DO ji = 1, kjpindex
5537	temp(ji) = tmc(ji,jst)
5538	tmcint(ji) = temp(ji) - water2infilt(ji,jst) ! to estimate bare soil evap based on water budget
5539	ENDDO
5540
5541	!! 8.2 Since we estimate bare soile evap for the next time step, we update profil_froz_hydro and mcl
5542	! (effect of mc only, the change in temp_hydro is neglected)
5543	IF ( ok_freeze_cwrr ) CALL hydrol_soil_froz(kjpindex,jst,njsc)
5544	DO jsl = 1, nslm
5545	DO ji =1, kjpindex
5546	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(njsc(ji)) + &
5547	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
5548	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
5549	ENDDO
5550	ENDDO
5551
5552	!! 8.3 K and D are recomputed for the updated profile of mc/mcl
5553	CALL hydrol_soil_coef(kjpindex,jst,njsc)
5554
5555	!! 8.4 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
5556	CALL hydrol_soil_setup(kjpindex,jst)
5557	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
5558
5559	!! 8.5 We define the system of linear equations, based on matrix coefficients,
5560
5561	!- Impose potential evaporation as flux_top in mm/step, assuming the water is available
5562	! Note that this should lead to never have evapnu>evapot_penm(ji)
5563
5564	DO ji = 1, kjpindex
5565
5566	IF (vegtot(ji).GT.min_sechiba) THEN
5567
5568	! We calculate a reduced demand, by means of a soil resistance (Sellers et al., 1992)
5569	! It is based on the liquid SM only, like for us and humrel
5570	IF (do_rsoil) THEN
5571	mc_rel(ji) = tmc_litter(ji,jst)/tmcs_litter(ji) ! tmc_litter based on mcl
5572	! based on SM in the top 4 soil layers (litter) to smooth variability
5573	r_soil_ns(ji,jst) = exp(8.206 - 4.255 * mc_rel(ji))
5574	ELSE
5575	r_soil_ns(ji,jst) = zero
5576	ENDIF
5577
5578	! Aerodynamic resistance
5579	speed = MAX(min_wind, SQRT (u(ji)u(ji) + v(ji)v(ji)))
5580	IF (speed * tq_cdrag(ji) .GT. min_sechiba) THEN
5581	ra = un / (speed * tq_cdrag(ji))
5582	evap_soil(ji) = evapot_penm(ji) / (un + r_soil_ns(ji,jst)/ra)
5583	ELSE
5584	evap_soil(ji) = evapot_penm(ji)
5585	ENDIF
5586
5587	! AD16*** et si evap_bare_lim_ns<0 ?? car on suppose que tmcint > tmc(new)
5588	! (water2inflit permet de propager de la ponded water d'un pas de temps a l'autre:
5589	! peut-on s'en servir pour creer des cas d'evapnu potentielle negative ? a gerer dans diffuco ?)
5590
5591	flux_top(ji) = evap_soil(ji) * &
5592	AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
5593	ELSE
5594
5595	flux_top(ji) = zero
5596
5597	ENDIF
5598	ENDDO
5599
5600	! We don't use rootsinks, because we assume there is no transpiration in the bare soil fraction (??)
5601	!- First layer
5602	DO ji = 1, kjpindex
5603	tmat(ji,1,1) = zero
5604	tmat(ji,1,2) = f(ji,1)
5605	tmat(ji,1,3) = g1(ji,1)
5606	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
5607	- flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) &
5608	- lateral_sink(ji,1,jst) !IGEM
5609	ENDDO
5610	!- soil body
5611	DO jsl=2, nslm-1
5612	DO ji = 1, kjpindex
5613	tmat(ji,jsl,1) = e(ji,jsl)
5614	tmat(ji,jsl,2) = f(ji,jsl)
5615	tmat(ji,jsl,3) = g1(ji,jsl)
5616	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
5617	+ gp(ji,jsl) * mcl(ji,jsl+1,jst) &
5618	+ (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux &
5619	- lateral_sink(ji,jsl,jst) !IGEM
5620	ENDDO
5621	ENDDO
5622	!- Last layer
5623	DO ji = 1, kjpindex
5624	jsl=nslm
5625	tmat(ji,jsl,1) = e(ji,jsl)
5626	tmat(ji,jsl,2) = f(ji,jsl)
5627	tmat(ji,jsl,3) = zero
5628	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
5629	+ (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
5630	- lateral_sink(ji,jsl,jst) !IGEM
5631	ENDDO
5632	!- Store the equations for later use (9.6)
5633	DO jsl=1,nslm
5634	DO ji = 1, kjpindex
5635	srhs(ji,jsl) = rhs(ji,jsl)
5636	stmat(ji,jsl,1) = tmat(ji,jsl,1)
5637	stmat(ji,jsl,2) = tmat(ji,jsl,2)
5638	stmat(ji,jsl,3) = tmat(ji,jsl,3)
5639	ENDDO
5640	ENDDO
5641
5642	!! 8.6 Solve the diffusion equation, assuming that flux_top=evapot_penm (updates mcl)
5643	CALL hydrol_soil_tridiag(kjpindex,jst)
5644
5645	!! 9.7 Alternative solution with mc(1)=mcr in points where the above solution leads to mcl<mcr
5646	! hydrol_soil_tridiag calculates mc recursively from the top as a fonction of rhs and tmat
5647	! We re-use these the above values, but for mc(1)=mcr and the related tmat
5648
5649	DO ji = 1, kjpindex
5650	! by construction, mc and mcl are always on the same side of mcr, so we can use mcl here
5651	resolv(ji) = (mcl(ji,1,jst).LT.(mcr(njsc(ji))).AND.flux_top(ji).GT.min_sechiba)
5652	!IGEM19
5653	IF(resolv(ji)) THEN
5654	check_resolv(ji,jst) = 1.0
5655	ELSE
5656	check_resolv(ji,jst) = 0.0
5657	ENDIF
5658	!End IGEM19
5659	ENDDO
5660
5661	!! Reset the coefficient for diffusion (tridiag is only solved if resolv(ji) = .TRUE.)O
5662	DO jsl=1,nslm
5663	!- The new condition is to put the upper layer at residual soil moisture
5664	DO ji = 1, kjpindex
5665	rhs(ji,jsl) = srhs(ji,jsl)
5666	tmat(ji,jsl,1) = stmat(ji,jsl,1)
5667	tmat(ji,jsl,2) = stmat(ji,jsl,2)
5668	tmat(ji,jsl,3) = stmat(ji,jsl,3)
5669	END DO
5670	END DO
5671
5672	DO ji = 1, kjpindex
5673	tmat(ji,1,2) = un
5674	tmat(ji,1,3) = zero
5675	rhs(ji,1) = mcr(njsc(ji))
5676	ENDDO
5677
5678	tmat_diag(:,jst) = tmat(ji,1,2) !IGEM19pourtest
5679
5680
5681	! Solves the diffusion equation with new surface bc where resolv=T
5682	CALL hydrol_soil_tridiag(kjpindex,jst)
5683
5684	!! 8.8 In both case, we have drainage to be consistent with rhs
5685	DO ji = 1, kjpindex
5686	flux_bottom(ji) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst) * (dt_sechiba/one_day)
5687	ENDDO
5688
5689	!! 8.9 Water budget to assess the top flux = soil evaporation
5690	! Where resolv=F at the 2nd step (9.6), it should simply be the potential evaporation
5691
5692	! Total soil moisture content for water budget
5693
5694	DO jsl = 1, nslm
5695	DO ji =1, kjpindex
5696	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
5697	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(njsc(ji))) )
5698	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
5699	ENDDO
5700	ENDDO
5701
5702	DO ji = 1, kjpindex
5703	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
5704	ENDDO
5705	DO jsl = 2,nslm-1
5706	DO ji = 1, kjpindex
5707	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
5708	* (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
5709	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
5710	ENDDO
5711	ENDDO
5712	DO ji = 1, kjpindex
5713	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
5714	* (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
5715	END DO
5716
5717
5718	!IGEM2018:
5719	!This part is mofified to help to understand some behavior of transpir
5720	!and evapnu.
5721	!evap_bare_lim_ns(:,jst) = zero
5722	!WHERE(resolv(:) .EQV. .FALSE.) evap_bare_lim_ns(:,jst) = flux_top(:)
5723	!End IGEMTV2018
5724
5725	! Deduce upper flux from soil moisture variation and bottom flux
5726	! TMCi-D-BSE=TMC (BSE=bare soil evap=TMCi-TMC-D)
5727	! The numerical errors of tridiag close to saturation cannot be simply solved here,
5728	! we can only hope they are not too large because we don't add water at this stage...
5729	DO ji = 1, kjpindex
5730	diag_lat(ji)=SUM(lateral_sink(ji,:,jst)) !IGEM19
5731	evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
5732	(tmcint(ji)-tmc(ji,jst)-flux_bottom(ji)-diag_lat(ji))
5733	END DO
5734
5735	check_fluxtop(:,jst) = evap_bare_lim_ns(:,jst)-evap_soil(:) !IGEM19pourtest
5736
5737	tmc_before_diag(:,jst) = tmcint(:) !IGEM19pourtest
5738	tmc_after_diag(:,jst) = tmc(:,jst) !IGEM19pourtest
5739	qlat_ns_diag(:,jst) = diag_lat(:) !IGEM19pourtest
5740	flxbot_diag(:,jst) = flux_bottom(:) !IGEM19pourtest
5741	flxtop_diag(:,jst) = flux_top(:) !IGEM19pourtest
5742
5743	!! 8.10 evap_bare_lim_ns is turned from an evaporation rate to a beta
5744	DO ji = 1, kjpindex
5745	! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil.
5746	! This is given by frac_bare_ns, taking into account bare soil under vegetation
5747	IF(vegtot(ji) .GT. min_sechiba) THEN
5748	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) * frac_bare_ns(ji,jst)
5749	ELSE
5750	evap_bare_lim_ns(ji,jst) = 0.
5751	ENDIF
5752	END DO
5753
5754	! We divide by evapot, which is consistent with diffuco (evap_bare_lim_ns < evapot_penm/evapot)
5755	! Further decrease if tmc_litter is below the wilting point
5756
5757	IF (do_rsoil) THEN
5758	DO ji=1,kjpindex
5759	IF (evapot(ji).GT.min_sechiba) THEN
5760	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
5761	ELSE
5762	evap_bare_lim_ns(ji,jst) = zero ! not redundant with the is_under_mcr case below
5763	! but not necessarily useful
5764	END IF
5765	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
5766	END DO
5767	ELSE
5768	DO ji=1,kjpindex
5769	IF ((evapot(ji).GT.min_sechiba) .AND. &
5770	(tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN
5771	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
5772	ELSEIF((evapot(ji).GT.min_sechiba).AND. &
5773	(tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN
5774	evap_bare_lim_ns(ji,jst) = (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji)
5775	! This is very arbitrary, with no justification from the literature
5776	ELSE
5777	evap_bare_lim_ns(ji,jst) = zero
5778	END IF
5779	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
5780	END DO
5781	ENDIF
5782
5783	!! 8.11 Set evap_bare_lim_ns to zero if is_under_mcr at the end of the prognostic loop
5784	!! (cf us, humrelv, vegstressv in 5.2)
5785	WHERE (is_under_mcr(:,jst))
5786	evap_bare_lim_ns(:,jst) = zero
5787	ENDWHERE
5788
5789	!! 8.12 Restores mc, mcl, and tmc, to erase the effect of the dummy integrations
5790	!! on these prognostic variables
5791	DO jsl = 1, nslm
5792	DO ji = 1, kjpindex
5793	mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
5794	mcl(ji,jsl,jst) = mask_soiltile(ji,jst) * mclint(ji,jsl)
5795	ENDDO
5796	ENDDO
5797	DO ji = 1, kjpindex
5798	tmc(ji,jst) = temp(ji)
5799	ENDDO
5800
5801	ENDDO !end loop on tiles for dummy integration
5802
5803	!! 9. evap_bar_lim is the grid-cell scale beta
5804	DO ji = 1, kjpindex
5805	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
5806	r_soil(ji) = SUM(r_soil_ns(ji,:)vegtot(ji)soiltile(ji,:))
5807	ENDDO
5808	! si vegtot LE min_sechiba, evap_bare_lim_ns et evap_bare_lim valent zero
5809
5810	!! 10. XIOS export of local variables, including water conservation checks
5811
5812	CALL xios_orchidee_send_field("ksat",ksat) ! mm/d (for CMIP6, once)
5813	CALL xios_orchidee_send_field("psi_moy",psi_moy) ! mm (for SP-MIP)
5814	CALL xios_orchidee_send_field("wtd",wtd) ! in m
5815	CALL xios_orchidee_send_field("ru_corr",ru_corr/dt_sechiba) ! adjustment flux added to surface runoff (included in runoff)
5816	CALL xios_orchidee_send_field("ru_corr2",ru_corr2/dt_sechiba)
5817	CALL xios_orchidee_send_field("dr_corr",dr_corr/dt_sechiba) ! adjustment flux added to drainage (included in drainage)
5818	CALL xios_orchidee_send_field("dr_corrnum",dr_corrnum/dt_sechiba)
5819	!CALL xios_orchidee_send_field("dr_force",dr_force/dt_sechiba) ! adjustement flux added to drainage to sustain a forced wtd
5820	CALL xios_orchidee_send_field("qinfilt",qinfilt/dt_sechiba)
5821	CALL xios_orchidee_send_field("ru_infilt",ru_infilt/dt_sechiba)
5822	CALL xios_orchidee_send_field("ru_infilt_ns",ru_infilt_ns/dt_sechiba) !IGEM
5823	CALL xios_orchidee_send_field("r_soil",r_soil) ! s/m
5824	CALL xios_orchidee_send_field("wtd_ns",wtd_ns) !(m) IGEM
5825	CALL xios_orchidee_send_field("qlat",qlat/dt_sechiba) !kg/m2grid/s IGEM
5826	CALL xios_orchidee_send_field("dr_to_river",dr_to_river/dt_sechiba) !kg/m2grid/s IGEM
5827	CALL xios_orchidee_send_field("ru_to_river",ru_to_river/dt_sechiba) !kg/m2grid/s IGEM
5828	CALL xios_orchidee_send_field("free_drain_coef",free_drain_coef) !IGEM
5829	!CALL xios_orchidee_send_field("mc_before_corr",mc_before_corr) !IGEM
5830	!CALL xios_orchidee_send_field("mc_after_corr",mc_after_corr) !IGEM
5831	!CALL xios_orchidee_send_field("evap_bare_lim",evap_bare_lim) !IGEM ! now in diffuco
5832	!CALL xios_orchidee_send_field("evap_bare_lim_ns",evap_bare_lim_ns) !IGEM ! now in diffuco
5833	CALL xios_orchidee_send_field("check_resolv",check_resolv) !IGEM19
5834	CALL xios_orchidee_send_field("check_fluxtop",check_fluxtop) !IGEM19
5835	CALL xios_orchidee_send_field("tmat_diag",tmat_diag) !IGEM19
5836	CALL xios_orchidee_send_field("tmc_before_diag",tmc_before_diag) !IGEM19
5837	CALL xios_orchidee_send_field("tmc_after_diag",tmc_after_diag) !IGEM19
5838	CALL xios_orchidee_send_field("qlat_ns_diag",qlat_ns_diag) !IGEM19
5839	CALL xios_orchidee_send_field("flxbot_diag",flxbot_diag) !IGEM19
5840	CALL xios_orchidee_send_field("flxtop_diag",flxtop_diag) !IGEM19
5841
5842
5843	IF (check_cwrr2) THEN
5844	CALL xios_orchidee_send_field("check_infilt",check_infilt/dt_sechiba)
5845	CALL xios_orchidee_send_field("check_tr",check_tr/dt_sechiba)
5846	CALL xios_orchidee_send_field("check_over",check_over/dt_sechiba)
5847	CALL xios_orchidee_send_field("check_under",check_under/dt_sechiba)
5848	CALL xios_orchidee_send_field("check_tr_ns",check_tr_ns/dt_sechiba) !IGEM
5849	CALL xios_orchidee_send_field("check_infilt_ns",check_infilt_ns/dt_sechiba)!IGEM
5850	CALL xios_orchidee_send_field("dr_corrnum_ns",dr_corrnum_ns/dt_sechiba)
5851	CALL xios_orchidee_send_field("dr_corr_ns",dr_corr_ns/dt_sechiba) !IGEM
5852	CALL xios_orchidee_send_field("ru_corr_ns",ru_corr_ns/dt_sechiba)!IGEM
5853	CALL xios_orchidee_send_field("ru_corr2_ns",ru_corr2_ns/dt_sechiba)!IGEM
5854	CALL xios_orchidee_send_field("swbr_ns",swbr_ns/dt_sechiba)!IGEM
5855	END IF
5856
5857	!! 11. Exit if error was found previously in this subroutine
5858
5859	IF ( error ) THEN
5860	WRITE(numout,*) 'One or more errors have been detected in hydrol_soil. Model stops.'
5861	CALL ipslerr_p(3, 'hydrol_soil', 'We will STOP now.',&
5862	& 'One or several fatal errors were found previously.','')
5863	END IF
5864
5865	END SUBROUTINE hydrol_soil
5866
5867
5868	!! ================================================================================================================================
5869	!! SUBROUTINE : hydrol_soil_infilt
5870	!!
5871	!>\BRIEF Infiltration
5872	!!
5873	!! DESCRIPTION :
5874	!! 1. We calculate the total SM at the beginning of the routine
5875	!! 2. Infiltration process
5876	!! 2.1 Initialization of time counter and infiltration rate
5877	!! 2.2 Infiltration layer by layer, accounting for an exponential law for subgrid variability
5878	!! 2.3 Resulting infiltration and surface runoff
5879	!! 3. For water conservation check, we calculate the total SM at the beginning of the routine,
5880	!! and export the difference with the flux
5881	!! 5. Local verification
5882	!!
5883	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5884	!! Adding checks and interactions variables with hydrol_soil, but the processes are unchanged
5885	!!
5886	!! MAIN OUTPUT VARIABLE(S) :
5887	!!
5888	!! REFERENCE(S) :
5889	!!
5890	!! FLOWCHART : None
5891	!! \n
5892	!_ ================================================================================================================================
5893	!_ hydrol_soil_infilt
5894
5895	SUBROUTINE hydrol_soil_infilt(kjpindex, ins, njsc, flux_infilt, qinfilt_ns, ru_infilt, check)
5896
5897	!! 0. Variable and parameter declaration
5898
5899	!! 0.1 Input variables
5900
5901	! GLOBAL (in or inout)
5902	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5903	INTEGER(i_std), INTENT(in) :: ins
5904	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell
5905	!! (1-nscm, unitless)
5906	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: flux_infilt !! Water to infiltrate (nstm: IGEM)
5907	!! @tex $(kg m^{-2})$ @endtex
5908
5909	!! 0.2 Output variables
5910	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux (mm/dt_sechiba)
5911	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: ru_infilt !! Surface runoff from soil_infilt (mm/dt_sechiba)
5912	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: qinfilt_ns !! Effective infiltration flux (mm/dt_sechiba)
5913
5914	!! 0.3 Modified variables
5915
5916	!! 0.4 Local variables
5917
5918	INTEGER(i_std) :: ji, jsl !! Indices
5919	REAL(r_std), DIMENSION (kjpindex) :: wat_inf_pot !! infiltrable water in the layer
5920	REAL(r_std), DIMENSION (kjpindex) :: wat_inf !! infiltrated water in the layer
5921	REAL(r_std), DIMENSION (kjpindex) :: dt_tmp !! time remaining before the end of the time step
5922	REAL(r_std), DIMENSION (kjpindex) :: dt_inf !! the time it takes to complete the infiltration in the
5923	!! layer
5924	REAL(r_std) :: k_m !! the mean conductivity used for the saturated front
5925	REAL(r_std), DIMENSION (kjpindex) :: infilt_tmp !! infiltration rate for the considered layer
5926	REAL(r_std), DIMENSION (kjpindex) :: infilt_tot !! total infiltration
5927	REAL(r_std), DIMENSION (kjpindex) :: flux_tmp !! rate at which precip hits the ground
5928
5929	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine (kg/m2)
5930	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine (kg/m2)
5931
5932
5933	!_ ================================================================================================================================
5934
5935	! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
5936
5937	!! 1. We calculate the total SM at the beginning of the routine
5938	IF (check_cwrr2) THEN
5939	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5940	DO jsl = 2,nslm-1
5941	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5942	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5943	ENDDO
5944	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5945	ENDIF
5946
5947	!! 2. Infiltration process
5948
5949	!! 2.1 Initialization
5950
5951	DO ji = 1, kjpindex
5952	!! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
5953	wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,1,ins)) * dz(2) / deux, zero)
5954	wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji,ins)) !IGEM(ins)
5955	mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2)
5956	!
5957	ENDDO
5958
5959	!! Initialize a countdown for infiltration during the time-step and the value of potential runoff
5960	dt_tmp(:) = dt_sechiba / one_day
5961	infilt_tot(:) = wat_inf(:)
5962	!! Compute the rate at which water will try to infiltrate each layer
5963	! flux_temp is converted here to the same unit as k_m
5964	flux_tmp(:) = (flux_infilt(:,ins)-wat_inf(:)) / dt_tmp(:) !IGEM (ins)
5965
5966	!! 2.2 Infiltration layer by layer
5967	DO jsl = 2, nslm-1
5968	DO ji = 1, kjpindex
5969	!! Infiltrability of each layer if under a saturated one
5970	! This is computed by an simple arithmetic average because
5971	! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
5972	k_m = (k(ji,jsl) + ks(njsc(ji))kfact(jsl-1,njsc(ji))kfact_root(ji,jsl,ins)) / deux
5973
5974	IF (ok_freeze_cwrr) THEN
5975	IF (temp_hydro(ji, jsl) .LT. ZeroCelsius) THEN
5976	k_m = k(ji,jsl)
5977	ENDIF
5978	ENDIF
5979
5980	!! We compute the mean rate at which water actually infiltrate:
5981	! Subgrid: Exponential distribution of k around k_m, but average p directly used
5982	! See d'Orgeval 2006, p 78, but it's not fully clear to me (AD16***)
5983	infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m))
5984
5985	!! From which we deduce the time it takes to fill up the layer or to end the time step...
5986	wat_inf_pot(ji) = MAX((mcs(njsc(ji))-mc(ji,jsl,ins)) * (dz(jsl) + dz(jsl+1)) / deux, zero)
5987	IF ( infilt_tmp(ji) > min_sechiba) THEN
5988	dt_inf(ji) = MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
5989	! The water infiltration TIME has to limited by what is still available for infiltration.
5990	IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji,ins)-infilt_tot(ji) ) THEN !IGEM(ins)
5991	dt_inf(ji) = MAX(flux_infilt(ji,ins)-infilt_tot(ji),zero)/infilt_tmp(ji) !IGEM(ins)
5992	ENDIF
5993	ELSE
5994	dt_inf(ji) = dt_tmp(ji)
5995	ENDIF
5996
5997	!! The water enters in the layer
5998	wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
5999	! bviously the moisture content
6000	mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
6001	& wat_inf(ji) * deux / (dz(jsl) + dz(jsl+1))
6002	! the time remaining before the next time step
6003	dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
6004	! and finally the infilt_tot (which is just used to check if there is a problem, below)
6005	infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
6006	ENDDO
6007	ENDDO
6008
6009	!! 2.3 Resulting infiltration and surface runoff
6010	ru_infilt(:,ins) = flux_infilt(:,ins) - infilt_tot(:)
6011	qinfilt_ns(:,ins) = infilt_tot(:)
6012
6013	!! 3. For water conservation check: we calculate the total SM at the beginning of the routine
6014	!! and export the difference with the flux
6015	IF (check_cwrr2) THEN
6016	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6017	DO jsl = 2,nslm-1
6018	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6019	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6020	ENDDO
6021	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6022	! Normally, tcmf=tmci+infilt_tot
6023	check(:,ins) = tmcf(:)-(tmci(:)+infilt_tot(:))
6024	ENDIF
6025
6026	!! 5. Local verification
6027	DO ji = 1, kjpindex
6028	IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji,ins) + min_sechiba) THEN
6029	WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
6030	WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
6031	CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
6032	ENDIF
6033	ENDDO
6034
6035	END SUBROUTINE hydrol_soil_infilt
6036
6037
6038
6039
6040	SUBROUTINE hydrol_soil_wtd(kjpindex, njsc, soiltile, influx_from_bottom, ru_wtd, check_wtd)
6041	!! 0. Variable and parameter declaration
6042	!! 0.1 Input variables
6043	! GLOBAL (in or inout)
6044	INTEGER(i_std), INTENT(in) :: kjpindex !!Domain size
6045	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !!Index of the dominant soil textural class in the grid cell
6046	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: influx_from_bottom !!Water to infiltrate [kg/m2(tile)/dtsechiba]
6047	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile
6048	REAL(r_std), DIMENSION (kjpindex), INTENT (inout) :: ru_wtd
6049	!! 0.4 Local variables
6050	INTEGER(i_std) :: ji, jsl, jstm, ins !! Indices
6051	REAL(r_std), DIMENSION (kjpindex) :: to_inject !! infiltrable [kg/m2(tile)/dtsechiba]
6052	REAL(r_std), DIMENSION (kjpindex) :: to_infiltrate !! to infiltrate [kg/m2(tile)/dtsechiba]
6053	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM before infilt [kg/m2(tile)]
6054	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM after infilt [kg/m2(tile)]
6055	REAL(r_std), DIMENSION(kjpindex) :: check
6056	REAL(r_std), DIMENSION(kjpindex),INTENT (inout) :: check_wtd
6057
6058
6059	!Initialization
6060	to_infiltrate(:) = zero
6061	ru_wtd(:) = zero
6062	tmci(:) = zero
6063	tmcf(:) = zero
6064	ins = 4 !4th soiltile index
6065
6066
6067	IF (check_cwrr2) THEN
6068	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6069	DO jsl = 2,nslm-1
6070	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6071	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6072	ENDDO
6073	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6074	ENDIF
6075
6076
6077	!Infiltration process
6078
6079	to_infiltrate(:) = influx_from_bottom(:) !mm
6080	!write(numout,*)'influx_from_bottom',influx_from_bottom(:)
6081
6082	DO ji = 1, kjpindex
6083	IF(to_infiltrate(ji) .GT. zero)THEN
6084	!! 1.1 Filling the bottom layer
6085	to_inject(ji) = MIN(to_infiltrate(ji) , MAX((mcs(njsc(ji))-mc(ji,nslm,4)) * dz(nslm-1)/deux, zero))
6086	mc(ji,nslm,4) = mc(ji,nslm,4) + to_inject(ji)* deux/dz(nslm)
6087	to_infiltrate(ji) = to_infiltrate(ji)-to_inject(ji)
6088
6089	!! 1.2 Filling iteratively the next layers from the bottom to the surface
6090	DO jsl = nslm-1,2,-1
6091	to_inject(ji) = MIN(to_infiltrate(ji) , MAX((mcs(njsc(ji))-mc(ji,jsl,4)) * (dz(jsl)+dz(jsl+1))/deux, zero))
6092	mc(ji,jsl,4) = mc(ji,jsl,4) + to_inject(ji)*deux/(dz(jsl)+dz(jsl+1))
6093	to_infiltrate(ji) = to_infiltrate(ji)-to_inject(ji)
6094	ENDDO
6095
6096	!! 1.3 Filling the first layer
6097	to_inject(ji) = MIN(to_infiltrate(ji),MAX((mcs(njsc(ji))-mc(ji,1,4)) * dz(2)/deux, zero))
6098	mc(ji,1,4) = mc(ji,1,4) + to_inject(ji)* deux/dz(2)
6099	to_infiltrate(ji) = to_infiltrate(ji)-to_inject(ji)
6100	ENDIF
6101	ENDDO
6102
6103
6104	IF (check_cwrr2) THEN
6105	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6106	DO jsl = 2,nslm-1
6107	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6108	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6109	ENDDO
6110	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6111	check_wtd(:) = tmcf(:)-(tmci(:)+((influx_from_bottom(:)-to_infiltrate(:))))
6112	ENDIF
6113
6114	! Not infiltrated water to be put in the surface runoff of the 4th tile.
6115	ru_wtd(:) = to_infiltrate(:)
6116
6117	END SUBROUTINE hydrol_soil_wtd
6118
6119	!! ================================================================================================================================
6120	!! SUBROUTINE : hydrol_soil_smooth_under_mcr
6121	!!
6122	!>\BRIEF : Modifies the soil moisture profile to avoid under-residual values,
6123	!! then diagnoses the points where such "excess" values remain.
6124	!!
6125	!! DESCRIPTION :
6126	!! The "excesses" under-residual are corrected from top to bottom, by transfer of excesses
6127	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
6128	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
6129	!! and the remaining "excess" is necessarily concentrated in the top layer.
6130	!! This allowing diagnosing the flag is_under_mcr.
6131	!! Eventually, the remaining "excess" is split over the entire profile
6132	!! 1. We calculate the total SM at the beginning of the routine
6133	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
6134	!! Note that we check that mc > min_sechiba in hydrol_soil
6135	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
6136	!! and export the difference with the flux
6137	!!
6138	!! RECENT CHANGE(S) : 2016 by A. Ducharne
6139	!!
6140	!! MAIN OUTPUT VARIABLE(S) :
6141	!!
6142	!! REFERENCE(S) :
6143	!!
6144	!! FLOWCHART : None
6145	!! \n
6146	!_ ================================================================================================================================
6147	!_ hydrol_soil_smooth_under_mcr
6148
6149	SUBROUTINE hydrol_soil_smooth_under_mcr(kjpindex, ins, njsc, is_under_mcr, check)
6150
6151	!- arguments
6152
6153	!! 0. Variable and parameter declaration
6154
6155	!! 0.1 Input variables
6156
6157	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6158	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
6159	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
6160	!! (1-nscm, unitless)
6161
6162	!! 0.2 Output variables
6163
6164	LOGICAL, DIMENSION(kjpindex,nstm), INTENT(out) :: is_under_mcr !! Flag diagnosing under residual soil moisture
6165	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
6166
6167	!! 0.3 Modified variables
6168
6169	!! 0.4 Local variables
6170
6171	INTEGER(i_std) :: ji,jsl
6172	REAL(r_std) :: excess
6173	REAL(r_std), DIMENSION(kjpindex) :: excessji
6174	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
6175	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
6176
6177	!_ ================================================================================================================================
6178
6179	!! 1. We calculate the total SM at the beginning of the routine
6180	IF (check_cwrr2) THEN
6181	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6182	DO jsl = 2,nslm-1
6183	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6184	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6185	ENDDO
6186	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6187	ENDIF
6188
6189	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
6190
6191	! 2.1 smoothing from top to bottom
6192	DO jsl = 1,nslm-2
6193	DO ji=1, kjpindex
6194	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
6195	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
6196	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
6197	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
6198	ENDDO
6199	ENDDO
6200
6201	jsl = nslm-1
6202	DO ji=1, kjpindex
6203	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
6204	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
6205	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
6206	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
6207	ENDDO
6208
6209	jsl = nslm
6210	DO ji=1, kjpindex
6211	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
6212	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
6213	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
6214	& dz(jsl)/(dz(jsl-1)+dz(jsl))
6215	ENDDO
6216
6217	! 2.2 smoothing from bottom to top
6218	DO jsl = nslm-1,2,-1
6219	DO ji=1, kjpindex
6220	excess = MAX(mcr(njsc(ji))-mc(ji,jsl,ins),zero)
6221	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
6222	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
6223	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
6224	ENDDO
6225	ENDDO
6226
6227	! 2.3 diagnoses is_under_mcr(ji), and updates the entire profile
6228	! excess > 0
6229	DO ji=1, kjpindex
6230	excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(njsc(ji))-mc(ji,1,ins),zero)
6231	ENDDO
6232	DO ji=1, kjpindex
6233	mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji) ! then mc(1)=mcr
6234	is_under_mcr(ji,ins) = (excessji(ji) .GT. min_sechiba)
6235	ENDDO
6236
6237	! 2.4 The amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
6238	! -excess(ji) * dz(2) / deux donne le deficit total, negatif, en mm
6239	! diviser par la profondeur totale en mm donne des delta_mc identiques en chaque couche, en mm
6240	! retransformes en delta_mm par couche selon les bonnes eqs (eqs_hydrol.pdf, Eqs 13-15), puis sommes
6241	! retourne bien le deficit total en mm
6242	DO jsl = 1, nslm
6243	DO ji=1, kjpindex
6244	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2) / (deux * zmaxh*mille)
6245	ENDDO
6246	ENDDO
6247	! This can lead to mc(jsl) < mcr depending on the value of excess,
6248	! but this is no major pb for the diffusion
6249	! Yet, we need to prevent evaporation if is_under_mcr
6250
6251	!! Note that we check that mc > min_sechiba in hydrol_soil
6252
6253	! We just make sure that mc remains at 0 where soiltile=0
6254	DO jsl = 1, nslm
6255	DO ji=1, kjpindex
6256	mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
6257	ENDDO
6258	ENDDO
6259
6260	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
6261	!! and export the difference with the flux
6262	IF (check_cwrr2) THEN
6263	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6264	DO jsl = 2,nslm-1
6265	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6266	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6267	ENDDO
6268	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6269	! Normally, tcmf=tmci since we just redistribute the deficit
6270	check(:,ins) = tmcf(:)-tmci(:)
6271	ENDIF
6272
6273	END SUBROUTINE hydrol_soil_smooth_under_mcr
6274
6275
6276	!! ================================================================================================================================
6277	!! SUBROUTINE : hydrol_soil_smooth_over_mcs
6278	!!
6279	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
6280	!! by putting the excess in ru_ns
6281	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
6282	!!
6283	!! DESCRIPTION :
6284	!! The "excesses" over-saturation are corrected from top to bottom, by transfer of excesses
6285	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
6286	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
6287	!! and the remaining "excess" is necessarily concentrated in the top layer.
6288	!! Eventually, the remaining "excess" creates rudr_corr, to be added to ru_ns or dr_ns
6289	!! 1. We calculate the total SM at the beginning of the routine
6290	!! 2. In case of over-saturation we put the water where it is possible by smoothing
6291	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
6292	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
6293	!! and export the difference with the flux
6294	!!
6295	!! RECENT CHANGE(S) : 2016 by A. Ducharne
6296	!!
6297	!! MAIN OUTPUT VARIABLE(S) :
6298	!!
6299	!! REFERENCE(S) :
6300	!!
6301	!! FLOWCHART : None
6302	!! \n
6303	!_ ================================================================================================================================
6304	!_ hydrol_soil_smooth_over_mcs
6305
6306	SUBROUTINE hydrol_soil_smooth_over_mcs(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
6307
6308	!- arguments
6309
6310	!! 0. Variable and parameter declaration
6311
6312	!! 0.1 Input variables
6313
6314	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6315	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
6316	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
6317	!! (1-nscm, unitless)
6318
6319	!! 0.2 Output variables
6320
6321	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
6322	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
6323
6324	!! 0.3 Modified variables
6325	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
6326
6327	!! 0.4 Local variables
6328
6329	INTEGER(i_std) :: ji,jsl
6330	REAL(r_std) :: excess
6331	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
6332	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
6333
6334	!_ ================================================================================================================================
6335
6336	!! 1. We calculate the total SM at the beginning of the routine
6337	IF (check_cwrr2) THEN
6338	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6339	DO jsl = 2,nslm-1
6340	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6341	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6342	ENDDO
6343	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6344	ENDIF
6345
6346	!! 2. In case of over-saturation we put the water where it is possible by smoothing
6347
6348	! 2.1 smoothing from top to bottom
6349	DO jsl = 1, nslm-2
6350	DO ji=1, kjpindex
6351	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
6352	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
6353	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
6354	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
6355	ENDDO
6356	ENDDO
6357
6358	jsl = nslm-1
6359	DO ji=1, kjpindex
6360	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
6361	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
6362	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
6363	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
6364	ENDDO
6365
6366	jsl = nslm
6367	DO ji=1, kjpindex
6368	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
6369	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
6370	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
6371	& dz(jsl)/(dz(jsl-1)+dz(jsl))
6372	ENDDO
6373
6374	! 2.2 smoothing from bottom to top, leading to keep most of the excess in the soil column
6375	DO jsl = nslm-1,2,-1
6376	DO ji=1, kjpindex
6377	excess = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero)
6378	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
6379	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
6380	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
6381	ENDDO
6382	ENDDO
6383
6384	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
6385
6386	DO ji=1, kjpindex
6387	excess = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(njsc(ji)),zero)
6388	mc(ji,1,ins) = mc(ji,1,ins) - excess ! then mc(1)=mcs
6389	rudr_corr(ji,ins) = rudr_corr(ji,ins) + excess * dz(2) / deux
6390	is_over_mcs(ji) = .FALSE.
6391	ENDDO
6392
6393	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
6394	!! and export the difference with the flux
6395
6396	IF (check_cwrr2) THEN
6397	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6398	DO jsl = 2,nslm-1
6399	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6400	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6401	ENDDO
6402	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6403	! Normally, tcmf=tmci-rudr_corr
6404	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
6405	ENDIF
6406
6407	END SUBROUTINE hydrol_soil_smooth_over_mcs
6408
6409	!! ================================================================================================================================
6410	!! SUBROUTINE : hydrol_soil_smooth_over_mcs2
6411	!!
6412	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
6413	!! by putting the excess in ru_ns
6414	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
6415	!!
6416	!! DESCRIPTION :
6417	!! The "excesses" over-saturation are corrected, by directly discarding the excess as rudr_corr,
6418	!! to be added to ru_ns or dr_nsrunoff (via rudr_corr).
6419	!! Therefore, there is no more smoothing, and this helps preventing the saturation of too many layers,
6420	!! which leads to numerical errors with tridiag.
6421	!! 1. We calculate the total SM at the beginning of the routine
6422	!! 2. In case of over-saturation, we directly eliminate the excess via rudr_corr
6423	!! The calculation of the adjustement flux needs to account for nodes n-1 and n+1.
6424	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
6425	!! and export the difference with the flux
6426	!!
6427	!! RECENT CHANGE(S) : 2016 by A. Ducharne
6428	!!
6429	!! MAIN OUTPUT VARIABLE(S) :
6430	!!
6431	!! REFERENCE(S) :
6432	!!
6433	!! FLOWCHART : None
6434	!! \n
6435	!_ ================================================================================================================================
6436	!_ hydrol_soil_smooth_over_mcs2
6437
6438	SUBROUTINE hydrol_soil_smooth_over_mcs2(kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
6439
6440	!- arguments
6441
6442	!! 0. Variable and parameter declaration
6443
6444	!! 0.1 Input variables
6445
6446	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6447	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
6448	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
6449	!! (1-nscm, unitless)
6450
6451	!! 0.2 Output variables
6452
6453	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
6454	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
6455
6456	!! 0.3 Modified variables
6457	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
6458
6459	!! 0.4 Local variables
6460
6461	INTEGER(i_std) :: ji,jsl
6462	REAL(r_std), DIMENSION(kjpindex,nslm) :: excess
6463	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
6464	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
6465
6466	!_ ================================================================================================================================
6467	!-
6468
6469	!! 1. We calculate the total SM at the beginning of the routine
6470	IF (check_cwrr2) THEN
6471	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6472	DO jsl = 2,nslm-1
6473	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6474	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6475	ENDDO
6476	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6477	ENDIF
6478
6479	!! 2. In case of over-saturation, we don't do any smoothing,
6480	!! but directly eliminate the excess as runoff (via rudr_corr)
6481	! we correct the calculation of the adjustement flux, which needs to account for nodes n-1 and n+1
6482	! for the calculation to remain simple and accurate, we directly drain all the oversaturated mc,
6483	! without transfering to lower layers
6484
6485	!! 2.1 thresholding from top to bottom, with excess defined along jsl
6486	DO jsl = 1, nslm
6487	DO ji=1, kjpindex
6488	excess(ji,jsl) = MAX(mc(ji,jsl,ins)-mcs(njsc(ji)),zero) ! >=0
6489	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess(ji,jsl) ! here mc either does not change or decreases
6490	ENDDO
6491	ENDDO
6492
6493	!! 2.2 To ensure conservation, this needs to be balanced by additional drainage (in kg/m2/dt)
6494	DO ji = 1, kjpindex
6495	rudr_corr(ji,ins) = dz(2) * ( trois*excess(ji,1) + excess(ji,2) )/huit ! top layer = initialisation
6496	ENDDO
6497	DO jsl = 2,nslm-1 ! intermediate layers
6498	DO ji = 1, kjpindex
6499	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(jsl) &
6500	& * (trois*excess(ji,jsl)+excess(ji,jsl-1))/huit &
6501	& + dz(jsl+1) * (trois*excess(ji,jsl)+excess(ji,jsl+1))/huit
6502	ENDDO
6503	ENDDO
6504	DO ji = 1, kjpindex
6505	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(nslm) & ! bottom layer
6506	& * (trois * excess(ji,nslm) + excess(ji,nslm-1))/huit
6507	is_over_mcs(ji) = .FALSE.
6508	END DO
6509
6510	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
6511	!! and export the difference with the flux
6512
6513	IF (check_cwrr2) THEN
6514	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
6515	DO jsl = 2,nslm-1
6516	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
6517	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
6518	ENDDO
6519	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
6520	! Normally, tcmf=tmci-rudr_corr
6521	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
6522	ENDIF
6523
6524	END SUBROUTINE hydrol_soil_smooth_over_mcs2
6525
6526
6527	!! ================================================================================================================================
6528	!! SUBROUTINE : hydrol_soil_flux
6529	!!
6530	!>\BRIEF : This subroutine diagnoses the vertical liquid water fluxes between the
6531	!! different soil layers, based on each layer water budget. It also checks the
6532	!! corresponding water conservation (during redistribution).
6533	!!
6534	!! DESCRIPTION :
6535	!! 1. Initialize qflux from the bottom, with dr_ns
6536	!! 2. Between layer nslm and nslm-1, by means of water budget knowing mc changes and flux at the lowest interface
6537	!! 3. We go up, and deduct qflux(1:nslm-2), still by means of water budget
6538	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface should equal -flux_top
6539	!!
6540	!! RECENT CHANGE(S) : 2016 by A. Ducharne to fit hydrol_soil
6541	!!
6542	!! MAIN OUTPUT VARIABLE(S) :
6543	!!
6544	!! REFERENCE(S) :
6545	!!
6546	!! FLOWCHART : None
6547	!! \n
6548	!_ ================================================================================================================================
6549	!_ hydrol_soil_flux
6550
6551	SUBROUTINE hydrol_soil_flux(kjpindex,ins,mclint,flux_top)
6552	!
6553	!! 0. Variable and parameter declaration
6554
6555	!! 0.1 Input variables
6556
6557	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6558	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
6559	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mclint !! mc values at the beginning of the time step
6560	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flux_top !! Exfiltration (bare soil evaporation minus infiltration)
6561
6562	!! 0.2 Output variables
6563
6564	!! 0.3 Modified variables
6565
6566	!! 0.4 Local variables
6567
6568	INTEGER(i_std) :: jsl,ji
6569	REAL(r_std), DIMENSION(kjpindex) :: temp
6570
6571	!_ ================================================================================================================================
6572
6573	!- Compute the diffusion flux at every level from bottom to top (using mcl,mclint, and sink values)
6574	DO ji = 1, kjpindex
6575
6576	!! 1. Initialize qflux from the bottom, with dr_ns
6577	jsl = nslm
6578	qflux(ji,jsl,ins) = dr_ns(ji,ins)
6579	!! 2. Between layer nslm and nslm-1, by means of water budget knowing mc changes and flux at the lowest interface
6580	! qflux is downward
6581	jsl = nslm-1
6582	qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) &
6583	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
6584	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
6585	& * (dz(jsl+1)/huit) &
6586	& + rootsink(ji,jsl+1,ins)
6587	ENDDO
6588
6589	!! 3. We go up, and deduct qflux(1:nslm-2), still by means of water budget
6590	! Here, qflux(ji,1,ins) is the downward flux between the top soil layer and the 2nd one
6591	DO jsl = nslm-2,1,-1
6592	DO ji = 1, kjpindex
6593	qflux(ji,jsl,ins) = qflux(ji,jsl+1,ins) &
6594	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
6595	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
6596	& * (dz(jsl+1)/huit) &
6597	& + rootsink(ji,jsl+1,ins) &
6598	& + (dz(jsl+2)/huit) &
6599	& * (troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1) &
6600	& + mcl(ji,jsl+2,ins)-mclint(ji,jsl+2))
6601	END DO
6602	ENDDO
6603
6604	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface (temp) should equal -flux_top
6605	DO ji = 1, kjpindex
6606	temp(ji) = qflux(ji,1,ins) + (dz(2)/huit) &
6607	& * (trois* (mcl(ji,1,ins)-mclint(ji,1)) + (mcl(ji,2,ins)-mclint(ji,2))) &
6608	& + rootsink(ji,1,ins)
6609	ENDDO
6610
6611	! flux_top is positive when upward, while temp is positive when downward
6612	DO ji = 1, kjpindex
6613	IF (ABS(flux_top(ji)+temp(ji)).GT. deux*min_sechiba) THEN
6614	WRITE(numout,*) 'Problem in the water balance, qflux computation', flux_top(ji),temp(ji)
6615	WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
6616	WRITE(numout,*) 'mclint', mclint(ji,:)
6617	WRITE(numout,*) 'mcl', mcl(ji,:,ins)
6618	WRITE (numout,*) 'rootsink', rootsink(ji,:,ins)
6619	CALL ipslerr_p(3, 'hydrol_soil_flux', 'We will STOP now.',&
6620	& 'Problem in the water balance, qflux computation','')
6621	ENDIF
6622	ENDDO
6623
6624	END SUBROUTINE hydrol_soil_flux
6625
6626
6627	!! ================================================================================================================================
6628	!! SUBROUTINE : hydrol_soil_tridiag
6629	!!
6630	!>\BRIEF This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix.
6631	!!
6632	!! DESCRIPTION : It is only applied in the grid-cells where resolv(ji)=TRUE
6633	!!
6634	!! RECENT CHANGE(S) : None
6635	!!
6636	!! MAIN OUTPUT VARIABLE(S) : mcl (global module variable)
6637	!!
6638	!! REFERENCE(S) :
6639	!!
6640	!! FLOWCHART : None
6641	!! \n
6642	!_ ================================================================================================================================
6643	!_ hydrol_soil_tridiag
6644
6645	SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
6646
6647	!- arguments
6648
6649	!! 0. Variable and parameter declaration
6650
6651	!! 0.1 Input variables
6652
6653	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6654	INTEGER(i_std), INTENT(in) :: ins !! number of soil type
6655
6656	!! 0.2 Output variables
6657
6658	!! 0.3 Modified variables
6659
6660	!! 0.4 Local variables
6661
6662	INTEGER(i_std) :: ji,jsl
6663	REAL(r_std), DIMENSION(kjpindex) :: bet
6664	REAL(r_std), DIMENSION(kjpindex,nslm) :: gam
6665
6666	!_ ================================================================================================================================
6667	DO ji = 1, kjpindex
6668
6669	IF (resolv(ji)) THEN
6670	bet(ji) = tmat(ji,1,2)
6671	mcl(ji,1,ins) = rhs(ji,1)/bet(ji)
6672	ENDIF
6673	ENDDO
6674
6675	DO jsl = 2,nslm
6676	DO ji = 1, kjpindex
6677
6678	IF (resolv(ji)) THEN
6679
6680	gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
6681	bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
6682	mcl(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mcl(ji,jsl-1,ins))/bet(ji)
6683	ENDIF
6684
6685	ENDDO
6686	ENDDO
6687
6688	DO ji = 1, kjpindex
6689	IF (resolv(ji)) THEN
6690	DO jsl = nslm-1,1,-1
6691	mcl(ji,jsl,ins) = mcl(ji,jsl,ins) - gam(ji,jsl+1)*mcl(ji,jsl+1,ins)
6692	ENDDO
6693	ENDIF
6694	ENDDO
6695
6696	END SUBROUTINE hydrol_soil_tridiag
6697
6698
6699	!! ================================================================================================================================
6700	!! SUBROUTINE : hydrol_soil_coef
6701	!!
6702	!>\BRIEF Computes coef for the linearised hydraulic conductivity
6703	!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin.
6704	!!
6705	!! DESCRIPTION :
6706	!! First, we identify the interval i in which the current value of mc is located.
6707	!! Then, we give the values of the linearized parameters to compute
6708	!! conductivity and diffusivity as K=a*mc+b and d.
6709	!!
6710	!! RECENT CHANGE(S) : Addition of the dependence to profil_froz_hydro_ns
6711	!!
6712	!! MAIN OUTPUT VARIABLE(S) :
6713	!!
6714	!! REFERENCE(S) :
6715	!!
6716	!! FLOWCHART : None
6717	!! \n
6718	!_ ================================================================================================================================
6719	!_ hydrol_soil_coef
6720
6721	SUBROUTINE hydrol_soil_coef(kjpindex,ins,njsc)
6722
6723	IMPLICIT NONE
6724	!
6725	!! 0. Variable and parameter declaration
6726
6727	!! 0.1 Input variables
6728
6729	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6730	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
6731	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
6732
6733	!! 0.2 Output variables
6734
6735	!! 0.3 Modified variables
6736
6737	!! 0.4 Local variables
6738
6739	INTEGER(i_std) :: jsl,ji,i
6740	REAL(r_std) :: mc_ratio
6741	REAL(r_std) :: mc_used !! Used liquid water content
6742	REAL(r_std) :: x,m
6743
6744	!_ ================================================================================================================================
6745
6746	IF (ok_freeze_cwrr) THEN
6747
6748	! Calculation of liquid and frozen saturation degrees with respect to residual
6749	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
6750	! 1-x=frozen saturation degree/residual=(mcfc-mcr)/(mcs-mcr) (=profil_froz_hydro)
6751
6752	DO jsl=1,nslm
6753	DO ji=1,kjpindex
6754
6755	x = 1._r_std - profil_froz_hydro_ns(ji, jsl,ins)
6756
6757	! mc_used is used in the calculation of hydrological properties
6758	! It corresponds to a liquid mc, but the expression is different from mcl in hydrol_soil,
6759	! to ensure that we get the a, b, d of the first bin when mcl<mcr
6760	mc_used = mcr(njsc(ji))+x*MAX((mc(ji,jsl, ins)-mcr(njsc(ji))),zero)
6761	!
6762	! calcul de k based on mc_liq
6763	!
6764	i= MAX(imin, MIN(imax-1, INT(imin +(imax-imin)*(mc_used-mcr(njsc(ji)))/(mcs(njsc(ji))-mcr(njsc(ji))))))
6765	a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
6766	b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
6767	d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
6768	k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,njsc(ji)), &
6769	a_lin(i,jsl,njsc(ji)) * mc_used + b_lin(i,jsl,njsc(ji))) ! in mm/d
6770	ENDDO ! loop on grid
6771	ENDDO
6772
6773	ELSE
6774	! .NOT. ok_freeze_cwrr
6775	DO jsl=1,nslm
6776	DO ji=1,kjpindex
6777
6778	! it is impossible to consider a mc<mcr for the binning
6779	mc_ratio = MAX(mc(ji,jsl,ins)-mcr(njsc(ji)), zero)/(mcs(njsc(ji))-mcr(njsc(ji)))
6780
6781	i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
6782	a(ji,jsl) = a_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
6783	b(ji,jsl) = b_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm/d
6784	d(ji,jsl) = d_lin(i,jsl,njsc(ji)) * kfact_root(ji,jsl,ins) ! in mm^2/d
6785	k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,njsc(ji)), &
6786	a_lin(i,jsl,njsc(ji)) * mc(ji,jsl,ins) + b_lin(i,jsl,njsc(ji))) ! in mm/d
6787	END DO
6788	END DO
6789	ENDIF
6790
6791	END SUBROUTINE hydrol_soil_coef
6792
6793	!! ================================================================================================================================
6794	!! SUBROUTINE : hydrol_soil_froz
6795	!!
6796	!>\BRIEF Computes profil_froz_hydro_ns, the fraction of frozen water in the soil layers.
6797	!!
6798	!! DESCRIPTION :
6799	!!
6800	!! RECENT CHANGE(S) : Created by A. Ducharne in 2016.
6801	!!
6802	!! MAIN OUTPUT VARIABLE(S) : profil_froz_hydro_ns
6803	!!
6804	!! REFERENCE(S) :
6805	!!
6806	!! FLOWCHART : None
6807	!! \n
6808	!_ ================================================================================================================================
6809	!_ hydrol_soil_froz
6810
6811	SUBROUTINE hydrol_soil_froz(kjpindex,ins,njsc)
6812
6813	IMPLICIT NONE
6814	!
6815	!! 0. Variable and parameter declaration
6816
6817	!! 0.1 Input variables
6818
6819	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6820	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
6821	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
6822
6823	!! 0.2 Output variables
6824
6825	!! 0.3 Modified variables
6826
6827	!! 0.4 Local variables
6828
6829	INTEGER(i_std) :: jsl,ji,i
6830	REAL(r_std) :: x,m
6831	REAL(r_std) :: denom
6832	REAL(r_std),DIMENSION (kjpindex) :: froz_frac_moy
6833	REAL(r_std),DIMENSION (kjpindex) :: smtot_moy
6834	REAL(r_std),DIMENSION (kjpindex,nslm) :: mc_ns
6835
6836	!_ ================================================================================================================================
6837
6838	! ONLY FOR THE (ok_freeze_cwrr) CASE
6839
6840	! Calculation of liquid and frozen saturation degrees above residual moisture
6841	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
6842	! 1-x=frozen saturation degree/residual=(mcfc-mcr)/(mcs-mcr) (=profil_froz_hydro)
6843	! It's important for the good work of the water diffusion scheme (tridiag) that the total
6844	! liquid water also includes mcr, so mcl > 0 even when x=0
6845
6846	DO jsl=1,nslm
6847	DO ji=1,kjpindex
6848	! Van Genuchten parameter for thermodynamical calculation
6849	m = 1. -1./nvan(njsc(ji))
6850
6851	IF ((.NOT. ok_thermodynamical_freezing).OR.(mc(ji,jsl, ins).LT.(mcr(njsc(ji))+min_sechiba))) THEN
6852	! Linear soil freezing or soil moisture below residual
6853	IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
6854	x=1._r_std
6855	ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
6856	(temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
6857	x=(temp_hydro(ji, jsl)-(ZeroCelsius-fr_dT/2.))/fr_dT
6858	ELSE
6859	x=0._r_std
6860	ENDIF
6861	ELSE IF (ok_thermodynamical_freezing) THEN
6862	! Thermodynamical soil freezing
6863	IF (temp_hydro(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
6864	x=1._r_std
6865	ELSE IF ( (temp_hydro(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
6866	(temp_hydro(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
6867	! Factor 2.2 from the PhD of Isabelle Gouttevin
6868	x=MIN(((mcs(njsc(ji))-mcr(njsc(ji))) &
6869	((2.21000.avan(njsc(ji))(ZeroCelsius+fr_dT/2.-temp_hydro(ji, jsl)) &
6870	lhf/ZeroCelsius/10.)nvan(njsc(ji))+1.)*(-m)) / &
6871	(mc(ji,jsl, ins)-mcr(njsc(ji))),1._r_std)
6872	ELSE
6873	x=0._r_std
6874	ENDIF
6875	ENDIF
6876
6877	profil_froz_hydro_ns(ji,jsl,ins) = 1._r_std-x
6878
6879	mc_ns(ji,jsl)=mc(ji,jsl,ins)/mcs(njsc(ji))
6880
6881	ENDDO ! loop on grid
6882	ENDDO
6883
6884	! Applay correction on the frozen fraction
6885	! Depends on two external parameters: froz_frac_corr and smtot_corr
6886	froz_frac_moy(:)=zero
6887	denom=zero
6888	DO jsl=1,nslm
6889	froz_frac_moy(:)=froz_frac_moy(:)+dh(jsl)*profil_froz_hydro_ns(:,jsl,ins)
6890	denom=denom+dh(jsl)
6891	ENDDO
6892	froz_frac_moy(:)=froz_frac_moy(:)/denom
6893
6894	smtot_moy(:)=zero
6895	denom=zero
6896	DO jsl=1,nslm-1
6897	smtot_moy(:)=smtot_moy(:)+dh(jsl)*mc_ns(:,jsl)
6898	denom=denom+dh(jsl)
6899	ENDDO
6900	smtot_moy(:)=smtot_moy(:)/denom
6901
6902	DO jsl=1,nslm
6903	profil_froz_hydro_ns(:,jsl,ins)=MIN(profil_froz_hydro_ns(:,jsl,ins)* &
6904	(froz_frac_moy(:)*froz_frac_corr)(smtot_moy(:)**smtot_corr), max_froz_hydro)
6905	ENDDO
6906
6907	END SUBROUTINE hydrol_soil_froz
6908
6909
6910	!! ================================================================================================================================
6911	!! SUBROUTINE : hydrol_soil_setup
6912	!!
6913	!>\BRIEF This subroutine computes the matrix coef.
6914	!!
6915	!! DESCRIPTION : None
6916	!!
6917	!! RECENT CHANGE(S) : None
6918	!!
6919	!! MAIN OUTPUT VARIABLE(S) : matrix coef
6920	!!
6921	!! REFERENCE(S) :
6922	!!
6923	!! FLOWCHART : None
6924	!! \n
6925	!_ ================================================================================================================================
6926
6927	SUBROUTINE hydrol_soil_setup(kjpindex,ins)
6928
6929
6930	IMPLICIT NONE
6931	!
6932	!! 0. Variable and parameter declaration
6933
6934	!! 0.1 Input variables
6935	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6936	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
6937
6938	!! 0.2 Output variables
6939
6940	!! 0.3 Modified variables
6941
6942	!! 0.4 Local variables
6943
6944	INTEGER(i_std) :: jsl,ji
6945	REAL(r_std) :: temp3, temp4
6946
6947	!_ ================================================================================================================================
6948	!-we compute tridiag matrix coefficients (LEFT and RIGHT)
6949	! of the system to solve [LEFT]mc_{t+1}=[RIGHT]mc{t}+[add terms]:
6950	! e(nslm),f(nslm),g1(nslm) for the [left] vector
6951	! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
6952
6953	! w_time=1 (in constantes_soil) indicates implicit computation for diffusion
6954	temp3 = w_time*(dt_sechiba/one_day)/deux
6955	temp4 = (un-w_time)*(dt_sechiba/one_day)/deux
6956
6957	! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
6958
6959	!- coefficient for first layer
6960	DO ji = 1, kjpindex
6961	e(ji,1) = zero
6962	f(ji,1) = trois * dz(2)/huit + temp3 &
6963	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
6964	g1(ji,1) = dz(2)/(huit) - temp3 &
6965	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
6966	ep(ji,1) = zero
6967	fp(ji,1) = trois * dz(2)/huit - temp4 &
6968	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
6969	gp(ji,1) = dz(2)/(huit) + temp4 &
6970	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
6971	ENDDO
6972
6973	!- coefficient for medium layers
6974
6975	DO jsl = 2, nslm-1
6976	DO ji = 1, kjpindex
6977	e(ji,jsl) = dz(jsl)/(huit) - temp3 &
6978	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
6979
6980	f(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit + temp3 &
6981	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
6982	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
6983
6984	g1(ji,jsl) = dz(jsl+1)/(huit) - temp3 &
6985	& * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
6986
6987	ep(ji,jsl) = dz(jsl)/(huit) + temp4 &
6988	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
6989
6990	fp(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit - temp4 &
6991	& * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
6992	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
6993
6994	gp(ji,jsl) = dz(jsl+1)/(huit) + temp4 &
6995	& *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
6996	ENDDO
6997	ENDDO
6998
6999	!- coefficient for last layer
7000	DO ji = 1, kjpindex
7001	e(ji,nslm) = dz(nslm)/(huit) - temp3 &
7002	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
7003	f(ji,nslm) = trois * dz(nslm)/huit + temp3 &
7004	& * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm)) &
7005	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
7006	g1(ji,nslm) = zero
7007	ep(ji,nslm) = dz(nslm)/(huit) + temp4 &
7008	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
7009	fp(ji,nslm) = trois * dz(nslm)/huit - temp4 &
7010	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm)) &
7011	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
7012	gp(ji,nslm) = zero
7013	ENDDO
7014
7015	END SUBROUTINE hydrol_soil_setup
7016
7017
7018	!! ================================================================================================================================
7019	!! SUBROUTINE : hydrol_split_soil
7020	!!
7021	!>\BRIEF Splits 2d variables into 3d variables, per soiltile (_ns suffix), at the beginning of hydrol
7022	!! At this stage, the forcing fluxes to hydrol are transformed from grid-cell averages
7023	!! to mean fluxes over vegtot=sum(soiltile)
7024	!!
7025	!! DESCRIPTION :
7026	!! 1. Split 2d variables into 3d variables, per soiltile
7027	!! 1.1 Throughfall
7028	!! 1.2 Bare soil evaporation
7029	!! 1.2.1 vevapnu_old
7030	!! 1.2.2 ae_ns new
7031	!! 1.3 transpiration
7032	!! 1.4 root sink
7033	!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes
7034	!! 2.1 precisol
7035	!! 2.2 ae_ns and evapnu
7036	!! 2.3 transpiration
7037	!! 2.4 root sink
7038	!!
7039	!! RECENT CHANGE(S) : 2016 by A. Ducharne to match the simplification of hydrol_soil
7040	!!
7041	!! MAIN OUTPUT VARIABLE(S) :
7042	!!
7043	!! REFERENCE(S) :
7044	!!
7045	!! FLOWCHART : None
7046	!! \n
7047	!_ ================================================================================================================================
7048	!_ hydrol_split_soil
7049
7050	SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, &
7051	evap_bare_lim, evap_bare_lim_ns, tot_bare_soil)
7052	!
7053	! interface description
7054
7055	!! 0. Variable and parameter declaration
7056
7057	!! 0.1 Input variables
7058
7059	INTEGER(i_std), INTENT(in) :: kjpindex
7060	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget_max !! max Vegetation map
7061	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soiltile within vegtot (0-1, unitless)
7062	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: vevapnu !! Bare soil evaporation
7063	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
7064	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: humrel !! Relative humidity
7065	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evap_bare_lim !!
7066	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(in) :: evap_bare_lim_ns !!
7067	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
7068
7069	!! 0.4 Local variables
7070
7071	INTEGER(i_std) :: ji, jv, jsl, jst
7072	REAL(r_std), DIMENSION (kjpindex) :: vevapnu_old
7073	REAL(r_std), DIMENSION (kjpindex) :: tmp_check1
7074	REAL(r_std), DIMENSION (kjpindex) :: tmp_check2
7075	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmp_check3
7076	LOGICAL :: error=.FALSE. !! If true, exit in the end of subroutine
7077
7078	!_ ================================================================================================================================
7079
7080	!! 1. Split 2d variables into 3d variables, per soiltile
7081
7082	! Reminders:
7083	! corr_veg_soil(:,nvm,nstm) = PFT fraction per soiltile in each grid-cell
7084	! corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
7085	! soiltile(:,nstm) = fraction of vegtot covered by each soiltile (0-1, unitless)
7086	! vegtot(:) = total fraction of grid-cell covered by PFTs (fraction with bare soil + vegetation)
7087	! veget_max(:,nvm) = PFT fractions of vegtot+frac_nobio
7088	! veget(:,nvm) = fractions (of vegtot+frac_nobio) covered by vegetation in each PFT
7089	! BUT veget(:,1)=veget_max(:,1)
7090	! frac_bare(:,nvm) = fraction (of veget_max) with bare soil in each PFT
7091	! tot_bare_soil(:) = fraction of grid mesh covered by all bare soil (=SUM(frac_bare*veget_max))
7092	! frac_bare_ns(:,nstm) = evaporating bare soil fraction (of vegtot) per soiltile (defined in hydrol_vegupd)
7093
7094	!! 1.1 Throughfall
7095	! Transformation from precisol (flux from PFT jv in m2 of grid-mesh)
7096	! to precisol_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
7097	precisol_ns(:,:)=zero
7098	DO ji=1,kjpindex
7099	DO jst=1,nstm!IGEM
7100	DO jv=1,nvm
7101	IF((veget_max(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
7102	precisol_ns(ji,jst) = precisol_ns(ji,jst) + &
7103	ratio_soil(ji,jv,jst)precisol(ji,jv) / (soiltile(ji,jst)vegtot(ji))
7104	ENDIF
7105	END DO
7106	END DO
7107	END DO!IGEM
7108
7109
7110	CALL xios_orchidee_send_field("precisol_ns",precisol_ns) !IGEM
7111
7112	!! 1.2 Bare soil evaporation
7113	!! 1.2.1 vevapnu_old
7114	! AD16*** vevapnu_old ne sert que pour le split suivant de vevapnu (issu de enerbil) en ae_ns pour hydrol_soil
7115	! mais il ne semble y avoir aucune bonne raison de contraindre ae_ns en fonction de vevapnu_old
7116	vevapnu_old(:)=zero
7117	DO jst=1,nstm
7118	DO ji=1,kjpindex
7119	IF ( vegtot(ji) .GT. min_sechiba) THEN
7120	vevapnu_old(ji)=vevapnu_old(ji)+ &
7121	& ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
7122	ENDIF
7123	END DO
7124	END DO
7125
7126	!! 1.2.2 ae_ns new
7127	! AD16*** les lignes ci-dessous sont excessivement compliquees et ne garantissent pas que ae_ns = 0 si evap_bare_lim=0
7128	! c'est notamment le cas pour les 3emes et 6emes conditions
7129	! AD19: test1 for IGEM
7130	!!$ DO jst=1,nstm
7131	!!$ DO ji=1,kjpindex
7132	!!$ IF (vevapnu_old(ji).GT.min_sechiba) THEN
7133	!!$ IF(evap_bare_lim(ji).GT.min_sechiba) THEN
7134	!!$ ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
7135	!!$ ELSE
7136	!!$ IF(vevapnu_old(ji).GT.min_sechiba) THEN
7137	!!$ ae_ns(ji,jst)=ae_ns(ji,jst) * vevapnu(ji)/vevapnu_old(ji) ! 3Ãšme condition
7138	!!$ ELSE
7139	!!$ ae_ns(ji,jst)=zero
7140	!!$ ENDIF
7141	!!$ ENDIF
7142	!!$ ELSEIF(frac_bare_ns(ji,jst).GT.min_sechiba) THEN
7143	!!$ IF(evap_bare_lim(ji).GT.min_sechiba) THEN
7144	!!$ ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
7145	!!$ ELSE
7146	!!$ IF(tot_bare_soil(ji).GT.min_sechiba) THEN
7147	!!$ ae_ns(ji,jst) = vevapnu(ji) * frac_bare_ns(ji,jst)/tot_bare_soil(ji) ! 6Ãšme condition
7148	!!$ ELSE
7149	!!$ ae_ns(ji,jst) = zero
7150	!!$ ENDIF
7151	!!$ ENDIF
7152	!!$ ENDIF
7153	!!$ END DO
7154	!!$ END DO
7155	! ADNV27072016: we believe the following block should be used (tests needed before committ, since AD16*** had pb with it)
7156	!!$ ! given the definition of evap_bare_lim, it leads to sum(ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji))=vevapnu(ji)
7157	ae_ns(:,:)=zero
7158	DO jst=1,nstm
7159	DO ji=1,kjpindex
7160	IF(evap_bare_lim(ji).GT.min_sechiba) THEN
7161	ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
7162	ENDIF
7163	ENDDO
7164	ENDDO
7165
7166	!! 1.3 transpiration
7167	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
7168	! to tr_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
7169	! To do next: simplify the use of humrelv(ji,jv,jst) /humrel(ji,jv), since both are equal
7170	tr_ns(:,:)=zero
7171	DO jst=1,nstm !IGEM
7172	DO jv=1,nvm
7173	DO ji=1,kjpindex
7174	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba))THEN
7175	tr_ns(ji,jst)= tr_ns(ji,jst) &
7176	+ transpir(ji,jv) * (humrelv(ji,jv,jst) / humrel(ji,jv)) &
7177	* ratio_soil(ji,jv,jst) / (soiltile(ji,jst)*vegtot(ji))
7178
7179	ENDIF
7180	END DO
7181	END DO
7182	END DO!IGEM
7183
7184	!! 1.4 root sink
7185	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
7186	! to root_sink (flux from contributing PFTs and soil layer with another unit, in m2 of soiltile)
7187	rootsink(:,:,:)=zero
7188	DO jst=1,nstm !IGEM
7189	DO jv=1,nvm
7190	DO jsl=1,nslm
7191	DO ji=1,kjpindex
7192	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba)) THEN
7193	rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
7194	+ transpir(ji,jv) * (us(ji,jv,jst,jsl) / humrel(ji,jv)) &
7195	* ratio_soil(ji,jv,jst) / (soiltile(ji,jst)*vegtot(ji))
7196	! rootsink(ji,1,jst)=0 as us(ji,jv,jst,1)=0
7197	END IF
7198	END DO
7199	END DO
7200	END DO
7201	END DO !IGEM
7202
7203	CALL xios_orchidee_send_field("rootsink",rootsink/dt_sechiba) !mm/s !IGEM
7204
7205	!!! ADNV270716 *** we are here
7206
7207	!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes (grid-cell average)
7208
7209	IF (check_cwrr) THEN
7210
7211	!! 2.1 precisol
7212
7213	tmp_check1(:)=zero
7214	DO jst=1,nstm
7215	DO ji=1,kjpindex
7216	tmp_check1(ji)=tmp_check1(ji) + precisol_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
7217	END DO
7218	END DO
7219
7220	tmp_check2(:)=zero
7221	DO jv=1,nvm
7222	DO ji=1,kjpindex
7223	tmp_check2(ji)=tmp_check2(ji) + precisol(ji,jv)
7224	END DO
7225	END DO
7226
7227	DO ji=1,kjpindex
7228	IF(ABS(tmp_check1(ji) - tmp_check2(ji)).GT.allowed_err) THEN
7229	WRITE(numout,*) 'PRECISOL SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
7230	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
7231	WRITE(numout,*) 'vegtot',vegtot(ji)
7232	DO jv=1,nvm
7233	WRITE(numout,'(a,i2.2,"\|",F13.4,"\|",F13.4,"\|",3(F9.6))') &
7234	'jv,veget_max, precisol, vegetmax_soil ', &
7235	jv,veget_max(ji,jv),precisol(ji,jv),vegetmax_soil(ji,jv,:)
7236	END DO
7237	DO jst=1,nstm
7238	WRITE(numout,*) 'jst,precisol_ns',jst,precisol_ns(ji,jst)
7239	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
7240	END DO
7241	error=.TRUE.
7242	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
7243	& 'check_CWRR','PRECISOL SPLIT FALSE')
7244	ENDIF
7245	END DO
7246
7247	!! 2.2 ae_ns and evapnu
7248
7249	tmp_check1(:)=zero
7250	DO jst=1,nstm
7251	DO ji=1,kjpindex
7252	tmp_check1(ji)=tmp_check1(ji) + ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
7253	END DO
7254	END DO
7255
7256	DO ji=1,kjpindex
7257	IF(ABS(tmp_check1(ji) - vevapnu(ji)).GT.allowed_err) THEN
7258	WRITE(numout,*) 'VEVAPNU SPLIT FALSE:ji, Sum(ae_ns), vevapnu =',ji,tmp_check1(ji),vevapnu(ji)
7259	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- vevapnu(ji))
7260	WRITE(numout,*) 'ae_ns',ae_ns(ji,:)
7261	WRITE(numout,*) 'vegtot',vegtot(ji)
7262	WRITE(numout,*) 'evap_bare_lim, evap_bare_lim_ns',evap_bare_lim(ji), evap_bare_lim_ns(ji,:)
7263	DO jst=1,nstm
7264	WRITE(numout,*) 'jst,ae_ns',jst,ae_ns(ji,jst)
7265	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
7266	END DO
7267	error=.TRUE.
7268	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
7269	& 'check_CWRR','VEVAPNU SPLIT FALSE')
7270	ENDIF
7271	ENDDO
7272
7273	!! 2.3 transpiration
7274
7275	tmp_check1(:)=zero
7276	DO jst=1,nstm
7277	DO ji=1,kjpindex
7278	tmp_check1(ji)=tmp_check1(ji) + tr_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
7279	END DO
7280	END DO
7281
7282	tmp_check2(:)=zero
7283	DO jv=1,nvm
7284	DO ji=1,kjpindex
7285	tmp_check2(ji)=tmp_check2(ji) + transpir(ji,jv)
7286	END DO
7287	END DO
7288
7289	DO ji=1,kjpindex
7290	IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
7291	WRITE(numout,*) 'TRANSPIR SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
7292	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
7293	WRITE(numout,*) 'vegtot',vegtot(ji)
7294	DO jv=1,nvm
7295	WRITE(numout,*) 'jv,veget_max, transpir',jv,veget_max(ji,jv),transpir(ji,jv)
7296	DO jst=1,nstm
7297	WRITE(numout,*) 'vegetmax_soil:ji,jv,jst',ji,jv,jst,vegetmax_soil(ji,jv,jst)
7298	END DO
7299	END DO
7300	DO jst=1,nstm
7301	WRITE(numout,*) 'jst,tr_ns',jst,tr_ns(ji,jst)
7302	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
7303	END DO
7304	error=.TRUE.
7305	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
7306	& 'check_CWRR','TRANSPIR SPLIT FALSE')
7307	ENDIF
7308
7309	END DO
7310
7311	!! 2.4 root sink
7312
7313	tmp_check3(:,:)=zero
7314	DO jst=1,nstm
7315	DO jsl=1,nslm
7316	DO ji=1,kjpindex
7317	tmp_check3(ji,jst)=tmp_check3(ji,jst) + rootsink(ji,jsl,jst)
7318	END DO
7319	END DO
7320	ENDDO
7321
7322	DO jst=1,nstm
7323	DO ji=1,kjpindex
7324	IF(ABS(tmp_check3(ji,jst) - tr_ns(ji,jst)).GT.allowed_err) THEN
7325	WRITE(numout,*) 'ROOTSINK SPLIT FALSE:ji,jst=', ji,jst,&
7326	& tmp_check3(ji,jst),tr_ns(ji,jst)
7327	WRITE(numout,*) 'err',ABS(tmp_check3(ji,jst)- tr_ns(ji,jst))
7328	WRITE(numout,*) 'HUMREL(jv=1:13)',humrel(ji,:)
7329	WRITE(numout,*) 'TRANSPIR',transpir(ji,:)
7330	DO jv=1,nvm
7331	WRITE(numout,*) 'jv=',jv,'us=',us(ji,jv,jst,:)
7332	ENDDO
7333	error=.TRUE.
7334	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
7335	& 'check_CWRR','ROOTSINK SPLIT FALSE')
7336	ENDIF
7337	END DO
7338	END DO
7339
7340	ENDIF ! end of check_cwrr
7341
7342	!! Exit if error was found previously in this subroutine
7343	IF ( error ) THEN
7344	WRITE(numout,*) 'One or more errors have been detected in hydrol_split_soil. Model stops.'
7345	CALL ipslerr_p(3, 'hydrol_split_soil', 'We will STOP now.',&
7346	& 'One or several fatal errors were found previously.','')
7347	END IF
7348
7349	END SUBROUTINE hydrol_split_soil
7350
7351
7352	!! ================================================================================================================================
7353	!! SUBROUTINE : hydrol_diag_soil
7354	!!
7355	!>\BRIEF Calculates diagnostic variables at the grid-cell scale
7356	!!
7357	!! DESCRIPTION :
7358	!! - 1. Apply mask_soiltile
7359	!! - 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
7360	!!
7361	!! RECENT CHANGE(S) : 2016 by A. Ducharne for the claculation of shumdiag_perma
7362	!!
7363	!! MAIN OUTPUT VARIABLE(S) :
7364	!!
7365	!! REFERENCE(S) :
7366	!!
7367	!! FLOWCHART : None
7368	!! \n
7369	!_ ================================================================================================================================
7370	!_ hydrol_diag_soil
7371
7372	SUBROUTINE hydrol_diag_soil (kjpindex, veget_max, ratio_tile, soiltile, njsc, runoff, drainage, qtot_to_river,&!IGEM
7373	& evapot, vevapnu, returnflow, reinfiltration, irrigation, reinf_from_fast,flowtowtd,& !IGEM
7374	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt)
7375	!
7376	! interface description
7377
7378	!! 0. Variable and parameter declaration
7379
7380	!! 0.1 Input variables
7381
7382	! input scalar
7383	INTEGER(i_std), INTENT(in) :: kjpindex
7384	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. vegetation type
7385	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
7386	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
7387	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !!
7388	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the deep reservoir
7389	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
7390	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Water from irrigation
7391	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !!
7392	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: ratio_tile !! IGEM
7393	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinf_from_fast !! IGEM
7394	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flowtowtd !! IGEM
7395
7396	!! 0.2 Output variables
7397
7398	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of litter wetness
7399	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! complete runoff
7400	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
7401	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag !! relative soil moisture
7402	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
7403	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter cond.
7404	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
7405	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
7406	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
7407	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: qtot_to_river !! IGEM
7408
7409
7410	!! 0.3 Modified variables
7411
7412	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !!
7413
7414	!! 0.4 Local variables
7415
7416	INTEGER(i_std) :: ji, jv, jsl, jst, i
7417	REAL(r_std), DIMENSION (kjpindex) :: mask_vegtot
7418	REAL(r_std) :: k_tmp, tmc_litter_ratio
7419
7420	!_ ================================================================================================================================
7421	!
7422	! Put the prognostics variables of soil to zero if soiltype is zero
7423
7424	!! 1. Apply mask_soiltile
7425
7426	DO jst=1,nstm
7427	DO ji=1,kjpindex
7428
7429	ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
7430	dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
7431	ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
7432	tmc(ji,jst) = tmc(ji,jst) * mask_soiltile(ji,jst)
7433
7434	DO jv=1,nvm
7435	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
7436	DO jsl=1,nslm
7437	us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl) * mask_soiltile(ji,jst)
7438	END DO
7439	END DO
7440
7441	DO jsl=1,nslm
7442	mc(ji,jsl,jst) = mc(ji,jsl,jst) * mask_soiltile(ji,jst)
7443	END DO
7444
7445	END DO
7446	END DO
7447
7448	runoff(:) = zero
7449	drainage(:) = zero
7450	humtot(:) = zero
7451	humtot_ns(:,:) = zero !IGEM
7452	shumdiag(:,:)= zero
7453	shumdiag_perma(:,:)=zero
7454	k_litt(:) = zero
7455	litterhumdiag(:) = zero
7456	tmc_litt_dry_mea(:) = zero
7457	tmc_litt_wet_mea(:) = zero
7458	tmc_litt_mea(:) = zero
7459	humrel(:,:) = zero
7460	vegstress(:,:) = zero
7461	IF (ok_freeze_cwrr) THEN
7462	profil_froz_hydro(:,:)=zero ! initialisation for the mean of profil_froz_hydro_ns
7463	ENDIF
7464
7465	!! 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
7466
7467	DO ji = 1, kjpindex
7468	mask_vegtot(ji) = 0
7469	IF(vegtot(ji) .GT. min_sechiba) THEN
7470	mask_vegtot(ji) = 1
7471	ENDIF
7472	END DO
7473
7474	DO ji = 1, kjpindex
7475	! Here we weight ae_ns by the fraction of bare evaporating soil.
7476	! This is given by frac_bare_ns, taking into account bare soil under vegetation
7477	ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
7478	END DO
7479
7480	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
7481	DO jst = 1, nstm
7482	DO ji = 1, kjpindex
7483	drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)soiltile(ji,jst)dr_ns(ji,jst))
7484	runoff(ji) = mask_vegtot(ji) * (runoff(ji) + vegtot(ji)soiltile(ji,jst)ru_ns(ji,jst)) &
7485	& + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
7486	humtot(ji) = mask_vegtot(ji) * (humtot(ji) + vegtot(ji)soiltile(ji,jst) tmc(ji,jst))
7487	humtot_ns(ji,jst) = mask_vegtot(ji) * (humtot_ns(ji,jst) + vegtot(ji)soiltile(ji,jst)tmc(ji,jst)) !IGEM
7488	IF (ok_freeze_cwrr) THEN
7489	! profil_froz_hydro_ns comes from hydrol_soil, to remain the same as in the prognotic loop
7490	profil_froz_hydro(ji,:)=mask_vegtot(ji) * &
7491	(profil_froz_hydro(ji,:) + vegtot(ji)soiltile(ji,jst) profil_froz_hydro_ns(ji,:, jst))
7492	ENDIF
7493	END DO
7494	END DO
7495
7496	!write(numout,*) 'DRAINAGE',drainage(:)
7497
7498	! we add the excess of snow sublimation to vevapnu
7499	! - because vevapsno is modified in hydrol_snow if subsinksoil
7500	! - it is multiplied by vegtot because it is devided by 1-tot_frac_nobio at creation in hydrol_snow
7501
7502	DO ji = 1,kjpindex
7503	vevapnu(ji) = vevapnu (ji) + subsinksoil(ji)*vegtot(ji)
7504	END DO
7505
7506	DO jst=1,nstm
7507	DO jv=1,nvm
7508	DO ji=1,kjpindex
7509	IF(veget_max(ji,jv).GT.min_sechiba) THEN
7510	vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)*ratio_soil(ji,jv,jst)!IGEM
7511	vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
7512	ENDIF
7513	END DO
7514	END DO
7515	END DO
7516
7517	DO jst=1,nstm
7518	DO jv=1,nvm
7519	DO ji=1,kjpindex
7520	humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)*ratio_soil(ji,jv,jst)!IGEM
7521	humrel(ji,jv)=MAX(humrel(ji,jv),zero)
7522	END DO
7523	END DO
7524	END DO
7525
7526	!! Litter... the goal is to calculate drysoil_frac, to calculate the albedo in condveg
7527	! In condveg, drysoil_frac serve to calculate the albedo of drysoil, excluding the nobio contribution which is further added
7528	! In conclusion, we calculate drysoil_frac based on moisture averages restricted to the soiltile (no multiplication by vegtot)
7529	! BUT THIS IS NOT USED ANYMORE WITH THE NEW BACKGROUNG ALBEDO
7530	!! k_litt is calculated here as a grid-cell average (for consistency with drainage)
7531	!! litterhumdiag, like shumdiag, is averaged over the soiltiles for transmission to stomate
7532	DO jst=1,nstm
7533	DO ji=1,kjpindex
7534	! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds
7535	IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
7536	i = imin
7537	ELSE
7538	tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
7539	& (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
7540	i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
7541	ENDIF
7542	k_tmp = MAX(k_lin(i,1,njsc(ji))*ks(njsc(ji)), zero)
7543	k_litt(ji) = k_litt(ji) + vegtot(ji)soiltile(ji,jst) SQRT(k_tmp) ! grid-cell average
7544	ENDDO
7545	DO ji=1,kjpindex
7546	litterhumdiag(ji) = litterhumdiag(ji) + &
7547	& soil_wet_litter(ji,jst) * soiltile(ji,jst)
7548
7549	tmc_litt_wet_mea(ji) = tmc_litt_wet_mea(ji) + &
7550	& tmc_litter_awet(ji,jst)* soiltile(ji,jst)
7551
7552	tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
7553	& tmc_litter_adry(ji,jst) * soiltile(ji,jst)
7554
7555	tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
7556	& tmc_litter(ji,jst) * soiltile(ji,jst)
7557	ENDDO
7558	ENDDO
7559
7560	DO ji=1,kjpindex
7561	IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
7562	drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
7563	& (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
7564	ELSE
7565	drysoil_frac(ji) = zero
7566	ENDIF
7567	END DO
7568
7569	! Calculate soilmoist, as a function of total water content (mc)
7570	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
7571	soilmoist(:,:) = zero
7572	DO jst=1,nstm
7573	DO ji=1,kjpindex
7574	soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
7575	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
7576	DO jsl = 2,nslm-1
7577	soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
7578	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
7579	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
7580	END DO
7581	soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
7582	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
7583	END DO
7584	END DO
7585	DO ji=1,kjpindex
7586	soilmoist(ji,:) = soilmoist(ji,:) * vegtot(ji) ! conversion to grid-cell average
7587	ENDDO
7588
7589	soilmoist_liquid(:,:) = zero
7590	DO jst=1,nstm
7591	DO ji=1,kjpindex
7592	soilmoist_liquid(ji,1) = soilmoist_liquid(ji,1) + soiltile(ji,jst) * &
7593	dz(2) * ( trois*mcl(ji,1,jst) + mcl(ji,2,jst) )/huit
7594	DO jsl = 2,nslm-1
7595	soilmoist_liquid(ji,jsl) = soilmoist_liquid(ji,jsl) + soiltile(ji,jst) * &
7596	( dz(jsl) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl-1,jst))/huit &
7597	+ dz(jsl+1) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl+1,jst))/huit )
7598	END DO
7599	soilmoist_liquid(ji,nslm) = soilmoist_liquid(ji,nslm) + soiltile(ji,jst) * &
7600	dz(nslm) * (trois*mcl(ji,nslm,jst) + mcl(ji,nslm-1,jst))/huit
7601	ENDDO
7602	ENDDO
7603	DO ji=1,kjpindex
7604	soilmoist_liquid(ji,:) = soilmoist_liquid(ji,:) * vegtot_old(ji) ! grid cell average
7605	ENDDO
7606
7607
7608	! Shumdiag: we start from soil_wet_ns, change the range over which the relative moisture is calculated,
7609	! then do a spatial average, excluding the nobio fraction on which stomate doesn't act
7610	DO jst=1,nstm
7611	DO jsl=1,nslm
7612	DO ji=1,kjpindex
7613	shumdiag(ji,jsl) = shumdiag(ji,jsl) + soil_wet_ns(ji,jsl,jst) * soiltile(ji,jst) * &
7614	((mcs(njsc(ji))-mcw(njsc(ji)))/(mcfc(njsc(ji))-mcw(njsc(ji))))
7615	shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero)
7616	ENDDO
7617	ENDDO
7618	ENDDO
7619
7620	! Shumdiag_perma is based on soilmoist / moisture at saturation in the layer
7621	! Her we start from grid averages by hydrol soil layer and transform it to the diag levels
7622	! We keep a grid-cell average, like for all variables transmitted to ok_freeze
7623	DO jsl=1,nslm
7624	DO ji=1,kjpindex
7625	shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(njsc(ji)))
7626	shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), un), zero)
7627	ENDDO
7628	ENDDO
7629
7630
7631	DO ji=1,kjpindex !IGEM
7632	IF(soiltile(ji,4).GT.min_sechiba)THEN !AD2 => zero replaced by min_sechiba
7633	qtot_to_river(ji) = qtot_to_river(ji) * soiltile(ji,4) * vegtot(ji) ![kg/m2(grid)/dtsechiba]
7634	ELSE
7635	qtot_to_river(ji) = reinf_from_fast(ji)+flowtowtd(ji) ![kg/m2(grid)/dtsechiba]
7636	! like the two fluxes from routing
7637	ENDIF !IGEM
7638	ENDDO
7639
7640	END SUBROUTINE hydrol_diag_soil
7641
7642
7643	!! ================================================================================================================================
7644	!! SUBROUTINE : hydrol_alma
7645	!!
7646	!>\BRIEF This routine computes the changes in soil moisture and interception storage for the ALMA outputs.
7647	!!
7648	!! DESCRIPTION : None
7649	!!
7650	!! RECENT CHANGE(S) : None
7651	!!
7652	!! MAIN OUTPUT VARIABLE(S) :
7653	!!
7654	!! REFERENCE(S) :
7655	!!
7656	!! FLOWCHART : None
7657	!! \n
7658	!_ ================================================================================================================================
7659	!_ hydrol_alma
7660
7661	SUBROUTINE hydrol_alma (kjpindex, index, lstep_init, qsintveg, snow, snow_nobio, soilwet)
7662	!
7663	!! 0. Variable and parameter declaration
7664
7665	!! 0.1 Input variables
7666
7667	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
7668	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
7669	LOGICAL, INTENT (in) :: lstep_init !! At which time is this routine called ?
7670	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
7671	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow water equivalent
7672	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
7673
7674	!! 0.2 Output variables
7675
7676	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: soilwet !! Soil wetness
7677
7678	!! 0.3 Modified variables
7679
7680	!! 0.4 Local variables
7681
7682	INTEGER(i_std) :: ji
7683	REAL(r_std) :: watveg
7684
7685	!_ ================================================================================================================================
7686	!
7687	!
7688	IF ( lstep_init ) THEN
7689	! Initialize variables if they were not found in the restart file
7690
7691	DO ji = 1, kjpindex
7692	watveg = SUM(qsintveg(ji,:))
7693	tot_watveg_beg(ji) = watveg
7694	tot_watsoil_beg(ji) = humtot(ji)
7695	snow_beg(ji) = snow(ji) + SUM(snow_nobio(ji,:))
7696	ENDDO
7697
7698	RETURN
7699
7700	ENDIF
7701	!
7702	! Calculate the values for the end of the time step
7703	!
7704	DO ji = 1, kjpindex
7705	watveg = SUM(qsintveg(ji,:)) ! average within the mesh
7706	tot_watveg_end(ji) = watveg
7707	tot_watsoil_end(ji) = humtot(ji) ! average within the mesh
7708	snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:)) ! average within the mesh
7709
7710	delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji) ! average within the mesh
7711	delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
7712	delswe(ji) = snow_end(ji) - snow_beg(ji) ! average within the mesh
7713	ENDDO
7714	!
7715	!
7716	! Transfer the total water amount at the end of the current timestep top the begining of the next one.
7717	!
7718	tot_watveg_beg = tot_watveg_end
7719	tot_watsoil_beg = tot_watsoil_end
7720	snow_beg(:) = snow_end(:)
7721	!
7722	DO ji = 1,kjpindex
7723	IF ( mx_eau_var(ji) > 0 ) THEN
7724	soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
7725	ELSE
7726	soilwet(ji) = zero
7727	ENDIF
7728	ENDDO
7729	!
7730	END SUBROUTINE hydrol_alma
7731	!
7732
7733
7734	!! ================================================================================================================================
7735	!! SUBROUTINE : hydrol_calculate_temp_hydro
7736	!!
7737	!>\BRIEF Calculate the temperature at hydrological levels
7738	!!
7739	!! DESCRIPTION : None
7740	!!
7741	!! RECENT CHANGE(S) : None
7742	!!
7743	!! MAIN OUTPUT VARIABLE(S) :
7744	!!
7745	!! REFERENCE(S) :
7746	!!
7747	!! FLOWCHART : None
7748	!! \n
7749	!_ ================================================================================================================================
7750
7751
7752	SUBROUTINE hydrol_calculate_temp_hydro(kjpindex, stempdiag, snow,snowdz)
7753
7754	!! 0.1 Input variables
7755
7756	INTEGER(i_std), INTENT(in) :: kjpindex
7757	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag
7758	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow
7759	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in) :: snowdz
7760
7761
7762	!! 0.2 Local variables
7763
7764	INTEGER jh, jsl, ji
7765	REAL(r_std) :: snow_h
7766	REAL(r_std) :: lev_diag, prev_diag, lev_prog, prev_prog
7767	REAL(r_std), DIMENSION(nslm,nslm) :: intfactt
7768
7769
7770	DO ji=1,kjpindex
7771	IF (ok_explicitsnow) THEN
7772	!The snow pack is above the surface soil in the new snow model.
7773	snow_h=0
7774	ELSE
7775	snow_h=snow(ji)/sn_dens
7776	ENDIF
7777
7778	intfactt(:,:)=0.
7779	prev_diag = snow_h
7780	DO jh = 1, nslm
7781	IF (jh.EQ.1) THEN
7782	lev_diag = zz(2)/1000./2.+snow_h
7783	ELSEIF (jh.EQ.nslm) THEN
7784	lev_diag = zz(nslm)/1000.+snow_h
7785
7786	ELSE
7787	lev_diag = zz(jh)/1000. &
7788	& +(zz(jh+1)-zz(jh))/1000./2.+snow_h
7789
7790	ENDIF
7791	prev_prog = 0.0
7792	DO jsl = 1, nslm
7793	lev_prog = diaglev(jsl)
7794	IF ((lev_diag.GT.diaglev(nslm).AND. &
7795	& prev_diag.LT.diaglev(nslm)-min_sechiba)) THEN
7796	lev_diag=diaglev(nslm)
7797	ENDIF
7798	intfactt(jh,jsl) = MAX(MIN(lev_diag,lev_prog)-MAX(prev_diag, prev_prog),&
7799	& 0.0)/(lev_diag-prev_diag)
7800	prev_prog = lev_prog
7801	ENDDO
7802	IF (lev_diag.GT.diaglev(nslm).AND. &
7803	& prev_diag.GE.diaglev(nslm)-min_sechiba) intfactt(jh,nslm)=1.
7804	prev_diag = lev_diag
7805	ENDDO
7806	ENDDO
7807
7808	temp_hydro(:,:)=0.
7809	DO jsl= 1, nslm
7810	DO jh= 1, nslm
7811	DO ji = 1, kjpindex
7812	temp_hydro(ji,jh) = temp_hydro(ji,jh) + stempdiag(ji,jsl)*intfactt(jh,jsl)
7813	ENDDO
7814	ENDDO
7815	ENDDO
7816
7817	END SUBROUTINE hydrol_calculate_temp_hydro
7818
7819
7820	!! ================================================================================================================================
7821	!! SUBROUTINE : hydrol_nudge
7822	!!
7823	!>\BRIEF Applay nudging of soil moisture and/or snow variables
7824	!!
7825	!! 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
7826	!!
7827	!! RECENT CHANGE(S) : None
7828	!!
7829	!! MAIN IN-OUTPUT VARIABLE(S) : mc, snowdz, snowrho, snowtemp
7830	!!
7831	!! REFERENCE(S) :
7832	!!
7833	!! \n
7834	!_ ================================================================================================================================
7835
7836	SUBROUTINE hydrol_nudge(kjit, kjpindex, &
7837	mc_loc, snowdz, snowrho, snowtemp, soiltile)
7838
7839	!! 0.1 Input variables
7840	INTEGER(i_std), INTENT(in) :: kjit !! Timestep number
7841	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
7842	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
7843
7844	!! 0.2 Modified variables
7845	REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT(inout) :: mc_loc !! Soil moisture
7846	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness
7847	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density
7848	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature
7849
7850
7851
7852	!! 0.3 Locals variables
7853	REAL(r_std) :: tau !! Position between to values in nudge mc file
7854	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_read_current !! mc from file interpolated to current timestep
7855	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowdz_read_current !! snowdz from file interpolated to current timestep
7856	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowrho_read_current !! snowrho from file interpolated to current timestep
7857	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowtemp_read_current !! snowtemp from file interpolated to current timestep
7858	REAL(r_std), DIMENSION(kjpindex) :: nudgincsm !! Nudging increment of water in soil moisture
7859	REAL(r_std), DIMENSION(kjpindex) :: nudgincswe !! Nudging increment of water in snow
7860	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_aux !! Temorary variable for calculation of nudgincsm
7861	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_aux !! Temorary variable for calculation of nudgincsm
7862	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
7863	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
7864	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
7865	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowdz_read_glo2D !! snowdz from file at global 2D(lat,lon) grid
7866	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowrho_read_glo2D !! snowrho from file at global 2D(lat,lon) grid
7867	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowtemp_read_glo2D !! snowrho from file at global 2D(lat,lon) grid
7868	REAL(r_std), DIMENSION(nbp_glo,nslm,nstm) :: mc_read_glo1D !! mc_read_glo2D on land-only vector form, in global
7869	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowdz_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global
7870	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowrho_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global
7871	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowtemp_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global
7872	INTEGER(i_std), SAVE :: istart_mc, istart_snow!! start index to read from input file
7873	INTEGER(i_std) :: iend !! end index to read from input file
7874	INTEGER(i_std) :: i, j, ji, jg, jst, jsl!! loop index
7875	INTEGER(i_std) :: iim_file, jjm_file, llm_file !! Dimensions in input file
7876	INTEGER(i_std), SAVE :: ttm_mc, ttm_snow !! Time dimensions in input file
7877	INTEGER(i_std), SAVE :: mc_id, snow_id !! index for netcdf files
7878	LOGICAL, SAVE :: firsttime_mc=.TRUE.
7879	LOGICAL, SAVE :: firsttime_snow=.TRUE.
7880
7881
7882	!! 1. Nudging of soil moisture
7883	IF (ok_nudge_mc) THEN
7884
7885	!! 1.2 Read mc from file, once a day only
7886	!! The forcing file must contain daily frequency variable for the full year of the simulation
7887	IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN
7888	! Save mc read from file from previous day
7889	mc_read_prev = mc_read_next
7890
7891	IF (nudge_interpol_with_xios) THEN
7892	! Read mc from input file. XIOS interpolates it to the model grid before it is received here.
7893	CALL xios_orchidee_recv_field("moistc_interp", mc_read_next)
7894
7895	! Read and interpolation the mask for variable mc from input file.
7896	! This is only done to be able to output the mask it later for validation purpose.
7897	! The mask corresponds to the fraction of the input source file which was underlaying the model grid cell.
7898	! 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.
7899	CALL xios_orchidee_recv_field("mask_moistc_interp", mask_mc_interp)
7900
7901	ELSE
7902
7903	! Only read fields from the file. We here suppose that no interpolation is needed.
7904	IF (is_root_prc) THEN
7905	IF (firsttime_mc) THEN
7906	! Open and read dimenions in file
7907	CALL flininfo('nudge_moistc.nc', iim_file, jjm_file, llm_file, ttm_mc, mc_id)
7908
7909	! Coherence test between dimension in the file and in the model run
7910	IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
7911	WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_mc=', &
7912	iim_file, jjm_file, llm_file, ttm_mc
7913	WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
7914	CALL ipslerr_p(2,'hydrol_nudge','Problem in coherence between dimensions in nudge_moistc.nc file and model',&
7915	'iim_file should be equal to iim_g','jjm_file should be equal to jjm_g')
7916	END IF
7917
7918	firsttime_mc=.FALSE.
7919	istart_mc=julian_diff-1 ! initialize time counter to read
7920	IF (printlev>=2) WRITE(numout,*) "Start read nudge_moistc.nc file at time step: ", istart_mc+1
7921	END IF
7922
7923	istart_mc=istart_mc+1 ! read next time step in the file
7924	iend=istart_mc ! only read 1 time step
7925
7926	! Read mc from file, one variable per soiltile
7927	IF (printlev>=3) WRITE(numout,*) &
7928	"Read variables moistc_1, moistc_2 and moistc_3 from nudge_moistc.nc at time step: ", istart_mc
7929	CALL flinget (mc_id, 'moistc_1', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_1)
7930	CALL flinget (mc_id, 'moistc_2', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_2)
7931	CALL flinget (mc_id, 'moistc_3', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_3)
7932
7933	! Transform from global 2D(iim_g, jjm_g) into into land-only global 1D(nbp_glo)
7934	! Put the variables on the 3 soiltiles in the same file
7935	DO ji = 1, nbp_glo
7936	j = ((index_g(ji)-1)/iim_g) + 1
7937	i = (index_g(ji) - (j-1)*iim_g)
7938	mc_read_glo1D(ji,:,1) = mc_read_glo2D_1(i,j,:,1)
7939	mc_read_glo1D(ji,:,2) = mc_read_glo2D_2(i,j,:,1)
7940	mc_read_glo1D(ji,:,3) = mc_read_glo2D_3(i,j,:,1)
7941	END DO
7942	END IF
7943
7944	! Distribute the fields on all processors
7945	CALL scatter(mc_read_glo1D, mc_read_next)
7946
7947	! No interpolation is done, set the mask to 1
7948	mask_mc_interp(:,:,:) = 1
7949
7950	END IF ! nudge_interpol_with_xios
7951	END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
7952
7953
7954	!! 1.3 Linear time interpolation between daily fields to the current time step
7955	tau = (kjit-1)dt_sechiba/one_day - AINT((kjit-1)dt_sechiba/one_day)
7956	mc_read_current(:,:,:) = (1.-tau)mc_read_prev(:,:,:) + taumc_read_next(:,:,:)
7957
7958	!! 1.4 Output daily fields and time interpolated fields only for debugging and validation purpose
7959	CALL xios_orchidee_send_field("mc_read_next", mc_read_next)
7960	CALL xios_orchidee_send_field("mc_read_current", mc_read_current)
7961	CALL xios_orchidee_send_field("mc_read_prev", mc_read_prev)
7962	CALL xios_orchidee_send_field("mask_mc_interp_out", mask_mc_interp)
7963
7964
7965	!! 1.5 Applay nudging of soil moisture using alpha_nudge_mc at each model sechiba time step.
7966	!! alpha_mc_nudge calculated using the parameter for relaxation time NUDGE_TAU_MC set in module constantes.
7967	!! alpha_nudge_mc is between 0-1
7968	!! If alpha_nudge_mc=1, the new mc will be replaced by the one read from file
7969	mc_loc(:,:,:) = (1-alpha_nudge_mc)mc_loc(:,:,:) + alpha_nudge_mc mc_read_current(:,:,:)
7970
7971
7972	!! 1.6 Calculate diagnostic for nudging increment of water in soil moisture
7973	mc_aux(:,:,:) = alpha_nudge_mc * ( mc_read_current(:,:,:) - mc_loc(:,:,:))
7974	DO jst=1,nstm
7975	DO ji=1,kjpindex
7976	tmc_aux(ji,jst) = dz(2) * ( trois*mc_aux(ji,1,jst) + mc_aux(ji,2,jst) )/huit
7977	DO jsl = 2,nslm-1
7978	tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(jsl) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl-1,jst))/huit &
7979	+ dz(jsl+1) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl+1,jst))/huit
7980	ENDDO
7981	tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(nslm) * (trois*mc_aux(ji,nslm,jst) + mc_aux(ji,nslm-1,jst))/huit
7982	ENDDO
7983	ENDDO
7984
7985	! Average over grid-cell
7986	nudgincsm(:) = zero
7987	DO jst=1,nstm
7988	DO ji=1,kjpindex
7989	nudgincsm(ji) = nudgincsm(ji) + vegtot(ji) * soiltile(ji,jst) * tmc_aux(ji,jst)
7990	ENDDO
7991	ENDDO
7992
7993	CALL xios_orchidee_send_field("nudgincsm", nudgincsm)
7994
7995
7996	END IF ! IF (ok_nudge_mc)
7997
7998
7999	!! 2. Nudging of snow variables
8000	IF (ok_nudge_snow) THEN
8001
8002	!! 2.1 Read snow variables from file, once a day only
8003	!! The forcing file must contain daily frequency values for the full year of the simulation
8004	IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN
8005	! Save variables from previous day
8006	snowdz_read_prev = snowdz_read_next
8007	snowrho_read_prev = snowrho_read_next
8008	snowtemp_read_prev = snowtemp_read_next
8009
8010	IF (nudge_interpol_with_xios) THEN
8011	! Read and interpolation snow variables and the mask from input file
8012	CALL xios_orchidee_recv_field("snowdz_interp", snowdz_read_next)
8013	CALL xios_orchidee_recv_field("snowrho_interp", snowrho_read_next)
8014	CALL xios_orchidee_recv_field("snowtemp_interp", snowtemp_read_next)
8015	CALL xios_orchidee_recv_field("mask_snow_interp", mask_snow_interp)
8016
8017	ELSE
8018	! Only read fields from the file. We here suppose that no interpolation is needed.
8019	IF (is_root_prc) THEN
8020	IF (firsttime_snow) THEN
8021	! Open and read dimenions in file
8022	CALL flininfo('nudge_snow.nc', iim_file, jjm_file, llm_file, ttm_snow, snow_id)
8023
8024	! Coherence test between dimension in the file and in the model run
8025	IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
8026	WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_snow=', &
8027	iim_file, jjm_file, llm_file, ttm_snow
8028	WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
8029	CALL ipslerr_p(3,'hydrol_nudge','Problem in coherence between dimensions in nudge_snow.nc file and model',&
8030	'iim_file should be equal to iim_g','jjm_file should be equal to jjm_g')
8031	END IF
8032
8033	firsttime_snow=.FALSE.
8034	istart_snow=julian_diff-1 ! initialize time counter to read
8035	IF (printlev>=2) WRITE(numout,*) "Start read nudge_snow.nc file at time step: ", istart_snow+1
8036	END IF
8037
8038	istart_snow=istart_snow+1 ! read next time step in the file
8039	iend=istart_snow ! only read 1 time step
8040
8041	! Read snowdz, snowrho and snowtemp from file
8042	IF (printlev>=3) WRITE(numout,*) &
8043	"Read variables snowdz, snowrho and snowtemp from nudge_snow.nc at time step: ", istart_snow
8044	CALL flinget (snow_id, 'snowdz', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowdz_read_glo2D)
8045	CALL flinget (snow_id, 'snowrho', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowrho_read_glo2D)
8046	CALL flinget (snow_id, 'snowtemp', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowtemp_read_glo2D)
8047
8048
8049	! Transform from global 2D(iim_g, jjm_g) variables into into land-only global 1D variables (nbp_glo)
8050	DO ji = 1, nbp_glo
8051	j = ((index_g(ji)-1)/iim_g) + 1
8052	i = (index_g(ji) - (j-1)*iim_g)
8053	snowdz_read_glo1D(ji,:) = snowdz_read_glo2D(i,j,:,1)
8054	snowrho_read_glo1D(ji,:) = snowrho_read_glo2D(i,j,:,1)
8055	snowtemp_read_glo1D(ji,:) = snowtemp_read_glo2D(i,j,:,1)
8056	END DO
8057	END IF
8058
8059	! Distribute the fields on all processors
8060	CALL scatter(snowdz_read_glo1D, snowdz_read_next)
8061	CALL scatter(snowrho_read_glo1D, snowrho_read_next)
8062	CALL scatter(snowtemp_read_glo1D, snowtemp_read_next)
8063
8064	! No interpolation is done, set the mask to 1
8065	mask_snow_interp=1
8066
8067	END IF ! nudge_interpol_with_xios
8068	END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
8069
8070
8071	!! 2.2 Linear time interpolation between daily fields for current time step
8072	tau = (kjit-1)dt_sechiba/one_day - AINT((kjit-1)dt_sechiba/one_day)
8073	snowdz_read_current(:,:) = (1.-tau)snowdz_read_prev(:,:) + tausnowdz_read_next(:,:)
8074	snowrho_read_current(:,:) = (1.-tau)snowrho_read_prev(:,:) + tausnowrho_read_next(:,:)
8075	snowtemp_read_current(:,:) = (1.-tau)snowtemp_read_prev(:,:) + tausnowtemp_read_next(:,:)
8076
8077	!! 2.3 Output daily fields and time interpolated fields only for debugging and validation purpose
8078	CALL xios_orchidee_send_field("snowdz_read_next", snowdz_read_next)
8079	CALL xios_orchidee_send_field("snowdz_read_current", snowdz_read_current)
8080	CALL xios_orchidee_send_field("snowdz_read_prev", snowdz_read_prev)
8081	CALL xios_orchidee_send_field("snowrho_read_next", snowrho_read_next)
8082	CALL xios_orchidee_send_field("snowrho_read_current", snowrho_read_current)
8083	CALL xios_orchidee_send_field("snowrho_read_prev", snowrho_read_prev)
8084	CALL xios_orchidee_send_field("snowtemp_read_next", snowtemp_read_next)
8085	CALL xios_orchidee_send_field("snowtemp_read_current", snowtemp_read_current)
8086	CALL xios_orchidee_send_field("snowtemp_read_prev", snowtemp_read_prev)
8087	CALL xios_orchidee_send_field("mask_snow_interp_out", mask_snow_interp)
8088
8089	!! 2.4 Applay nudging of snow variables using alpha_nudge_snow at each model sechiba time step.
8090	!! alpha_snow_nudge calculated using the parameter for relaxation time NUDGE_TAU_SNOW set in module constantes.
8091	!! alpha_nudge_snow is between 0-1
8092	!! If alpha_nudge_snow=1, the new snow variables will be replaced by the ones read from file.
8093	snowdz(:,:) = (1-alpha_nudge_snow)snowdz(:,:) + alpha_nudge_snow snowdz_read_current(:,:)
8094	snowrho(:,:) = (1-alpha_nudge_snow)snowrho(:,:) + alpha_nudge_snow snowrho_read_current(:,:)
8095	snowtemp(:,:) = (1-alpha_nudge_snow)snowtemp(:,:) + alpha_nudge_snow snowtemp_read_current(:,:)
8096
8097	!! 2.5 Calculate diagnostic for the nudging increment of water in snow
8098	nudgincswe=0.
8099	DO jg = 1, nsnow
8100	nudgincswe(:) = nudgincswe(:) + &
8101	alpha_nudge_snow(snowdz_read_current(:,jg)snowrho_read_current(:,jg)-snowdz(:,jg)*snowrho(:,jg))
8102	END DO
8103	CALL xios_orchidee_send_field("nudgincswe", nudgincswe)
8104
8105	END IF
8106
8107
8108	END SUBROUTINE hydrol_nudge
8109
8110	!AD19: overrule check_wtd definition + done by another subroutine
8111	!!$ !IGEM: routine for caclulate the total water content tmc(mm) in the soil colunm of
8112	!!$ ! a soil tile
8113	!!$ SUBROUTINE calc_humtot(kjpindex,tmci,ins,njsc)
8114	!!$ !! 0. Variable and parameter declaration
8115	!!$ !! 0.1 Input variables
8116	!!$ ! GLOBAL (in or inout)
8117	!!$ INTEGER(i_std), INTENT(in) :: kjpindex !!Domain size
8118	!!$ REAL(r_std), INTENT(out), DIMENSION(kjpindex) :: tmci
8119	!!$ INTEGER(i_std), INTENT(in), DIMENSION(kjpindex) :: njsc
8120	!!$ !! 0.4 Local variables
8121	!!$ INTEGER(i_std) :: ji, jsl, jstm, ins !!Indices
8122	!!$ LOGICAL :: check_wtd
8123	!!$
8124	!!$ !IGEM: mcl calculate here for water conservation
8125	!!$ !We define mcl (liquid water content) based on mc and
8126	!!$ !profil_froz_hydro_ns
8127	!!$ DO jsl = 1, nslm
8128	!!$ DO ji =1, kjpindex
8129	!!$ mcl(ji,jsl,ins)= MIN( mc(ji,jsl,ins), mcr(njsc(ji)) + &
8130	!!$ (un-profil_froz_hydro_ns(ji,jsl,ins))*(mc(ji,jsl,ins)-mcr(njsc(ji))))
8131	!!$ ENDDO
8132	!!$ ENDDO
8133	!!$
8134	!!$ tmci(:) = zero
8135	!!$
8136	!!$ check_wtd = .TRUE.
8137	!!$ IF (check_wtd) THEN
8138	!!$ tmci(:) = dz(2) * ( trois*mcl(:,1,ins) + mcl(:,2,ins) )/huit
8139	!!$ DO jsl = 2,nslm-1
8140	!!$ tmci(:) = tmci(:) + dz(jsl) * (trois*mcl(:,jsl,ins)+mcl(:,jsl-1,ins))/huit &
8141	!!$ + dz(jsl+1) * (trois*mcl(:,jsl,ins)+mcl(:,jsl+1,ins))/huit
8142	!!$ ENDDO
8143	!!$ tmci(:) = tmci(:) + dz(nslm) * (trois*mcl(:,nslm,ins) + mcl(:,nslm-1,ins))/huit
8144	!!$ ENDIF
8145	!!$
8146	!!$ END SUBROUTINE calc_humtot
8147
8148
8149	END MODULE hydrol

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

Context Navigation

source: branches/publications/ORCHIDEE-Hillslope-r6515/src_sechiba/hydrol.f90

Download in other formats: