Context Navigation

source: tags/ORCHIDEE_4_1/ORCHIDEE/src_sechiba/hydrol.f90 @ 7704

Last change on this file since 7704 was 7615, checked in by sebastiaan.luyssaert, 2 years ago
Enhanced consistency of variable names: input has been changed in n_input throughout the code and the variable name vegstress introduced in sechiba is now also used in stomate. Enhnaced computational consistency: Pgap_cumul is used in stomate rather than recalculating it before calculating light_tran_to_floor_season. Edited getin_p while checking the code (but no real changes were made) and added several missing stomate and sechiba variables to age_class_distr to improve the 1+1=2 issue when comparing a model run with against a run without age classes. Finally: Write warning 10b in allocation to the history file rather than the out_orchidee file
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 380.2 KB

Line
1	! ===================================================================================================\n
2	! MODULE : hydrol
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This module computes the soil moisture processes on continental points.
10	!!
11	!!\n DESCRIPTION : contains hydrol_main, hydrol_initialize, hydrol_finalise, hydrol_init,
12	!! hydrol_var_init, hydrol_waterbal, hydrol_alma,
13	!! hydrol_vegupd, hydrol_canop, hydrol_flood, hydrol_soil, hydrol_root_profile.
14	!! The assumption in this module is that very high vertical resolution is
15	!! needed in order to properly resolve the vertical diffusion of water in
16	!! the soils. Furthermore we have taken into account the sub-grid variability
17	!! of soil properties and vegetation cover by allowing the co-existence of
18	!! different soil moisture columns in the same grid box.
19	!! This routine was originaly developed by Patricia deRosnay.
20	!!
21	!! RECENT CHANGE(S) : November 2020: It is possible to define soil hydraulic parameters from maps,
22	!! as needed for the SP-MIP project (Tafasca Salma and Ducharne Agnes).
23	!! Here, it leads to change dimensions and indices.
24	!! We can also impose kfact_root=1 in all soil layers to cancel the effect of
25	!! roots on ks profile (keyword KFACT_ROOT_CONST).
26	!!
27	!! REFERENCE(S) :
28	!! - de Rosnay, P., J. Polcher, M. Bruen, and K. Laval, Impact of a physically based soil
29	!! water flow and soil-plant interaction representation for modeling large-scale land surface
30	!! processes, J. Geophys. Res, 107 (10.1029), 2002. \n
31	!! - de Rosnay, P. and Polcher J. (1998) Modeling root water uptake in a complex land surface scheme coupled
32	!! to a GCM. Hydrology and Earth System Sciences, 2(2-3):239-256. \n
33	!! - de Rosnay, P., M. Bruen, and J. Polcher, Sensitivity of surface fluxes to the number of layers in the soil
34	!! model used in GCMs, Geophysical research letters, 27 (20), 3329 - 3332, 2000. \n
35	!! - dâOrgeval, T., J. Polcher, and P. De Rosnay, Sensitivity of the West African hydrological
36	!! cycle in ORCHIDEE to infiltration processes, Hydrol. Earth Syst. Sci. Discuss, 5, 2251 - 2292, 2008. \n
37	!! - Carsel, R., and R. Parrish, Developing joint probability distributions of soil water retention
38	!! characteristics, Water Resources Research, 24 (5), 755 - 769, 1988. \n
39	!! - Mualem, Y., A new model for predicting the hydraulic conductivity of unsaturated porous
40	!! media, Water Resources Research, 12 (3), 513 - 522, 1976. \n
41	!! - Van Genuchten, M., A closed-form equation for predicting the hydraulic conductivity of
42	!! unsaturated soils, Soil Science Society of America Journal, 44 (5), 892 - 898, 1980. \n
43	!! - Campoy, A., Ducharne, A., Cheruy, F., Hourdin, F., Polcher, J., and Dupont, J.-C., Response
44	!! of land surface fluxes and precipitation to different soil bottom hydrological conditions in a
45	!! general circulation model, J. Geophys. Res, in press, 2013. \n
46	!! - Gouttevin, I., Krinner, G., Ciais, P., Polcher, J., and Legout, C. , 2012. Multi-scale validation
47	!! of a new soil freezing scheme for a land-surface model with physically-based hydrology.
48	!! The Cryosphere, 6, 407-430, doi: 10.5194/tc-6-407-2012. \n
49	!! - Tafasca S. (2020). Evaluation de lâimpact des propriÃ©tÃ©s du sol sur lâhydrologie simulee dans le
50	!! modÃšle ORCHIDEE, PhD thesis, Sorbonne Universite. \n
51	!!
52	!! SVN :
53	!! $HeadURL$
54	!! $Date$
55	!! $Revision$
56	!! \n
57	!_ ===============================================================================================\n
58	MODULE hydrol
59
60	USE ioipsl
61	USE xios_orchidee
62	USE constantes
63	USE time, ONLY : one_day, dt_sechiba, julian_diff
64	USE constantes_soil
65	USE pft_parameters
66	USE sechiba_io_p
67	USE grid
68	USE explicitsnow
69
70	IMPLICIT NONE
71
72	PRIVATE
73	PUBLIC :: hydrol_main, hydrol_initialize, hydrol_finalize, hydrol_clear
74
75	!
76	! variables used inside hydrol module : declaration and initialisation
77	!
78	LOGICAL, SAVE :: doponds=.FALSE. !! Reinfiltration flag (true/false)
79	!$OMP THREADPRIVATE(doponds)
80	REAL(r_std), SAVE :: froz_frac_corr !! Coefficient for water frozen fraction correction
81	!$OMP THREADPRIVATE(froz_frac_corr)
82	REAL(r_std), SAVE :: max_froz_hydro !! Coefficient for water frozen fraction correction
83	!$OMP THREADPRIVATE(max_froz_hydro)
84	REAL(r_std), SAVE :: smtot_corr !! Coefficient for water frozen fraction correction
85	!$OMP THREADPRIVATE(smtot_corr)
86	LOGICAL, SAVE :: do_rsoil=.TRUE. !! Flag to calculate rsoil for bare soile evap
87	!! (true/false)
88	!$OMP THREADPRIVATE(do_rsoil)
89	LOGICAL, SAVE :: kfact_root_const !! Control kfact_root calculation, set constant kfact_root=1 if kfact_root_const=true
90	!$OMP THREADPRIVATE(kfact_root_const)
91	CHARACTER(LEN=80) , SAVE :: var_name !! To store variables names for I/O
92	!$OMP THREADPRIVATE(var_name)
93
94	!
95	REAL(r_std), PARAMETER :: allowed_err = 2.0E-8_r_std
96	REAL(r_std), PARAMETER :: EPS1 = EPSILON(un) !! A small number
97	! one dimension array allocated, computed, saved and got in hydrol module
98	! Values per soil type
99
100	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: pcent !! Fraction of saturated volumetric soil moisture above
101	!! which transpir is max (0-1, unitless)
102	!$OMP THREADPRIVATE(pcent)
103	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_awet !! Vol. wat. cont. above which albedo is cst
104	!! @tex $(m^{3} m^{-3})$ @endtex
105	!$OMP THREADPRIVATE(mc_awet)
106	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mc_adry !! Vol. wat. cont. below which albedo is cst
107	!! @tex $(m^{3} m^{-3})$ @endtex
108	!$OMP THREADPRIVATE(mc_adry)
109	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_beg !! Total amount of water on vegetation at start of time
110	!! step @tex $(kg m^{-2})$ @endtex
111	!$OMP THREADPRIVATE(tot_watveg_beg)
112	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watveg_end !! Total amount of water on vegetation at end of time step
113	!! @tex $(kg m^{-2})$ @endtex
114	!$OMP THREADPRIVATE(tot_watveg_end)
115	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_beg !! Total amount of water in the soil at start of time step
116	!! @tex $(kg m^{-2})$ @endtex
117	!$OMP THREADPRIVATE(tot_watsoil_beg)
118	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tot_watsoil_end !! Total amount of water in the soil at end of time step
119	!! @tex $(kg m^{-2})$ @endtex
120	!$OMP THREADPRIVATE(tot_watsoil_end)
121	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_beg !! Total amount of snow at start of time step
122	!! @tex $(kg m^{-2})$ @endtex
123	!$OMP THREADPRIVATE(snow_beg)
124	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: snow_end !! Total amount of snow at end of time step
125	!! @tex $(kg m^{-2})$ @endtex
126	!$OMP THREADPRIVATE(snow_end)
127	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delsoilmoist !! Change in soil moisture @tex $(kg m^{-2})$ @endtex
128	!$OMP THREADPRIVATE(delsoilmoist)
129	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delintercept !! Change in interception storage
130	!! @tex $(kg m^{-2})$ @endtex
131	!$OMP THREADPRIVATE(delintercept)
132	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: delswe !! Change in SWE @tex $(kg m^{-2})$ @endtex
133	!$OMP THREADPRIVATE(delswe)
134	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION (:) :: undermcr !! Nb of tiles under mcr for a given time step
135	!$OMP THREADPRIVATE(undermcr)
136	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_veget !! zero/one when veget fraction is zero/higher (1)
137	!$OMP THREADPRIVATE(mask_veget)
138	INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_soiltile !! zero/one where soil tile is zero/higher (1)
139	!$OMP THREADPRIVATE(mask_soiltile)
140	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: humrelv !! Water stress index for transpiration
141	!! for each soiltile x PFT couple (0-1, unitless)
142	!$OMP THREADPRIVATE(humrelv)
143	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegstressv !! Water stress index for vegetation growth
144	!! for each soiltile x PFT couple (0-1, unitless)
145	!$OMP THREADPRIVATE(vegstressv)
146	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol !! Throughfall+Totmelt per PFT
147	!! @tex $(kg m^{-2})$ @endtex
148	!$OMP THREADPRIVATE(precisol)
149	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: throughfall !! Throughfall per PFT
150	!! @tex $(kg m^{-2})$ @endtex
151	!$OMP THREADPRIVATE(throughfall)
152	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: precisol_ns !! Throughfall per soiltile
153	!! @tex $(kg m^{-2})$ @endtex
154	!$OMP THREADPRIVATE(precisol_ns)
155	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ae_ns !! Bare soil evaporation per soiltile
156	!! @tex $(kg m^{-2})$ @endtex
157	!$OMP THREADPRIVATE(ae_ns)
158	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: free_drain_coef !! Coefficient for free drainage at bottom
159	!! (0-1, unitless)
160	!$OMP THREADPRIVATE(free_drain_coef)
161	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: zwt_force !! Prescribed water table depth (m)
162	!$OMP THREADPRIVATE(zwt_force)
163	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: frac_bare_ns !! Evaporating bare soil fraction per soiltile
164	!! (0-1, unitless)
165	!$OMP THREADPRIVATE(frac_bare_ns)
166	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: rootsink !! Transpiration sink by soil layer and soiltile
167	!! @tex $(kg m^{-2})$ @endtex
168	!$OMP THREADPRIVATE(rootsink)
169	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsnowveg !! Sublimation of snow on vegetation
170	!! @tex $(kg m^{-2})$ @endtex
171	!$OMP THREADPRIVATE(subsnowveg)
172	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: subsnownobio !! Sublimation of snow on other surface types
173	!! (ice, lakes,...) @tex $(kg m^{-2})$ @endtex
174	!$OMP THREADPRIVATE(subsnownobio)
175	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: icemelt !! Ice melt @tex $(kg m^{-2})$ @endtex
176	!$OMP THREADPRIVATE(icemelt)
177	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: subsinksoil !! Excess of sublimation as a sink for the soil
178	!! @tex $(kg m^{-2})$ @endtex
179	!$OMP THREADPRIVATE(subsinksoil)
180	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot !! Total Total fraction of grid-cell covered by PFTs
181	!! (bare soil + vegetation) (1; 1)
182	!$OMP THREADPRIVATE(vegtot)
183	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: resdist !! Soiltile values from previous time-step (1; 1)
184	!$OMP THREADPRIVATE(resdist)
185	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: vegtot_old !! Total Total fraction of grid-cell covered by PFTs
186	!! from previous time-step (1; 1)
187	!$OMP THREADPRIVATE(vegtot_old)
188	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: mx_eau_var !! Maximum water content of the soil @tex $(kg m^{-2})$ @endtex
189	!$OMP THREADPRIVATE(mx_eau_var)
190
191	! arrays used by cwrr scheme
192	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kfact_root !! Factor to increase Ks towards the surface
193	!! (unitless)
194	!! DIM = kjpindex * nslm * nstm
195	!$OMP THREADPRIVATE(kfact_root)
196	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kfact !! Factor to reduce Ks with depth (unitless)
197	!! DIM = nslm * kjpindex
198	!$OMP THREADPRIVATE(kfact)
199	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: zz !! Depth of nodes [znh in vertical_soil] transformed into (mm)
200	!$OMP THREADPRIVATE(zz)
201	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dz !! Internode thickness [dnh in vertical_soil] transformed into (mm)
202	!$OMP THREADPRIVATE(dz)
203	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: dh !! Layer thickness [dlh in vertical_soil] transformed into (mm)
204	!$OMP THREADPRIVATE(dh)
205	INTEGER(i_std), SAVE :: itopmax !! Number of layers where the node is above 0.1m depth
206	!$OMP THREADPRIVATE(itopmax)
207	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mc_lin !! 50 Vol. Wat. Contents to linearize K and D, for each texture
208	!! @tex $(m^{3} m^{-3})$ @endtex
209	!! DIM = imin:imax * kjpindex
210	!$OMP THREADPRIVATE(mc_lin)
211	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: k_lin !! 50 values of unsaturated K, for each soil layer and texture
212	!! @tex $(mm d^{-1})$ @endtex
213	!! DIM = imin:imax * nslm * kjpindex
214	!$OMP THREADPRIVATE(k_lin)
215	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: d_lin !! 50 values of diffusivity D, for each soil layer and texture
216	!! @tex $(mm^2 d^{-1})$ @endtex
217	!! DIM = imin:imax * nslm * kjpindex
218	!$OMP THREADPRIVATE(d_lin)
219	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: a_lin !! 50 values of the slope in K=a*mc+b, for each soil layer and texture
220	!! @tex $(mm d^{-1})$ @endtex
221	!! DIM = imin:imax * nslm * kjpindex
222	!$OMP THREADPRIVATE(a_lin)
223	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: b_lin !! 50 values of y-intercept in K=a*mc+b, for each soil layer and texture
224	!! @tex $(m^{3} m^{-3})$ @endtex
225	!! DIM = imin:imax * nslm * kjpindex
226	!$OMP THREADPRIVATE(b_lin)
227
228	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: humtot !! Total Soil Moisture @tex $(kg m^{-2})$ @endtex
229	!$OMP THREADPRIVATE(humtot)
230	LOGICAL, ALLOCATABLE, SAVE, DIMENSION (:) :: resolv !! Mask of land points where to solve the diffusion equation
231	!! (true/false)
232	!$OMP THREADPRIVATE(resolv)
233
234	!! for output
235	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: kk_moy !! Mean hydraulic conductivity over soiltiles (mm/d)
236	!$OMP THREADPRIVATE(kk_moy)
237	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: kk !! Hydraulic conductivity for each soiltiles (mm/d)
238	!$OMP THREADPRIVATE(kk)
239	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: avan_mod_tab !! VG parameter a modified from exponantial profile
240	!! @tex $(mm^{-1})$ @endtex !! DIMENSION (nslm,kjpindex)
241	!$OMP THREADPRIVATE(avan_mod_tab)
242	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: nvan_mod_tab !! VG parameter n modified from exponantial profile
243	!! (unitless) !! DIMENSION (nslm,kjpindex)
244	!$OMP THREADPRIVATE(nvan_mod_tab)
245
246	!! linarization coefficients of hydraulic conductivity K (hydrol_soil_coef)
247	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: k !! Hydraulic conductivity K for each soil layer
248	!! @tex $(mm d^{-1})$ @endtex
249	!! DIM = (:,nslm)
250	!$OMP THREADPRIVATE(k)
251	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: a !! Slope in K=a*mc+b(:,nslm)
252	!! @tex $(mm d^{-1})$ @endtex
253	!! DIM = (:,nslm)
254	!$OMP THREADPRIVATE(a)
255	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: b !! y-intercept in K=a*mc+b
256	!! @tex $(m^{3} m^{-3})$ @endtex
257	!! DIM = (:,nslm)
258	!$OMP THREADPRIVATE(b)
259	!! linarization coefficients of hydraulic diffusivity D (hydrol_soil_coef)
260	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: d !! Diffusivity D for each soil layer
261	!! @tex $(mm^2 d^{-1})$ @endtex
262	!! DIM = (:,nslm)
263	!$OMP THREADPRIVATE(d)
264	!! matrix coefficients (hydrol_soil_tridiag and hydrol_soil_setup), see De Rosnay (1999), p155-157
265	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: e !! Left-hand tridiagonal matrix coefficients
266	!$OMP THREADPRIVATE(e)
267	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: f !! Left-hand tridiagonal matrix coefficients
268	!$OMP THREADPRIVATE(f)
269	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: g1 !! Left-hand tridiagonal matrix coefficients
270	!$OMP THREADPRIVATE(g1)
271
272	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ep !! Right-hand matrix coefficients
273	!$OMP THREADPRIVATE(ep)
274	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: fp !! Right-hand atrix coefficients
275	!$OMP THREADPRIVATE(fp)
276	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: gp !! Right-hand atrix coefficients
277	!$OMP THREADPRIVATE(gp)
278	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: rhs !! Right-hand system
279	!$OMP THREADPRIVATE(rhs)
280	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: srhs !! Temporarily stored rhs
281	!$OMP THREADPRIVATE(srhs)
282	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: tmat !! Left-hand tridiagonal matrix
283	!$OMP THREADPRIVATE(tmat)
284	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: stmat !! Temporarily stored tmat
285	!$OMP THREADPRIVATE(stmat)
286	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: water2infilt !! Water to be infiltrated
287	!! @tex $(kg m^{-2})$ @endtex
288	!$OMP THREADPRIVATE(water2infilt)
289	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc !! Total moisture content per soiltile
290	!! @tex $(kg m^{-2})$ @endtex
291	!$OMP THREADPRIVATE(tmc)
292	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcr !! Total moisture content at residual per soiltile
293	!! @tex $(kg m^{-2})$ @endtex
294	!$OMP THREADPRIVATE(tmcr)
295	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcs !! Total moisture content at saturation per soiltile
296	!! @tex $(kg m^{-2})$ @endtex
297	!$OMP THREADPRIVATE(tmcs)
298	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcfc !! Total moisture content at field capacity per soiltile
299	!! @tex $(kg m^{-2})$ @endtex
300	!$OMP THREADPRIVATE(tmcfc)
301	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmcw !! Total moisture content at wilting point per soiltile
302	!! @tex $(kg m^{-2})$ @endtex
303	!$OMP THREADPRIVATE(tmcw)
304	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter !! Total moisture in the litter per soiltile
305	!! @tex $(kg m^{-2})$ @endtex
306	!$OMP THREADPRIVATE(tmc_litter)
307	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_mea !! Total moisture in the litter over the grid
308	!! @tex $(kg m^{-2})$ @endtex
309	!$OMP THREADPRIVATE(tmc_litt_mea)
310	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_wilt !! Total moisture of litter at wilt point per soiltile
311	!! @tex $(kg m^{-2})$ @endtex
312	!$OMP THREADPRIVATE(tmc_litter_wilt)
313	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_field !! Total moisture of litter at field cap. per soiltile
314	!! @tex $(kg m^{-2})$ @endtex
315	!$OMP THREADPRIVATE(tmc_litter_field)
316	!!! A CHANGER DANS TOUT HYDROL: tmc_litter_res et sat ne devraient pas dependre de ji - tdo
317	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_res !! Total moisture of litter at residual moisture per soiltile
318	!! @tex $(kg m^{-2})$ @endtex
319	!$OMP THREADPRIVATE(tmc_litter_res)
320	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_sat !! Total moisture of litter at saturation per soiltile
321	!! @tex $(kg m^{-2})$ @endtex
322	!$OMP THREADPRIVATE(tmc_litter_sat)
323	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_awet !! Total moisture of litter at mc_awet per soiltile
324	!! @tex $(kg m^{-2})$ @endtex
325	!$OMP THREADPRIVATE(tmc_litter_awet)
326	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_litter_adry !! Total moisture of litter at mc_adry per soiltile
327	!! @tex $(kg m^{-2})$ @endtex
328	!$OMP THREADPRIVATE(tmc_litter_adry)
329	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_wet_mea !! Total moisture in the litter over the grid below which
330	!! albedo is fixed constant
331	!! @tex $(kg m^{-2})$ @endtex
332	!$OMP THREADPRIVATE(tmc_litt_wet_mea)
333	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: tmc_litt_dry_mea !! Total moisture in the litter over the grid above which
334	!! albedo is constant
335	!! @tex $(kg m^{-2})$ @endtex
336	!$OMP THREADPRIVATE(tmc_litt_dry_mea)
337	LOGICAL, SAVE :: tmc_init_updated = .FALSE. !! Flag allowing to determine if tmc is initialized.
338	!$OMP THREADPRIVATE(tmc_init_updated)
339
340	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: v1 !! Temporary variable (:)
341	!$OMP THREADPRIVATE(v1)
342
343	!! par type de sol :
344	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: ru_ns !! Surface runoff per soiltile
345	!! @tex $(kg m^{-2})$ @endtex
346	!$OMP THREADPRIVATE(ru_ns)
347	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: dr_ns !! Drainage per soiltile
348	!! @tex $(kg m^{-2})$ @endtex
349	!$OMP THREADPRIVATE(dr_ns)
350	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tr_ns !! Transpiration per soiltile
351	!$OMP THREADPRIVATE(tr_ns)
352	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: vegetmax_soil !! (:,nvm,nstm) percentage of each veg. type on each soil
353	!! of each grid point
354	!$OMP THREADPRIVATE(vegetmax_soil)
355	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc !! Total volumetric water content at the calculation nodes
356	!! (eg : liquid + frozen)
357	!! @tex $(m^{3} m^{-3})$ @endtex
358	!$OMP THREADPRIVATE(mc)
359
360	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_prev !! Soil moisture from file at previous timestep in the file
361	!$OMP THREADPRIVATE(mc_read_prev)
362	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_next !! Soil moisture from file at next time step in the file
363	!$OMP THREADPRIVATE(mc_read_next)
364	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mc_read_current !! For nudging, linear time interpolation bewteen mc_read_prev and mc_read_next
365	!$OMP THREADPRIVATE(mc_read_current)
366	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: mask_mc_interp !! Mask of valid data in soil moisture nudging file
367	!$OMP THREADPRIVATE(mask_mc_interp)
368	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: tmc_aux !! Temporary variable needed for the calculation of diag nudgincsm for nudging
369	!$OMP THREADPRIVATE(tmc_aux)
370	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowdz_read_prev !! snowdz read from file at previous timestep in the file [m]
371	!$OMP THREADPRIVATE(snowdz_read_prev)
372	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowdz_read_next !! snowdz read from file at next time step in the file [m]
373	!$OMP THREADPRIVATE(snowdz_read_next)
374	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowrho_read_prev !! snowrho read from file at previous timestep in the file (Kg/m^3)
375	!$OMP THREADPRIVATE(snowrho_read_prev)
376	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowrho_read_next !! snowrho read from file at next time step in the file (Kg/m^3)
377	!$OMP THREADPRIVATE(snowrho_read_next)
378	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowtemp_read_prev !! snowtemp read from file at previous timestep in the file
379	!$OMP THREADPRIVATE(snowtemp_read_prev)
380	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: snowtemp_read_next !! snowtemp read from file at next time step in the file
381	!$OMP THREADPRIVATE(snowtemp_read_next)
382	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: mask_snow_interp !! Mask of valid data in snow nudging file
383	!$OMP THREADPRIVATE(mask_snow_interp)
384
385	REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mcl !! Liquid water content
386	!! @tex $(m^{3} m^{-3})$ @endtex
387	!$OMP THREADPRIVATE(mcl)
388	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soilmoist !! (:,nslm) Mean of each soil layer's moisture
389	!! across soiltiles
390	!! @tex $(kg m^{-2})$ @endtex
391	!$OMP THREADPRIVATE(soilmoist)
392	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: soilmoist_s !! (:,nslm) Mean of each soil layer's moisture
393	!! per soiltiles
394	!! @tex $(kg m^{-2})$ @endtex
395	!$OMP THREADPRIVATE(soilmoist_s)
396	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soilmoist_liquid !! (:,nslm) Mean of each soil layer's liquid moisture
397	!! across soiltiles
398	!! @tex $(kg m^{-2})$ @endtex
399	!$OMP THREADPRIVATE(soilmoist_liquid)
400	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: soil_wet_ns !! Soil wetness above mcw (0-1, unitless)
401	!$OMP THREADPRIVATE(soil_wet_ns)
402	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: soil_wet_litter !! Soil wetness aove mvw in the litter (0-1, unitless)
403	!$OMP THREADPRIVATE(soil_wet_litter)
404	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: qflux_ns !! Diffusive water fluxes between soil layers
405	!! (at lower interface)
406	!$OMP THREADPRIVATE(qflux_ns)
407	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: check_top_ns !! Diagnostic calculated in hydrol_diag_soil_flux
408	!! (water balance residu of top soil layer)
409	!$OMP THREADPRIVATE(check_top_ns)
410	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: profil_froz_hydro !! Frozen fraction for each hydrological soil layer
411	!$OMP THREADPRIVATE(profil_froz_hydro)
412	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:) :: profil_froz_hydro_ns !! As profil_froz_hydro per soiltile
413	!$OMP THREADPRIVATE(profil_froz_hydro_ns)
414
415
416	CONTAINS
417
418	!! ================================================================================================================================
419	!! SUBROUTINE : hydrol_initialize
420	!!
421	!>\BRIEF Allocate module variables, read from restart file or initialize with default values
422	!!
423	!! DESCRIPTION :
424	!!
425	!! MAIN OUTPUT VARIABLE(S) :
426	!!
427	!! REFERENCE(S) :
428	!!
429	!! FLOWCHART : None
430	!! \n
431	!_ ================================================================================================================================
432
433	SUBROUTINE hydrol_initialize ( ks, nvan, avan, mcr, &
434	mcs, mcfc, mcw, kjit, &
435	kjpindex, index, rest_id, njsc, &
436	soiltile, veget, veget_max, altmax, &
437	humrel, vegstress, drysoil_frac, shumdiag_perma, &
438	qsintveg, evap_bare_lim, evap_bare_lim_ns, &
439	snow, snow_age, snow_nobio, snow_nobio_age, &
440	snowrho, snowtemp, snowgrain, snowdz, &
441	snowheat, mc_layh, mcl_layh, soilmoist_out, &
442	mc_layh_s, mcl_layh_s,soilmoist_out_s,mc_out, &
443	ksoil, root_profile, us)
444
445
446	!! 0. Variable and parameter declaration
447	!! 0.1 Input variables
448	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
449	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
450	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
451	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
452	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
453	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
454	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
455	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
456	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
457	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
458	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
459	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
460	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
461	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
462	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
463	REAL(r_std),DIMENSION (kjpindex,nvm),INTENT(in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
464	!! Not related with the active soil carbon pool.
465	!! 0.2 Output variables
466	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
467	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
468	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
469	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
470	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
471	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor for bare soil evaporation
472	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out) :: evap_bare_lim_ns !! Limitation factor for bare soil evaporation
473	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
474	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
475	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
476	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age !! Snow age on ice, lakes, ...
477	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowrho !! Snow density (Kg/m^3)
478	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowtemp !! Snow temperature
479	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowgrain !! Snow grainsize
480	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowdz !! Snow layer thickness [m]
481	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowheat !! Snow heat content
482	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
483	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
484	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: soilmoist_out !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
485	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mc_layh_s !! Volumetric moisture content for each layer in hydrol (liquid+ice) m3/m3
486	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mcl_layh_s !! Volumetric moisture content for each layer in hydrol (liquid) m3/m3
487	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: soilmoist_out_s !! Total soil moisture content for each layer in hydrol (liquid+ice), mm
488	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mc_out
489	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: ksoil
490	REAL(r_std),DIMENSION (kjpindex,nvm,nslm,nroot_prof), INTENT(out) :: root_profile !! Normalized root mass/length fraction in each soil layer
491	!! (0-1, unitless)
492	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT (out) :: us !! Water stress index for transpiration
493	!! (by soil layer and PFT) (0-1, unitless)
494
495
496	!! 0.4 Local variables
497	INTEGER(i_std) :: jsl
498	REAL(r_std),DIMENSION (kjpindex) :: soilwetdummy !! Temporary variable never used
499	!_ ================================================================================================================================
500
501	CALL hydrol_init (ks, nvan, avan, mcr, mcs, mcfc, mcw, njsc, &
502	kjit, kjpindex, index, rest_id, veget_max, soiltile, &
503	humrel, vegstress, snow, snow_age, snow_nobio, &
504	snow_nobio_age, qsintveg, &
505	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
506	drysoil_frac, evap_bare_lim, evap_bare_lim_ns, mc_out, ksoil, &
507	root_profile, us)
508
509	CALL hydrol_var_init (ks, nvan, avan, mcr, mcs, mcfc, mcw, &
510	kjpindex, veget, veget_max, soiltile, njsc, altmax, &
511	mx_eau_var, shumdiag_perma, &
512	drysoil_frac, qsintveg, mc_layh, mcl_layh, mc_layh_s, mcl_layh_s)
513
514	!! Initialize hydrol_alma routine if the variables were not found in the restart file. This is done in the end of
515	!! hydrol_initialize so that all variables(humtot,..) that will be used are initialized.
516	IF (ALL(tot_watveg_beg(:)==val_exp) .OR. ALL(tot_watsoil_beg(:)==val_exp) .OR. ALL(snow_beg(:)==val_exp)) THEN
517	! The output variable soilwetdummy is not calculated at first call to hydrol_alma.
518	CALL hydrol_alma(kjpindex, index, .TRUE., qsintveg, snow, snow_nobio, soilwetdummy)
519	END IF
520
521	!! Calculate itopmax indicating the number of layers where the node is above 0.1m depth
522	itopmax=1
523	DO jsl = 1, nslm
524	! znh : depth of nodes
525	IF (znh(jsl) <= 0.1) THEN
526	itopmax=jsl
527	END IF
528	END DO
529	IF (printlev>=3) WRITE(numout,*) "Number of layers where the node is above 0.1m depth: itopmax=",itopmax
530
531	! Copy soilmoist into a local variable to be sent to thermosoil
532	soilmoist_out(:,:) = soilmoist(:,:)
533	soilmoist_out_s(:,:,:) = soilmoist_s(:,:,:)
534
535	END SUBROUTINE hydrol_initialize
536
537
538	!! ================================================================================================================================
539	!! SUBROUTINE : hydrol_main
540	!!
541	!>\BRIEF
542	!!
543	!! DESCRIPTION :
544	!! - called every time step
545	!! - initialization and finalization part are not done in here
546	!!
547	!! - 1 computes snow ==> explicitsnow
548	!! - 2 computes vegetations reservoirs ==> hydrol_vegupd
549	!! - 3 computes canopy ==> hydrol_canop
550	!! - 4 computes surface reservoir ==> hydrol_flood
551	!! - 5 computes soil hydrology ==> hydrol_soil
552	!!
553	!! IMPORTANT NOTICE : The water fluxes are used in their integrated form, over the time step
554	!! dt_sechiba, with a unit of kg m^{-2}.
555	!!
556	!! RECENT CHANGE(S) : None
557	!!
558	!! MAIN OUTPUT VARIABLE(S) :
559	!!
560	!! REFERENCE(S) :
561	!!
562	!! FLOWCHART : None
563	!! \n
564	!_ ================================================================================================================================
565
566	SUBROUTINE hydrol_main (ks, nvan, avan, mcr, mcs, mcfc, mcw, kjit, kjpindex, &
567	& index, indexveg, indexsoil, indexlayer, indexnslm, &
568	& temp_sol_new, floodout, runoff, drainage, frac_nobio, totfrac_nobio, vevapwet, veget, veget_max, njsc, &
569	& qsintmax, qsintveg, vevapnu, vevapsno, vevapflo, snow, snow_age, snow_nobio, snow_nobio_age, &
570	& tot_melt, transpir, precip_rain, precip_snow, returnflow, reinfiltration, irrigation, &
571	& humrel, vegstress, drysoil_frac, evapot, evapot_penm, evap_bare_lim, evap_bare_lim_ns, &
572	& flood_frac, flood_res, &
573	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, soilcap, soiltile, fraclut, reinf_slope, rest_id, hist_id, hist2_id,&
574	& contfrac, stempdiag, &
575	& temp_air, pb, u, v, tq_cdrag, swnet, pgflux, &
576	& snowrho,snowtemp,snowgrain,snowdz,snowheat,snowliq, &
577	& grndflux,gtemp,tot_bare_soil, &
578	& lambda_snow,cgrnd_snow,dgrnd_snow,frac_snow_veg,temp_sol_add, &
579	& mc_layh, mcl_layh, tmc_pft, drainage_pft, runoff_pft, swc_pft, soilmoist_out, mc_layh_s, mcl_layh_s, soilmoist_out_s,&
580	& mc_out, e_frac, ksoil, mcs_hydrol, mcfc_hydrol, altmax, root_profile, &
581	& root_depth, circ_class_biomass, us)
582
583
584	!! 0. Variable and parameter declaration
585
586	!! 0.1 Input variables
587
588	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
589	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
590	INTEGER(i_std),INTENT (in) :: rest_id,hist_id !! _Restart_ file and _history_ file identifier
591	INTEGER(i_std),INTENT (in) :: hist2_id !! _history_ file 2 identifier
592	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
593	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg !! Indeces of the points on the 3D map for veg
594	INTEGER(i_std),DIMENSION (kjpindex*nstm), INTENT (in):: indexsoil !! Indeces of the points on the 3D map for soil
595	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexlayer !! Indeces of the points on the 3D map for soil layers
596	INTEGER(i_std),DIMENSION (kjpindex*nslm), INTENT (in):: indexnslm !! Indeces of the points on the 3D map for of diagnostic soil layers
597
598	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_rain !! Rain precipitation
599	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_snow !! Snow precipitation
600	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: returnflow !! Routed water which comes back into the soil (from the
601	!! bottom)
602	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinfiltration !! Routed water which comes back into the soil (at the
603	!! top)
604	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: irrigation !! Water from irrigation returning to soil moisture
605	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol_new !! New soil temperature
606
607	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
608	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: frac_nobio !! Fraction of ice, lakes, ...
609	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: totfrac_nobio !! Total fraction of ice+lakes+...
610	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: soilcap !! Soil capacity
611	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
612	REAL(r_std),DIMENSION (kjpindex,nlut), INTENT (in) :: fraclut !! Fraction of each landuse tile (0-1, unitless)
613	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vevapwet !! Interception loss
614	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of vegetation type
615	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type (LAI -> infty)
616	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintmax !! Maximum water on vegetation for interception
617	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
618	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Slope coef
619	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
620	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
621	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
622	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
623	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
624	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
625	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
626	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot !! Soil Potential Evaporation
627	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: evapot_penm !! Soil Potential Evaporation Correction
628	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: flood_frac !! flood fraction
629	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid
630	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
631	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature
632	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
633	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient (-)
634	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
635	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net shortwave radiation
636	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pgflux !! Net energy into snowpack
637	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: gtemp !! First soil layer temperature
638	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
639	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lambda_snow !! Coefficient of the linear extrapolation of surface temperature
640	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: cgrnd_snow !! Integration coefficient for snow numerical scheme
641	REAL(r_std),DIMENSION (kjpindex,nsnow), INTENT (in):: dgrnd_snow !! Integration coefficient for snow numerical scheme
642	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: frac_snow_veg !! Snow cover fraction on vegetation
643	REAL(r_std), DIMENSION(kjpindex,nvm,nslm,nstm), INTENT(in) :: e_frac !! Fraction of water transpired supplied by individual layers (no units)
644	REAL(r_std), DIMENSION (kjpindex,nvm),INTENT(in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
645	!! Not related with the active soil carbon pool.
646	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass !! Biomass components of the model tree
647	!! within a circumference class
648	!! class @tex $(g C ind^{-1})$ @endtex
649
650
651	!! 0.2 Output variables
652
653	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
654	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! function of litter wetness
655	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag !! Relative soil moisture in each soil layer
656	!! with respect to (mcfc-mcw)
657	!! (unitless; can be out of 0-1)
658	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
659	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter approximate conductivity
660	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
661	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_melt !! Total melt
662	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: floodout !! Flux out of floodplains
663	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: tmc_pft !! Total soil water per PFT (mm/m2)
664	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: drainage_pft !! Drainage per PFT (mm/m2)
665	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: runoff_pft !! Runoff per PFT (mm/m2)
666	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: swc_pft !! Relative Soil water content [tmcr:tmcs] per pft (-)
667	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out) :: mc_out !! Soil water content (copy of mc), which is need for
668	!! the hydraulic architecture
669	REAL(r_std),DIMENSION (kjpindex,nvm,nslm,nroot_prof), INTENT(out) :: root_profile !! Normalized root mass/length fraction in each soil layer
670	!! (0-1, unitless)
671	REAL(r_std), DIMENSION (kjpindex,nvm,ndepths), INTENT(out) :: root_depth !! Node and interface numbers at which the deepest roots
672	!! occur (1 to nslm, unitless)
673
674
675
676	!! 0.3 Modified variables
677
678	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: qsintveg !! Water on vegetation due to interception
679	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
680	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(inout):: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation
681	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout):: humrel !! Relative humidity
682	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapnu !! Bare soil evaporation
683	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapsno !! Snow evaporation
684	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: vevapflo !! Floodplain evaporation
685	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: flood_res !! flood reservoir estimate
686	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow !! Snow mass [kg/m^2]
687	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: snow_age !! Snow age
688	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
689	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: snow_nobio_age !! Snow age on ice, lakes, ...
690	!! We consider that any water on the ice is snow and we only peforme a water balance to have consistency.
691	!! The water balance is limite to + or - 10^6 so that accumulation is not endless
692
693	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: runoff !! Complete surface runoff
694	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: drainage !! Drainage
695	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density (Kg/m^3)
696	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature (K)
697	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowgrain !! Snow grainsize
698	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness [m]
699	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(inout) :: snowheat !! Snow heat content
700	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(out) :: snowliq !! Snow liquid content (m)
701	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: grndflux !! Net flux into soil W/m2
702	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mc_layh !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
703	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: mcl_layh !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]
704	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT(out) :: soilmoist_out!! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
705	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: temp_sol_add !! additional surface temperature due to the melt of first layer
706	!! at the present time-step @tex ($K$) @endtex
707	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out) :: mc_layh_s !! Volumetric moisture content for each layer in hydrol(liquid + ice) [m3/m3)]
708	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out) :: mcl_layh_s !! Volumetric moisture content for each layer in hydrol(liquid) [m3/m3]/
709	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksoil !! Soil conductivity (a copy of k for each soil type) (mm/d)
710	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT(out) :: soilmoist_out_s !! Total soil moisture content for each layer in hydrol(liquid + ice) [mm]
711	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: mcs_hydrol !! Saturated volumetric water content output to be used in stomate_soilcarbon
712	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: mcfc_hydrol!! Volumetric water content at field capacity output to be used in stomate_soilcarbon
713	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(inout) :: us !! Water stress index for transpiration
714	!! (by soil layer and PFT) (0-1, unitless)
715
716
717	!! 0.4 Local variables
718
719	INTEGER(i_std) :: jst !! Index of soil tiles (unitless, 1-3)
720	INTEGER(i_std) :: jsl !! Index of soil layers (unitless)
721	INTEGER(i_std) :: ji, jv
722	REAL(r_std),DIMENSION (kjpindex) :: soilwet !! A temporary diagnostic of soil wetness
723	REAL(r_std),DIMENSION (kjpindex) :: snowdepth_diag !! Depth of snow layer containing default values, only for diagnostics
724	REAL(r_std),DIMENSION (kjpindex, nsnow) :: snowdz_diag !! Depth of snow layer on all layers containing default values,
725	!! only for diagnostics [m]
726	REAL(r_std),DIMENSION (kjpindex) :: njsc_tmp !! Temporary REAL value for njsc to write it
727	REAL(r_std), DIMENSION (kjpindex) :: snowmelt !! Snow melt [mm/dt_sechiba]
728	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmc_top !! Moisture content in the itopmax upper layers, per tile
729	REAL(r_std), DIMENSION (kjpindex) :: humtot_top !! Moisture content in the itopmax upper layers, for diagnistics
730	REAL(r_std), DIMENSION(kjpindex) :: histvar !! Temporary variable when computations are needed
731	REAL(r_std), DIMENSION (kjpindex,nvm) :: frac_bare !! Fraction(of veget_max) of bare soil in each vegetation type
732	INTEGER(i_std), DIMENSION(kjpindex*imax) :: mc_lin_axis_index
733	REAL(r_std), DIMENSION(kjpindex) :: twbr !! Grid-cell mean of TWBR Total Water Budget Residu[kg/m2/dt]
734	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_root_profile!! To ouput the grid-cell mean of nroot
735	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_dlh !! To ouput the soil layer thickness on all grid points [m]
736	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcs !! To ouput the mean of mcs
737	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcfc !! To ouput the mean of mcfc
738	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcw !! To ouput the mean of mcw
739	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_mcr !! To ouput the mean of mcr
740	REAL(r_std),DIMENSION (kjpindex) :: land_tmcs !! To ouput the grid-cell mean of tmcs
741	REAL(r_std),DIMENSION (kjpindex) :: land_tmcfc !! To ouput the grid-cell mean of tmcfc
742	REAL(r_std),DIMENSION (kjpindex) :: drain_upd !! Change in drainage due to decrease in vegtot
743	!! on mc [kg/m2/dt]
744	REAL(r_std),DIMENSION (kjpindex) :: runoff_upd !! Change in runoff due to decrease in vegtot
745	!! on water2infilt[kg/m2/dt]
746	REAL(r_std),DIMENSION (kjpindex) :: mrsow !! Soil wetness above wilting point for CMIP6 (humtot-WP)/(SAT-WP)
747	REAL(r_std), DIMENSION (kjpindex,nlut) :: humtot_lut !! Moisture content on landuse tiles, for diagnostics
748	REAL(r_std), DIMENSION (kjpindex,nlut) :: humtot_top_lut !! Moisture content in upper layers on landuse tiles, for diagnostics
749	REAL(r_std), DIMENSION (kjpindex,nlut) :: mrro_lut !! Total runoff from landuse tiles, for diagnostics
750
751	!_ ================================================================================================================================
752	!! 1. Update vegtot_old and recalculate vegtot
753	vegtot_old(:) = vegtot(:)
754
755	DO ji = 1, kjpindex
756	vegtot(ji) = SUM(veget_max(ji,:))
757	ENDDO
758
759	!! 2. Applay nudging for soil moisture and/or snow variables
760
761	! For soil moisture, here only read and interpolate the soil moisture from file to current time step.
762	! The values will be applayed in hydrol_soil after the soil moisture has been updated.
763	IF (ok_nudge_mc) THEN
764	CALL hydrol_nudge_mc_read(kjit)
765	END IF
766
767	! Read, interpolate and applay nudging of snow variables
768	IF ( ok_nudge_snow) THEN
769	CALL hydrol_nudge_snow(kjit, kjpindex, snowdz, snowrho, snowtemp )
770	END IF
771
772
773	!! 3. Shared time step
774	IF (printlev>=3) WRITE (numout,*) 'hydrol pas de temps = ',dt_sechiba
775
776	! Loop on soiltiles to compute the variables (ji,jst)
777	DO jv=1,nvm
778	tmc_pft(:,jv) = MAX(tmc(:,pref_soil_veg(jv)),tmcr(:,pref_soil_veg(jv)))
779	swc_pft(:,jv) = MIN(un, (MAX(zero, (( tmc(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)) ) &
780	/ ( tmcs(:,pref_soil_veg(jv)) - tmcr(:,pref_soil_veg(jv)))))))
781	ENDDO
782
783
784
785	!
786	!! 3.1 Calculate snow processes with explicit snow model
787	CALL explicitsnow_main(kjpindex, precip_rain, precip_snow, temp_air, pb, &
788	u, v, temp_sol_new, soilcap, pgflux, &
789	frac_nobio, totfrac_nobio,gtemp, &
790	lambda_snow, cgrnd_snow, dgrnd_snow, contfrac, &
791	vevapsno, snow_age, snow_nobio_age,snow_nobio, snowrho, &
792	snowgrain, snowdz, snowtemp, snowheat, snow, &
793	temp_sol_add, &
794	snowliq, subsnownobio, grndflux, snowmelt, tot_melt, &
795	subsinksoil)
796
797	!
798	!! 3.2 computes vegetations reservoirs ==>hydrol_vegupd
799	CALL hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
800
801
802	!
803	!! 3.3 computes canopy ==>hydrol_canop
804	CALL hydrol_canop(kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, qsintveg,precisol,tot_melt)
805
806	!
807	!! 3.4 computes surface reservoir ==>hydrol_flood
808	CALL hydrol_flood(kjpindex, vevapflo, flood_frac, flood_res, floodout)
809
810	!
811	!! 3.5 computes soil hydrology ==>hydrol_soil
812
813	CALL hydrol_soil(ks, nvan, avan, mcr, mcs, mcfc, mcw, &
814	kjpindex, veget_max, soiltile, njsc, reinf_slope, &
815	transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
816	returnflow, reinfiltration, irrigation, &
817	tot_melt,evap_bare_lim,evap_bare_lim_ns, shumdiag, shumdiag_perma, &
818	k_litt, litterhumdiag, humrel, vegstress, drysoil_frac,&
819	stempdiag,snow,snowdz, tot_bare_soil, u, v, tq_cdrag, &
820	mc_layh, mcl_layh, mc_layh_s, mcl_layh_s, e_frac, ksoil, &
821	altmax, root_profile, root_depth, circ_class_biomass, &
822	us)
823
824	! The update fluxes come from hydrol_vegupd
825	drainage(:) = drainage(:) + drain_upd(:)
826	runoff(:) = runoff(:) + runoff_upd(:)
827
828	DO jv=1,nvm
829	drainage_pft(:,jv) = dr_ns(:,pref_soil_veg(jv))
830	runoff_pft(:,jv) = ru_ns(:,pref_soil_veg(jv))
831	ENDDO
832
833	!! 12.10 Copy mc to mc_out to return from hydrol_main. It's needed in hydrolaulic_arch, when we do not use
834	!! soil to root resistance
835	mc_out(:,:,:) = mc(:,:,:)
836
837	!! 4 write out file ==> hydrol_alma/histwrite(*)
838	!
839	! If we use the ALMA standards
840	CALL hydrol_alma(kjpindex, index, .FALSE., qsintveg, snow, snow_nobio, soilwet)
841
842
843	! Calculate the moisture in the upper itopmax layers corresponding to 0.1m (humtot_top):
844	! For ORCHIDEE with nslm=11 and zmaxh=2, itopmax=6.
845	! We compute tmc_top as tmc but only for the first itopmax layers. Then we compute a humtot with this variable.
846	DO jst=1,nstm
847	DO ji=1,kjpindex
848	tmc_top(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
849	DO jsl = 2, itopmax
850	tmc_top(ji,jst) = tmc_top(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
851	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
852	ENDDO
853	ENDDO
854	ENDDO
855
856	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
857	humtot_top(:) = zero
858	DO jst=1,nstm
859	DO ji=1,kjpindex
860	humtot_top(ji) = humtot_top(ji) + soiltile(ji,jst) * tmc_top(ji,jst) * vegtot(ji)
861	ENDDO
862	ENDDO
863
864	! Calculate the Total Water Budget Residu (in kg/m2 over dt_sechiba)
865	! All the delstocks and fluxes below are averaged over the mesh
866	! snow_nobio included in delswe
867	! Does not include the routing reservoirs, although the flux to/from routing are integrated
868	DO ji=1,kjpindex
869	twbr(ji) = (delsoilmoist(ji) + delintercept(ji) + delswe(ji)) &
870	- ( precip_rain(ji) + precip_snow(ji) + irrigation(ji) + floodout(ji) &
871	+ returnflow(ji) + reinfiltration(ji) ) &
872	+ ( runoff(ji) + drainage(ji) + SUM(vevapwet(ji,:)) &
873	+ SUM(transpir(ji,:)) + vevapnu(ji) + vevapsno(ji) + vevapflo(ji) )
874	ENDDO
875
876	! Transform unit from kg/m2/dt to kg/m2/s (or mm/s)
877	CALL xios_orchidee_send_field("twbr",twbr/dt_sechiba)
878	CALL xios_orchidee_send_field("undermcr",undermcr) ! nb of tiles undermcr at end of timestep
879
880	! Calculate land_root_profile : grid-cell mean of the structural root_profile
881	! Do not treat PFT1 because it has no roots
882	land_root_profile(:,:) = zero
883	DO jsl=1,nslm
884	DO jv=2,nvm
885	DO ji=1,kjpindex
886	IF ( vegtot(ji) > min_sechiba ) THEN
887	land_root_profile(ji,jsl) = land_root_profile(ji,jsl) + veget_max(ji,jv) * root_profile(ji,jv,jsl,istruc) / vegtot(ji)
888	END IF
889	END DO
890	ENDDO
891	ENDDO
892
893	CALL xios_orchidee_send_field("land_root_profile",land_root_profile)
894
895	DO jsl=1,nslm
896	land_dlh(:,jsl)=dlh(jsl)
897	ENDDO
898	CALL xios_orchidee_send_field("dlh",land_dlh)
899
900	! Particular soil moisture values, spatially averaged over the grid-cell
901	! (a) total SM in kg/m2
902	! we average the total values of each soiltile and multiply by vegtot to transform to a grid-cell mean (over total land)
903	land_tmcs(:) = zero
904	land_tmcfc(:) = zero
905	DO jst=1,nstm
906	DO ji=1,kjpindex
907	land_tmcs(ji) = land_tmcs(ji) + soiltile(ji,jst) * tmcs(ji,jst) * vegtot(ji)
908	land_tmcfc(ji) = land_tmcfc(ji) + soiltile(ji,jst) * tmcfc(ji,jst) * vegtot(ji)
909	ENDDO
910	ENDDO
911	CALL xios_orchidee_send_field("tmcs",land_tmcs) ! in kg/m2
912	CALL xios_orchidee_send_field("tmcfc",land_tmcfc) ! in kg/m2
913
914	! (b) volumetric moisture content by layers in m3/m3
915	! mcs etc are identical in all layers (no normalization by vegtot to be comparable to mc)
916	DO jsl=1,nslm
917	land_mcs(:,jsl) = mcs(:)
918	land_mcfc(:,jsl) = mcfc(:)
919	land_mcw(:,jsl) = mcw(:)
920	land_mcr(:,jsl) = mcr(:)
921	ENDDO
922	CALL xios_orchidee_send_field("mcs",land_mcs) ! in m3/m3
923	CALL xios_orchidee_send_field("mcfc",land_mcfc) ! in m3/m3
924	CALL xios_orchidee_send_field("mcw",land_mcw) ! in m3/m3
925	CALL xios_orchidee_send_field("mcr",land_mcr) ! in m3/m3
926
927	CALL xios_orchidee_send_field("water2infilt",water2infilt)
928	CALL xios_orchidee_send_field("mc",mc)
929	CALL xios_orchidee_send_field("kfact_root",kfact_root)
930	CALL xios_orchidee_send_field("rootsink",rootsink)
931	CALL xios_orchidee_send_field("vegetmax_soil",vegetmax_soil)
932	CALL xios_orchidee_send_field("evapnu_soil",ae_ns/dt_sechiba)
933	CALL xios_orchidee_send_field("drainage_soil",dr_ns/dt_sechiba)
934	CALL xios_orchidee_send_field("transpir_soil",tr_ns/dt_sechiba)
935	CALL xios_orchidee_send_field("runoff_soil",ru_ns/dt_sechiba)
936	CALL xios_orchidee_send_field("humrel",humrel)
937	CALL xios_orchidee_send_field("drainage",drainage/dt_sechiba) ! [kg m-2 s-1]
938	CALL xios_orchidee_send_field("runoff",runoff/dt_sechiba) ! [kg m-2 s-1]
939	CALL xios_orchidee_send_field("precisol",precisol/dt_sechiba)
940	CALL xios_orchidee_send_field("throughfall",throughfall/dt_sechiba)
941	CALL xios_orchidee_send_field("precip_rain",precip_rain/dt_sechiba)
942	CALL xios_orchidee_send_field("precip_snow",precip_snow/dt_sechiba)
943	CALL xios_orchidee_send_field("qsintmax",qsintmax)
944	CALL xios_orchidee_send_field("qsintveg",qsintveg)
945	CALL xios_orchidee_send_field("qsintveg_tot",SUM(qsintveg(:,:),dim=2))
946	histvar(:)=(precip_rain(:)-SUM(throughfall(:,:),dim=2))
947	CALL xios_orchidee_send_field("prveg",histvar/dt_sechiba)
948
949	IF ( do_floodplains ) THEN
950	CALL xios_orchidee_send_field("floodout",floodout/dt_sechiba)
951	END IF
952
953	CALL xios_orchidee_send_field("snowmelt",snowmelt/dt_sechiba)
954	CALL xios_orchidee_send_field("tot_melt",tot_melt/dt_sechiba)
955
956	CALL xios_orchidee_send_field("soilmoist",soilmoist)
957	CALL xios_orchidee_send_field("soilmoist_liquid",soilmoist_liquid)
958	CALL xios_orchidee_send_field("shumdiag_perma",shumdiag_perma)
959	CALL xios_orchidee_send_field("humtot_frozen",SUM(soilmoist(:,:),2)-SUM(soilmoist_liquid(:,:),2))
960	CALL xios_orchidee_send_field("tmc",tmc)
961	CALL xios_orchidee_send_field("humtot",humtot)
962	CALL xios_orchidee_send_field("humtot_top",humtot_top)
963
964	! For the soil wetness above wilting point for CMIP6 (mrsow)
965	mrsow(:) = MAX( zero,humtot(:) - zmaxhmillemcw(:) ) &
966	/ ( zmaxhmille( mcs(:) - mcw(:) ) )
967	CALL xios_orchidee_send_field("mrsow",mrsow)
968
969
970
971	! Prepare diagnostic snow variables
972	! Add XIOS default value where no snow
973	DO ji=1,kjpindex
974	IF (snow(ji) > 0) THEN
975	snowdz_diag(ji,:) = snowdz(ji,:)
976	snowdepth_diag(ji) = SUM(snowdz(ji,:))(1-totfrac_nobio(ji))frac_snow_veg(ji)
977	ELSE
978	snowdz_diag(ji,:) = xios_default_val
979	snowdepth_diag(ji) = xios_default_val
980	END IF
981	END DO
982	CALL xios_orchidee_send_field("snowdz",snowdz_diag)
983	CALL xios_orchidee_send_field("snowdepth",snowdepth_diag)
984
985	CALL xios_orchidee_send_field("frac_bare",frac_bare)
986	CALL xios_orchidee_send_field("soilwet",soilwet)
987	CALL xios_orchidee_send_field("delsoilmoist",delsoilmoist)
988	CALL xios_orchidee_send_field("delswe",delswe)
989	CALL xios_orchidee_send_field("delintercept",delintercept)
990
991	IF (ok_freeze_cwrr) THEN
992	CALL xios_orchidee_send_field("profil_froz_hydro",profil_froz_hydro)
993	END IF
994	CALL xios_orchidee_send_field("profil_froz_hydro_ns", profil_froz_hydro_ns)
995	CALL xios_orchidee_send_field("kk_moy",kk_moy) ! in mm/d
996
997	!! Calculate diagnostic variables on Landuse tiles for LUMIP/CMIP6
998	humtot_lut(:,:)=0
999	humtot_top_lut(:,:)=0
1000	mrro_lut(:,:)=0
1001	DO jv=1,nvm
1002	jst=pref_soil_veg(jv) ! soil tile index
1003	IF (natural(jv)) THEN
1004	humtot_lut(:,id_psl) = humtot_lut(:,id_psl) + tmc(:,jst)*veget_max(:,jv)
1005	humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl) + tmc_top(:,jst)*veget_max(:,jv)
1006	mrro_lut(:,id_psl) = mrro_lut(:,id_psl) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
1007	ELSE
1008	humtot_lut(:,id_crp) = humtot_lut(:,id_crp) + tmc(:,jst)*veget_max(:,jv)
1009	humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp) + tmc_top(:,jst)*veget_max(:,jv)
1010	mrro_lut(:,id_crp) = mrro_lut(:,id_crp) + (dr_ns(:,jst)+ru_ns(:,jst))*veget_max(:,jv)
1011	ENDIF
1012	END DO
1013
1014	WHERE (fraclut(:,id_psl)>min_sechiba)
1015	humtot_lut(:,id_psl) = humtot_lut(:,id_psl)/fraclut(:,id_psl)
1016	humtot_top_lut(:,id_psl) = humtot_top_lut(:,id_psl)/fraclut(:,id_psl)
1017	mrro_lut(:,id_psl) = mrro_lut(:,id_psl)/fraclut(:,id_psl)/dt_sechiba
1018	ELSEWHERE
1019	humtot_lut(:,id_psl) = val_exp
1020	humtot_top_lut(:,id_psl) = val_exp
1021	mrro_lut(:,id_psl) = val_exp
1022	END WHERE
1023	WHERE (fraclut(:,id_crp)>min_sechiba)
1024	humtot_lut(:,id_crp) = humtot_lut(:,id_crp)/fraclut(:,id_crp)
1025	humtot_top_lut(:,id_crp) = humtot_top_lut(:,id_crp)/fraclut(:,id_crp)
1026	mrro_lut(:,id_crp) = mrro_lut(:,id_crp)/fraclut(:,id_crp)/dt_sechiba
1027	ELSEWHERE
1028	humtot_lut(:,id_crp) = val_exp
1029	humtot_top_lut(:,id_crp) = val_exp
1030	mrro_lut(:,id_crp) = val_exp
1031	END WHERE
1032
1033	humtot_lut(:,id_pst) = val_exp
1034	humtot_lut(:,id_urb) = val_exp
1035	humtot_top_lut(:,id_pst) = val_exp
1036	humtot_top_lut(:,id_urb) = val_exp
1037	mrro_lut(:,id_pst) = val_exp
1038	mrro_lut(:,id_urb) = val_exp
1039
1040	CALL xios_orchidee_send_field("humtot_lut",humtot_lut)
1041	CALL xios_orchidee_send_field("humtot_top_lut",humtot_top_lut)
1042	CALL xios_orchidee_send_field("mrro_lut",mrro_lut)
1043
1044	! Write diagnistic for soil moisture nudging
1045	IF (ok_nudge_mc) CALL hydrol_nudge_mc_diag(kjpindex, soiltile)
1046
1047
1048	IF ( .NOT. almaoutput ) THEN
1049	CALL histwrite_p(hist_id, 'frac_bare', kjit, frac_bare, kjpindex*nvm, indexveg)
1050
1051	CALL histwrite_p(hist_id, 'moistc', kjit,mc, kjpindexnslmnstm, indexlayer)
1052	CALL histwrite_p(hist_id, 'kfactroot', kjit, kfact_root, kjpindexnslmnstm, indexlayer)
1053	CALL histwrite_p(hist_id, 'vegetsoil', kjit,vegetmax_soil, kjpindexnvmnstm, indexveg)
1054	CALL histwrite_p(hist_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
1055	CALL histwrite_p(hist_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
1056	CALL histwrite_p(hist_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
1057	CALL histwrite_p(hist_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
1058	CALL histwrite_p(hist_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
1059	! mrso is a perfect duplicate of humtot
1060	CALL histwrite_p(hist_id, 'humtot', kjit, humtot, kjpindex, index)
1061	CALL histwrite_p(hist_id, 'mrso', kjit, humtot, kjpindex, index)
1062	CALL histwrite_p(hist_id, 'mrsos', kjit, humtot_top, kjpindex, index)
1063	njsc_tmp(:)=njsc(:)
1064	CALL histwrite_p(hist_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
1065	CALL histwrite_p(hist_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
1066	CALL histwrite_p(hist_id, 'drainage', kjit, drainage, kjpindex, index)
1067	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
1068	CALL histwrite_p(hist_id, 'runoff', kjit, runoff, kjpindex, index)
1069	CALL histwrite_p(hist_id, 'mrros', kjit, runoff, kjpindex, index)
1070	histvar(:)=(runoff(:)+drainage(:))
1071	CALL histwrite_p(hist_id, 'mrro', kjit, histvar, kjpindex, index)
1072	CALL histwrite_p(hist_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
1073	CALL histwrite_p(hist_id, 'rain', kjit, precip_rain, kjpindex, index)
1074
1075	histvar(:)=(precip_rain(:)-SUM(throughfall(:,:),dim=2))
1076	CALL histwrite_p(hist_id, 'prveg', kjit, histvar, kjpindex, index)
1077
1078	CALL histwrite_p(hist_id, 'snowf', kjit, precip_snow, kjpindex, index)
1079	CALL histwrite_p(hist_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
1080	CALL histwrite_p(hist_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
1081	CALL histwrite_p(hist_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
1082	CALL histwrite_p(hist_id, 'shumdiag_perma',kjit,shumdiag_perma,kjpindex*nslm,indexnslm)
1083
1084	IF ( do_floodplains ) THEN
1085	CALL histwrite_p(hist_id, 'floodout', kjit, floodout, kjpindex, index)
1086	ENDIF
1087	!
1088	IF ( hist2_id > 0 ) THEN
1089	CALL histwrite_p(hist2_id, 'moistc', kjit,mc, kjpindexnslmnstm, indexlayer)
1090	CALL histwrite_p(hist2_id, 'kfactroot', kjit, kfact_root, kjpindexnslmnstm, indexlayer)
1091	CALL histwrite_p(hist2_id, 'vegetsoil', kjit,vegetmax_soil, kjpindexnvmnstm, indexveg)
1092	CALL histwrite_p(hist2_id, 'evapnu_soil', kjit, ae_ns, kjpindex*nstm, indexsoil)
1093	CALL histwrite_p(hist2_id, 'drainage_soil', kjit, dr_ns, kjpindex*nstm, indexsoil)
1094	CALL histwrite_p(hist2_id, 'transpir_soil', kjit, tr_ns, kjpindex*nstm, indexsoil)
1095	CALL histwrite_p(hist2_id, 'runoff_soil', kjit, ru_ns, kjpindex*nstm, indexsoil)
1096	CALL histwrite_p(hist2_id, 'humtot_soil', kjit, tmc, kjpindex*nstm, indexsoil)
1097	! mrso is a perfect duplicate of humtot
1098	CALL histwrite_p(hist2_id, 'humtot', kjit, humtot, kjpindex, index)
1099	CALL histwrite_p(hist2_id, 'mrso', kjit, humtot, kjpindex, index)
1100	CALL histwrite_p(hist2_id, 'mrsos', kjit, humtot_top, kjpindex, index)
1101	njsc_tmp(:)=njsc(:)
1102	CALL histwrite_p(hist2_id, 'soilindex', kjit, njsc_tmp, kjpindex, index)
1103	CALL histwrite_p(hist2_id, 'humrel', kjit, humrel, kjpindex*nvm, indexveg)
1104	CALL histwrite_p(hist2_id, 'drainage', kjit, drainage, kjpindex, index)
1105	! NB! According to histdef in intersurf, the variables 'runoff' and 'mrros' have different units
1106	CALL histwrite_p(hist2_id, 'runoff', kjit, runoff, kjpindex, index)
1107	CALL histwrite_p(hist2_id, 'mrros', kjit, runoff, kjpindex, index)
1108	histvar(:)=(runoff(:)+drainage(:))
1109	CALL histwrite_p(hist2_id, 'mrro', kjit, histvar, kjpindex, index)
1110
1111	IF ( do_floodplains ) THEN
1112	CALL histwrite_p(hist2_id, 'floodout', kjit, floodout, kjpindex, index)
1113	ENDIF
1114	CALL histwrite_p(hist2_id, 'precisol', kjit, precisol, kjpindex*nvm, indexveg)
1115	CALL histwrite_p(hist2_id, 'rain', kjit, precip_rain, kjpindex, index)
1116	CALL histwrite_p(hist2_id, 'snowf', kjit, precip_snow, kjpindex, index)
1117	CALL histwrite_p(hist2_id, 'snowmelt',kjit,snowmelt,kjpindex,index)
1118	CALL histwrite_p(hist2_id, 'qsintmax', kjit, qsintmax, kjpindex*nvm, indexveg)
1119	CALL histwrite_p(hist2_id, 'qsintveg', kjit, qsintveg, kjpindex*nvm, indexveg)
1120	ENDIF
1121	ELSE
1122	CALL histwrite_p(hist_id, 'Snowf', kjit, precip_snow, kjpindex, index)
1123	CALL histwrite_p(hist_id, 'Rainf', kjit, precip_rain, kjpindex, index)
1124	CALL histwrite_p(hist_id, 'Qs', kjit, runoff, kjpindex, index)
1125	CALL histwrite_p(hist_id, 'Qsb', kjit, drainage, kjpindex, index)
1126	CALL histwrite_p(hist_id, 'Qsm', kjit, snowmelt, kjpindex, index)
1127	CALL histwrite_p(hist_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
1128	CALL histwrite_p(hist_id, 'DelSWE', kjit, delswe, kjpindex, index)
1129	CALL histwrite_p(hist_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
1130	!
1131	CALL histwrite_p(hist_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
1132	CALL histwrite_p(hist_id, 'SoilWet', kjit, soilwet, kjpindex, index)
1133	!
1134	CALL histwrite_p(hist_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
1135	CALL histwrite_p(hist_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
1136
1137	IF ( hist2_id > 0 ) THEN
1138	CALL histwrite_p(hist2_id, 'Snowf', kjit, precip_snow, kjpindex, index)
1139	CALL histwrite_p(hist2_id, 'Rainf', kjit, precip_rain, kjpindex, index)
1140	CALL histwrite_p(hist2_id, 'Qs', kjit, runoff, kjpindex, index)
1141	CALL histwrite_p(hist2_id, 'Qsb', kjit, drainage, kjpindex, index)
1142	CALL histwrite_p(hist2_id, 'Qsm', kjit, snowmelt, kjpindex, index)
1143	CALL histwrite_p(hist2_id, 'DelSoilMoist', kjit, delsoilmoist, kjpindex, index)
1144	CALL histwrite_p(hist2_id, 'DelSWE', kjit, delswe, kjpindex, index)
1145	CALL histwrite_p(hist2_id, 'DelIntercept', kjit, delintercept, kjpindex, index)
1146	!
1147	CALL histwrite_p(hist2_id, 'SoilMoist', kjit, soilmoist, kjpindex*nslm, indexlayer)
1148	CALL histwrite_p(hist2_id, 'SoilWet', kjit, soilwet, kjpindex, index)
1149	!
1150	CALL histwrite_p(hist2_id, 'RootMoist', kjit, tot_watsoil_end, kjpindex, index)
1151	CALL histwrite_p(hist2_id, 'SubSnow', kjit, vevapsno, kjpindex, index)
1152	ENDIF
1153	ENDIF
1154
1155	IF (ok_freeze_cwrr) THEN
1156	CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit,profil_froz_hydro , kjpindex*nslm, indexlayer)
1157	ENDIF
1158	CALL histwrite_p(hist_id, 'kk_moy', kjit, kk_moy,kjpindex*nslm, indexlayer) ! averaged over soiltiles
1159	CALL histwrite_p(hist_id, 'profil_froz_hydro', kjit, profil_froz_hydro_ns, kjpindexnslmnstm, indexlayer)
1160
1161	! Copy soilmoist into a local variable to be sent to thermosoil
1162	soilmoist_out(:,:) = soilmoist(:,:)
1163	soilmoist_out_s(:,:,:) = soilmoist_s(:,:,:)
1164	! Copy mcs and mcfc into local variables to be sent to stomate_soilcarbon
1165	mcs_hydrol(:) = mcs(:)
1166	mcfc_hydrol(:) = mcfc(:)
1167
1168	IF (printlev>=3) WRITE (numout,*) ' hydrol_main Done '
1169
1170	END SUBROUTINE hydrol_main
1171
1172
1173	!! ================================================================================================================================
1174	!! SUBROUTINE : hydrol_finalize
1175	!!
1176	!>\BRIEF
1177	!!
1178	!! DESCRIPTION : This subroutine writes the module variables and variables calculated in hydrol to restart file
1179	!!
1180	!! MAIN OUTPUT VARIABLE(S) :
1181	!!
1182	!! REFERENCE(S) :
1183	!!
1184	!! FLOWCHART : None
1185	!! \n
1186	!_ ================================================================================================================================
1187
1188	SUBROUTINE hydrol_finalize( kjit, kjpindex, rest_id, vegstress, &
1189	qsintveg, humrel, snow, snow_age, snow_nobio, &
1190	snow_nobio_age, snowrho, snowtemp, snowdz, &
1191	snowheat, snowgrain, &
1192	drysoil_frac, evap_bare_lim, evap_bare_lim_ns, &
1193	mc_out, ksoil, root_profile, us)
1194
1195	!! 0. Variable and parameter declaration
1196	!! 0.1 Input variables
1197	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
1198	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
1199	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
1200	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1201	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
1202	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: humrel
1203	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
1204	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow_age !! Snow age
1205	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
1206	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio_age !! Snow age on ice, lakes, ...
1207	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowrho !! Snow density (Kg/m^3)
1208	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowtemp !! Snow temperature (K)
1209	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowdz !! Snow layer thickness [m]
1210	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowheat !! Snow heat content
1211	REAL(r_std), DIMENSION (kjpindex,nsnow), INTENT(in) :: snowgrain !! Snow grainsize
1212	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: drysoil_frac !! function of litter wetness
1213	REAL(r_std),DIMENSION (kjpindex),INTENT(in) :: evap_bare_lim
1214	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(in) :: evap_bare_lim_ns
1215	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (in) :: mc_out
1216	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (in) :: ksoil
1217	REAL(r_std),DIMENSION (kjpindex,nvm,nslm,nroot_prof), INTENT(in) :: root_profile !! Normalized root mass/length fraction in each soil layer
1218	!! (0-1, unitless)
1219	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(in) :: us !! Water stress index for transpiration
1220	!! (by soil layer and PFT) (0-1, unitless)
1221
1222	!! 0.4 Local variables
1223	INTEGER(i_std) :: jst, jsl
1224
1225	!_ ================================================================================================================================
1226
1227
1228	IF (printlev>=3) WRITE (numout,*) 'Write restart file with HYDROLOGIC variables '
1229
1230	CALL restput_p(rest_id, 'moistc', nbp_glo, nslm, nstm, kjit, mc, 'scatter', nbp_glo, index_g)
1231	!-
1232	CALL restput_p(rest_id, 'moistcl', nbp_glo, nslm, nstm, kjit, mcl, 'scatter', nbp_glo, index_g)
1233	!-
1234	IF (ok_nudge_mc) THEN
1235	CALL restput_p(rest_id, 'mc_read_next', nbp_glo, nslm, nstm, kjit, mc_read_next, 'scatter', nbp_glo, index_g)
1236	END IF
1237
1238	IF (ok_nudge_snow) THEN
1239	CALL restput_p(rest_id, 'snowdz_read_next', nbp_glo, nsnow, 1, kjit, snowdz_read_next(:,:), &
1240	'scatter', nbp_glo, index_g)
1241	!-
1242	CALL restput_p(rest_id, 'snowrho_read_next', nbp_glo, nsnow, 1, kjit, snowrho_read_next(:,:), &
1243	'scatter', nbp_glo, index_g)
1244	!-
1245	CALL restput_p(rest_id, 'snowtemp_read_next', nbp_glo, nsnow, 1, kjit, snowtemp_read_next(:,:), &
1246	'scatter', nbp_glo, index_g)
1247	END IF
1248
1249	CALL restput_p(rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, us,'scatter',nbp_glo,index_g)
1250	!-
1251	CALL restput_p(rest_id, 'free_drain_coef', nbp_glo, nstm, 1, kjit, free_drain_coef, 'scatter', nbp_glo, index_g)
1252	!-
1253	CALL restput_p(rest_id, 'zwt_force', nbp_glo, nstm, 1, kjit, zwt_force, 'scatter', nbp_glo, index_g)
1254	!-
1255	CALL restput_p(rest_id, 'water2infilt', nbp_glo, nstm, 1, kjit, water2infilt, 'scatter', nbp_glo, index_g)
1256	!-
1257	CALL restput_p(rest_id, 'ae_ns', nbp_glo, nstm, 1, kjit, ae_ns, 'scatter', nbp_glo, index_g)
1258	!-
1259	CALL restput_p(rest_id, 'vegstress', nbp_glo, nvm, 1, kjit, vegstress, 'scatter', nbp_glo, index_g)
1260	!-
1261	CALL restput_p(rest_id, 'snow', nbp_glo, 1, 1, kjit, snow, 'scatter', nbp_glo, index_g)
1262	!-
1263	CALL restput_p(rest_id, 'snow_age', nbp_glo, 1, 1, kjit, snow_age, 'scatter', nbp_glo, index_g)
1264	!-
1265	CALL restput_p(rest_id, 'snow_nobio', nbp_glo, nnobio, 1, kjit, snow_nobio, 'scatter', nbp_glo, index_g)
1266	!-
1267	CALL restput_p(rest_id, 'snow_nobio_age', nbp_glo, nnobio, 1, kjit, snow_nobio_age, 'scatter', nbp_glo, index_g)
1268	!-
1269	CALL restput_p(rest_id, 'qsintveg', nbp_glo, nvm, 1, kjit, qsintveg, 'scatter', nbp_glo, index_g)
1270	!-
1271	CALL restput_p(rest_id, 'evap_bare_lim_ns', nbp_glo, nstm, 1, kjit, evap_bare_lim_ns, 'scatter', nbp_glo, index_g)
1272	!-
1273	CALL restput_p(rest_id, 'evap_bare_lim', nbp_glo, 1, 1, kjit, evap_bare_lim, 'scatter', nbp_glo, index_g)
1274	!-
1275	CALL restput_p(rest_id, 'root_profile_struc', nbp_glo, nvm, nslm, kjit, root_profile(:,:,:,istruc), 'scatter', nbp_glo, index_g)
1276	!-
1277	CALL restput_p(rest_id, 'root_profile_func', nbp_glo, nvm, nslm, kjit, root_profile(:,:,:,ifunc), 'scatter', nbp_glo, index_g)
1278	!-
1279	CALL restput_p(rest_id, 'resdist', nbp_glo, nstm, 1, kjit, resdist, 'scatter', nbp_glo, index_g)
1280	!-
1281	CALL restput_p(rest_id, 'vegtot_old', nbp_glo, 1, 1, kjit, vegtot_old, 'scatter', nbp_glo, index_g)
1282	!-
1283	CALL restput_p(rest_id, 'drysoil_frac', nbp_glo, 1, 1, kjit, drysoil_frac, 'scatter', nbp_glo, index_g)
1284	!-
1285	CALL restput_p(rest_id, 'humrel', nbp_glo, nvm, 1, kjit, humrel, 'scatter', nbp_glo, index_g)
1286	!-
1287	CALL restput_p(rest_id, 'tot_watveg_beg', nbp_glo, 1, 1, kjit, tot_watveg_beg, 'scatter', nbp_glo, index_g)
1288	!-
1289	CALL restput_p(rest_id, 'tot_watsoil_beg', nbp_glo, 1, 1, kjit, tot_watsoil_beg, 'scatter', nbp_glo, index_g)
1290	!-
1291	CALL restput_p(rest_id, 'snow_beg', nbp_glo, 1, 1, kjit, snow_beg, 'scatter', nbp_glo, index_g)
1292	!-
1293	IF(ok_hydrol_arch)THEN
1294	CALL restput_p(rest_id, 'mc_out', nbp_glo, nslm, nstm, kjit, mc_out, 'scatter', nbp_glo, index_g)
1295	!-
1296	CALL restput_p(rest_id, 'ksoil', nbp_glo, nslm, nstm, kjit, ksoil, 'scatter', nbp_glo, index_g)
1297	ENDIF
1298
1299	! Write variables for explictsnow module to restart file
1300	CALL explicitsnow_finalize ( kjit, kjpindex, rest_id, snowrho, &
1301	snowtemp, snowdz, snowheat, snowgrain)
1302
1303	END SUBROUTINE hydrol_finalize
1304
1305
1306	!! ================================================================================================================================
1307	!! SUBROUTINE : hydrol_init
1308	!!
1309	!>\BRIEF Initializations and memory allocation
1310	!!
1311	!! DESCRIPTION :
1312	!! - 1 Some initializations
1313	!! - 2 make dynamic allocation with good dimension
1314	!! - 2.1 array allocation for soil textur
1315	!! - 2.2 Soil texture choice
1316	!! - 3 Other array allocation
1317	!! - 4 Open restart input file and read data for HYDROLOGIC process
1318	!! - 5 get restart values if none were found in the restart file
1319	!! - 6 Vegetation array
1320	!! - 7 set humrelv from us
1321	!!
1322	!! RECENT CHANGE(S) : None
1323	!!
1324	!! MAIN OUTPUT VARIABLE(S) :
1325	!!
1326	!! REFERENCE(S) :
1327	!!
1328	!! FLOWCHART : None
1329	!! \n
1330	!_ ================================================================================================================================
1331	!!_ hydrol_init
1332
1333	SUBROUTINE hydrol_init(ks, nvan, avan, mcr, mcs, mcfc, mcw, njsc, &
1334	kjit, kjpindex, index, rest_id, veget_max, soiltile, &
1335	humrel, vegstress, snow, snow_age, snow_nobio, snow_nobio_age, qsintveg, &
1336	snowdz, snowgrain, snowrho, snowtemp, snowheat, &
1337	drysoil_frac, evap_bare_lim, evap_bare_lim_ns, mc_out, ksoil, root_profile, &
1338	us)
1339
1340
1341	!! 0. Variable and parameter declaration
1342
1343	!! 0.1 Input variables
1344	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
1345	INTEGER(i_std), INTENT (in) :: kjit !! Time step number
1346	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
1347	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
1348	INTEGER(i_std), INTENT (in) :: rest_id !! _Restart_ file identifier
1349	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Carte de vegetation max
1350	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
1351	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
1352	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
1353	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
1354	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
1355	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
1356	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
1357	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
1358
1359	!! 0.2 Output variables
1360
1361	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Stress hydrique, relative humidity
1362	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
1363	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow !! Snow mass [Kg/m^2]
1364	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: snow_age !! Snow age
1365	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio !! Snow on ice, lakes, ...
1366	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: snow_nobio_age !! Snow age on ice, lakes, ...
1367	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintveg !! Water on vegetation due to interception
1368	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowdz !! Snow depth [m]
1369	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowgrain !! Snow grain size
1370	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowheat !! Snow heat content
1371	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowtemp !! Snow temperature (K)
1372	REAL(r_std),DIMENSION (kjpindex,nsnow),INTENT(out) :: snowrho !! Snow density (Kg/m^3)
1373	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: drysoil_frac !! function of litter wetness
1374	REAL(r_std),DIMENSION (kjpindex),INTENT(out) :: evap_bare_lim
1375	REAL(r_std),DIMENSION (kjpindex,nstm),INTENT(out) :: evap_bare_lim_ns
1376	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mc_out
1377	REAL(r_std),DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: ksoil
1378	REAL(r_std),DIMENSION (kjpindex,nvm,nslm,nroot_prof), INTENT(out) :: root_profile !! Normalized root mass/length fraction in each soil layer
1379	!! (0-1, unitless)
1380	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT (out) :: us !! Water stress index for transpiration
1381	!! (by soil layer and PFT) (0-1, unitless)
1382	!! 0.4 Local variables
1383
1384	INTEGER(i_std) :: ier !! Error code
1385	INTEGER(i_std) :: ji !! Index of land grid cells (1)
1386	INTEGER(i_std) :: jv !! Index of PFTs (1)
1387	INTEGER(i_std) :: jst !! Index of soil tiles (1)
1388	INTEGER(i_std) :: jsl !! Index of soil layers (1)
1389	INTEGER(i_std) :: jsc !! Index of soil texture (1)
1390	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
1391	!! Switch to 2 tu turn fatal errors into warnings
1392	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: free_drain_max !! Temporary var for initialization of free_drain_coef
1393	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: zwt_default !! Temporary variable for initialization of zwt_force
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 =
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 = 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 = 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 = 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 =
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	do_rsoil = .TRUE.
1449	CALL getin_p('DO_RSOIL', do_rsoil)
1450
1451	!! 2 make dynamic allocation with good dimension
1452
1453	!! 2.1 array allocation for soil texture
1454
1455	ALLOCATE (pcent(nscm),stat=ier)
1456	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable pcent','','')
1457
1458	ALLOCATE (mc_awet(nscm),stat=ier)
1459	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_awet','','')
1460
1461	ALLOCATE (mc_adry(nscm),stat=ier)
1462	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_adry','','')
1463
1464
1465	!! 2.2 Soil texture parameters
1466
1467	pcent(:) = pcent_usda(:)
1468	mc_awet(:) = mc_awet_usda(:)
1469	mc_adry(:) = mc_adry_usda(:)
1470
1471
1472	!! 2.3 Read in the run.def the parameters values defined by the user
1473
1474	!Config Key = WETNESS_TRANSPIR_MAX
1475	!Config Desc = Soil moisture above which transpir is max, for each soil texture class
1476	!Config If =
1477	!Config Def = 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8, 0.8
1478	!Config Help = This parameter is independent from soil texture for
1479	!Config the time being.
1480	!Config Units = [-]
1481	CALL getin_p("WETNESS_TRANSPIR_MAX",pcent)
1482
1483	!! Check parameter value (correct range)
1484	IF ( ANY(pcent(:) <= zero) .OR. ANY(pcent(:) > 1.) ) THEN
1485	CALL ipslerr_p(error_level, "hydrol_init.", &
1486	& "Wrong parameter value for WETNESS_TRANSPIR_MAX.", &
1487	& "This parameter should be positive and less or equals than 1. ", &
1488	& "Please, check parameter value in run.def. ")
1489	END IF
1490
1491
1492	!Config Key = VWC_MIN_FOR_WET_ALB
1493	!Config Desc = Vol. wat. cont. above which albedo is cst
1494	!Config If =
1495	!Config Def = 0.25, 0.25, 0.25
1496	!Config Help = This parameter is independent from soil texture for
1497	!Config the time being.
1498	!Config Units = [m3/m3]
1499	CALL getin_p("VWC_MIN_FOR_WET_ALB",mc_awet)
1500
1501	!! Check parameter value (correct range)
1502	IF ( ANY(mc_awet(:) < 0) ) THEN
1503	CALL ipslerr_p(error_level, "hydrol_init.", &
1504	& "Wrong parameter value for VWC_MIN_FOR_WET_ALB.", &
1505	& "This parameter should be positive. ", &
1506	& "Please, check parameter value in run.def. ")
1507	END IF
1508
1509
1510	!Config Key = VWC_MAX_FOR_DRY_ALB
1511	!Config Desc = Vol. wat. cont. below which albedo is cst
1512	!Config If =
1513	!Config Def = 0.1, 0.1, 0.1
1514	!Config Help = This parameter is independent from soil texture for
1515	!Config the time being.
1516	!Config Units = [m3/m3]
1517	CALL getin_p("VWC_MAX_FOR_DRY_ALB",mc_adry)
1518
1519	!! Check parameter value (correct range)
1520	IF ( ANY(mc_adry(:) < 0) .OR. ANY(mc_adry(:) > mc_awet(:)) ) THEN
1521	CALL ipslerr_p(error_level, "hydrol_init.", &
1522	& "Wrong parameter value for VWC_MAX_FOR_DRY_ALB.", &
1523	& "This parameter should be positive and not greater than VWC_MIN_FOR_WET_ALB.", &
1524	& "Please, check parameter value in run.def. ")
1525	END IF
1526
1527
1528	!! 3 Other array allocation
1529
1530	ALLOCATE (mask_veget(kjpindex,nvm),stat=ier)
1531	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_veget','','')
1532
1533	ALLOCATE (mask_soiltile(kjpindex,nstm),stat=ier)
1534	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_soiltile','','')
1535
1536	ALLOCATE (humrelv(kjpindex,nvm,nstm),stat=ier)
1537	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humrelv','','')
1538
1539	ALLOCATE (vegstressv(kjpindex,nvm,nstm),stat=ier)
1540	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegstressv','','')
1541
1542	ALLOCATE (precisol(kjpindex,nvm),stat=ier)
1543	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol','','')
1544
1545	ALLOCATE (throughfall(kjpindex,nvm),stat=ier)
1546	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable throughfall','','')
1547
1548	ALLOCATE (precisol_ns(kjpindex,nstm),stat=ier)
1549	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable precisol_nc','','')
1550
1551	ALLOCATE (free_drain_coef(kjpindex,nstm),stat=ier)
1552	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_coef','','')
1553
1554	ALLOCATE (zwt_force(kjpindex,nstm),stat=ier)
1555	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_force','','')
1556
1557	ALLOCATE (frac_bare_ns(kjpindex,nstm),stat=ier)
1558	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable frac_bare_ns','','')
1559
1560	ALLOCATE (water2infilt(kjpindex,nstm),stat=ier)
1561	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable water2infilt','','')
1562
1563	ALLOCATE (ae_ns(kjpindex,nstm),stat=ier)
1564	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ae_ns','','')
1565
1566	ALLOCATE (rootsink(kjpindex,nslm,nstm),stat=ier)
1567	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rootsink','','')
1568
1569	ALLOCATE (subsnowveg(kjpindex),stat=ier)
1570	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnowveg','','')
1571
1572	ALLOCATE (subsnownobio(kjpindex,nnobio),stat=ier)
1573	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsnownobio','','')
1574
1575	ALLOCATE (icemelt(kjpindex),stat=ier)
1576	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable icemelt','','')
1577
1578	ALLOCATE (subsinksoil(kjpindex),stat=ier)
1579	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable subsinksoil','','')
1580
1581	ALLOCATE (mx_eau_var(kjpindex),stat=ier)
1582	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mx_eau_var','','')
1583
1584	ALLOCATE (vegtot(kjpindex),stat=ier)
1585	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot','','')
1586
1587	ALLOCATE (vegtot_old(kjpindex),stat=ier)
1588	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegtot_old','','')
1589
1590	ALLOCATE (resdist(kjpindex,nstm),stat=ier)
1591	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resdist','','')
1592
1593	ALLOCATE (humtot(kjpindex),stat=ier)
1594	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable humtot','','')
1595
1596	ALLOCATE (resolv(kjpindex),stat=ier)
1597	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable resolv','','')
1598
1599	ALLOCATE (k(kjpindex,nslm),stat=ier)
1600	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k','','')
1601
1602	ALLOCATE (kk_moy(kjpindex,nslm),stat=ier)
1603	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk_moy','','')
1604	kk_moy(:,:) = 276.48
1605
1606	ALLOCATE (kk(kjpindex,nslm,nstm),stat=ier)
1607	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kk','','')
1608	kk(:,:,:) = 276.48
1609
1610	ALLOCATE (avan_mod_tab(nslm,kjpindex),stat=ier)
1611	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable avan_mod_tab','','')
1612
1613	ALLOCATE (nvan_mod_tab(nslm,kjpindex),stat=ier)
1614	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable nvan_mod_tab','','')
1615
1616	ALLOCATE (a(kjpindex,nslm),stat=ier)
1617	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a','','')
1618
1619	ALLOCATE (b(kjpindex,nslm),stat=ier)
1620	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b','','')
1621
1622	ALLOCATE (d(kjpindex,nslm),stat=ier)
1623	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d','','')
1624
1625	ALLOCATE (e(kjpindex,nslm),stat=ier)
1626	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable e','','')
1627
1628	ALLOCATE (f(kjpindex,nslm),stat=ier)
1629	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable f','','')
1630
1631	ALLOCATE (g1(kjpindex,nslm),stat=ier)
1632	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable g1','','')
1633
1634	ALLOCATE (ep(kjpindex,nslm),stat=ier)
1635	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ep','','')
1636
1637	ALLOCATE (fp(kjpindex,nslm),stat=ier)
1638	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable fp','','')
1639
1640	ALLOCATE (gp(kjpindex,nslm),stat=ier)
1641	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable gp','','')
1642
1643	ALLOCATE (rhs(kjpindex,nslm),stat=ier)
1644	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable rhs','','')
1645
1646	ALLOCATE (srhs(kjpindex,nslm),stat=ier)
1647	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable srhs','','')
1648
1649	ALLOCATE (tmc(kjpindex,nstm),stat=ier)
1650	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc','','')
1651
1652	ALLOCATE (tmcs(kjpindex,nstm),stat=ier)
1653	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcs','','')
1654
1655	ALLOCATE (tmcr(kjpindex,nstm),stat=ier)
1656	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcr','','')
1657
1658	ALLOCATE (tmcfc(kjpindex,nstm),stat=ier)
1659	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcfc','','')
1660
1661	ALLOCATE (tmcw(kjpindex,nstm),stat=ier)
1662	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmcw','','')
1663
1664	ALLOCATE (tmc_litter(kjpindex,nstm),stat=ier)
1665	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter','','')
1666
1667	ALLOCATE (tmc_litt_mea(kjpindex),stat=ier)
1668	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_mea','','')
1669
1670	ALLOCATE (tmc_litter_res(kjpindex,nstm),stat=ier)
1671	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_res','','')
1672
1673	ALLOCATE (tmc_litter_wilt(kjpindex,nstm),stat=ier)
1674	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_wilt','','')
1675
1676	ALLOCATE (tmc_litter_field(kjpindex,nstm),stat=ier)
1677	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_field','','')
1678
1679	ALLOCATE (tmc_litter_sat(kjpindex,nstm),stat=ier)
1680	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_sat','','')
1681
1682	ALLOCATE (tmc_litter_awet(kjpindex,nstm),stat=ier)
1683	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_awet','','')
1684
1685	ALLOCATE (tmc_litter_adry(kjpindex,nstm),stat=ier)
1686	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litter_adry','','')
1687
1688	ALLOCATE (tmc_litt_wet_mea(kjpindex),stat=ier)
1689	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_wet_mea','','')
1690
1691	ALLOCATE (tmc_litt_dry_mea(kjpindex),stat=ier)
1692	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_litt_dry_mea','','')
1693
1694	ALLOCATE (v1(kjpindex,nstm),stat=ier)
1695	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable v1','','')
1696
1697	ALLOCATE (ru_ns(kjpindex,nstm),stat=ier)
1698	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable ru_ns','','')
1699	ru_ns(:,:) = zero
1700
1701	ALLOCATE (dr_ns(kjpindex,nstm),stat=ier)
1702	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dr_ns','','')
1703	dr_ns(:,:) = zero
1704
1705	ALLOCATE (tr_ns(kjpindex,nstm),stat=ier)
1706	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tr_ns','','')
1707
1708	ALLOCATE (vegetmax_soil(kjpindex,nvm,nstm),stat=ier)
1709	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable vegetmax_soil','','')
1710
1711	ALLOCATE (mc(kjpindex,nslm,nstm),stat=ier)
1712	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc','','')
1713
1714
1715	! Variables for nudging of soil moisture
1716	IF (ok_nudge_mc) THEN
1717	ALLOCATE (mc_read_prev(kjpindex,nslm,nstm),stat=ier)
1718	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_prev','','')
1719	ALLOCATE (mc_read_next(kjpindex,nslm,nstm),stat=ier)
1720	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_next','','')
1721	ALLOCATE (mc_read_current(kjpindex,nslm,nstm),stat=ier)
1722	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_read_current','','')
1723	ALLOCATE (mask_mc_interp(kjpindex,nslm,nstm),stat=ier)
1724	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_mc_interp','','')
1725	ALLOCATE (tmc_aux(kjpindex,nstm),stat=ier)
1726	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmc_aux','','')
1727	END IF
1728
1729	! Variables for nudging of snow variables
1730	IF (ok_nudge_snow) THEN
1731	ALLOCATE (snowdz_read_prev(kjpindex,nsnow),stat=ier)
1732	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_prev','','')
1733	ALLOCATE (snowdz_read_next(kjpindex,nsnow),stat=ier)
1734	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowdz_read_next','','')
1735
1736	ALLOCATE (snowrho_read_prev(kjpindex,nsnow),stat=ier)
1737	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_prev','','')
1738	ALLOCATE (snowrho_read_next(kjpindex,nsnow),stat=ier)
1739	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowrho_read_next','','')
1740
1741	ALLOCATE (snowtemp_read_prev(kjpindex,nsnow),stat=ier)
1742	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_prev','','')
1743	ALLOCATE (snowtemp_read_next(kjpindex,nsnow),stat=ier)
1744	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snowtemp_read_next','','')
1745
1746	ALLOCATE (mask_snow_interp(kjpindex,nsnow),stat=ier)
1747	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mask_snow_interp','','')
1748	END IF
1749
1750	ALLOCATE (mcl(kjpindex, nslm, nstm),stat=ier)
1751	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mcl','','')
1752
1753	IF (ok_freeze_cwrr) THEN
1754	ALLOCATE (profil_froz_hydro(kjpindex, nslm),stat=ier)
1755	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydrol','','')
1756	profil_froz_hydro(:,:) = zero
1757	ENDIF
1758
1759	ALLOCATE (profil_froz_hydro_ns(kjpindex, nslm, nstm),stat=ier)
1760	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable profil_froz_hydro_ns','','')
1761	profil_froz_hydro_ns(:,:,:) = zero
1762
1763	ALLOCATE (soilmoist(kjpindex,nslm),stat=ier)
1764	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist','','')
1765
1766	ALLOCATE (soilmoist_s(kjpindex,nslm,nstm),stat=ier)
1767	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist_s','','')
1768
1769	ALLOCATE (soilmoist_liquid(kjpindex,nslm),stat=ier)
1770	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soilmoist_liquid','','')
1771
1772	ALLOCATE (soil_wet_ns(kjpindex,nslm,nstm),stat=ier)
1773	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_ns','','')
1774
1775	ALLOCATE (soil_wet_litter(kjpindex,nstm),stat=ier)
1776	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable soil_wet_litter','','')
1777
1778	ALLOCATE (qflux_ns(kjpindex,nslm,nstm),stat=ier)
1779	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable qflux_ns','','')
1780
1781	ALLOCATE (check_top_ns(kjpindex,nstm),stat=ier)
1782	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable check_top_ns','','')
1783
1784	ALLOCATE (tmat(kjpindex,nslm,3),stat=ier)
1785	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tmat','','')
1786
1787	ALLOCATE (stmat(kjpindex,nslm,3),stat=ier)
1788	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable stmat','','')
1789
1790	ALLOCATE (kfact_root(kjpindex, nslm, nstm), stat=ier)
1791	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact_root','','')
1792
1793	ALLOCATE (kfact(nslm, kjpindex),stat=ier)
1794	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable kfact','','')
1795
1796	ALLOCATE (zz(nslm),stat=ier)
1797	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zz','','')
1798
1799	ALLOCATE (dz(nslm),stat=ier)
1800	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dz','','')
1801
1802	ALLOCATE (dh(nslm),stat=ier)
1803	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable dh','','')
1804
1805	ALLOCATE (mc_lin(imin:imax, kjpindex),stat=ier)
1806	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable mc_lin','','')
1807
1808	ALLOCATE (k_lin(imin:imax, nslm, kjpindex),stat=ier)
1809	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable k_lin','','')
1810
1811	ALLOCATE (d_lin(imin:imax, nslm, kjpindex),stat=ier)
1812	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable d_lin','','')
1813
1814	ALLOCATE (a_lin(imin:imax, nslm, kjpindex),stat=ier)
1815	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable a_lin','','')
1816
1817	ALLOCATE (b_lin(imin:imax, nslm, kjpindex),stat=ier)
1818	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable b_lin','','')
1819
1820	ALLOCATE (undermcr(kjpindex),stat=ier)
1821	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable undermcr','','')
1822
1823	ALLOCATE (tot_watveg_beg(kjpindex),stat=ier)
1824	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watveg_beg','','')
1825
1826	ALLOCATE (tot_watveg_end(kjpindex),stat=ier)
1827	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watvag_end','','')
1828
1829	ALLOCATE (tot_watsoil_beg(kjpindex),stat=ier)
1830	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_beg','','')
1831
1832	ALLOCATE (tot_watsoil_end(kjpindex),stat=ier)
1833	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable tot_watsoil_end','','')
1834
1835	ALLOCATE (delsoilmoist(kjpindex),stat=ier)
1836	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delsoilmoist','','')
1837
1838	ALLOCATE (delintercept(kjpindex),stat=ier)
1839	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delintercept','','')
1840
1841	ALLOCATE (delswe(kjpindex),stat=ier)
1842	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable delswe','','')
1843
1844	ALLOCATE (snow_beg(kjpindex),stat=ier)
1845	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_beg','','')
1846
1847	ALLOCATE (snow_end(kjpindex),stat=ier)
1848	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable snow_end','','')
1849
1850	!! 4 Open restart input file and read data for HYDROLOGIC process
1851	IF (printlev>=3) WRITE (numout,*) ' we have to read a restart file for HYDROLOGIC variables'
1852
1853	CALL ioconf_setatt_p('UNITS', '-')
1854	CALL ioconf_setatt_p('LONG_NAME', 'moistc')
1855	CALL restget_p (rest_id, 'moistc', nbp_glo, nslm , nstm, kjit, .TRUE., mc, "gather", nbp_glo, index_g)
1856
1857	IF (ok_nudge_mc) THEN
1858	CALL ioconf_setatt_p('LONG_NAME','Soil moisture read from nudging file')
1859	CALL restget_p (rest_id, 'mc_read_next', nbp_glo, nslm , nstm, kjit, .TRUE., mc_read_next, &
1860	"gather", nbp_glo, index_g)
1861	END IF
1862
1863	IF (ok_nudge_snow) THEN
1864	CALL ioconf_setatt_p('UNITS', 'm')
1865	CALL ioconf_setatt_p('LONG_NAME','Snow layer thickness read from nudging file')
1866	CALL restget_p (rest_id, 'snowdz_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowdz_read_next, &
1867	"gather", nbp_glo, index_g)
1868
1869	CALL ioconf_setatt_p('UNITS', 'kg/m^3')
1870	CALL ioconf_setatt_p('LONG_NAME','Snow density profile read from nudging file')
1871	CALL restget_p (rest_id, 'snowrho_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowrho_read_next, &
1872	"gather", nbp_glo, index_g)
1873
1874	CALL ioconf_setatt_p('UNITS', 'K')
1875	CALL ioconf_setatt_p('LONG_NAME','Snow temperature read from nudging file')
1876	CALL restget_p (rest_id, 'snowtemp_read_next', nbp_glo, nsnow, 1, kjit, .TRUE., snowtemp_read_next, &
1877	"gather", nbp_glo, index_g)
1878	END IF
1879
1880	CALL restget_p (rest_id, 'moistcl', nbp_glo, nslm , nstm, kjit, .TRUE., mcl, "gather", nbp_glo, index_g)
1881	!
1882	CALL ioconf_setatt_p('UNITS', '-')
1883	CALL ioconf_setatt_p('LONG_NAME','us')
1884	CALL restget_p (rest_id, 'us', nbp_glo, nvm, nstm, nslm, kjit, .TRUE., us, "gather", nbp_glo, index_g)
1885	!
1886	var_name= 'free_drain_coef'
1887	CALL ioconf_setatt_p('UNITS', '-')
1888	CALL ioconf_setatt_p('LONG_NAME','Coefficient for free drainage at bottom of soil')
1889	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., free_drain_coef, "gather", nbp_glo, index_g)
1890	!
1891	var_name= 'zwt_force'
1892	CALL ioconf_setatt_p('UNITS', 'm')
1893	CALL ioconf_setatt_p('LONG_NAME','Prescribed water table depth')
1894	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., zwt_force, "gather", nbp_glo, index_g)
1895	!
1896	var_name= 'water2infilt'
1897	CALL ioconf_setatt_p('UNITS', '-')
1898	CALL ioconf_setatt_p('LONG_NAME','Remaining water to be infiltrated on top of the soil')
1899	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., water2infilt, "gather", nbp_glo, index_g)
1900	!
1901	var_name= 'ae_ns'
1902	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1903	CALL ioconf_setatt_p('LONG_NAME','Bare soil evap on each soil type')
1904	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., ae_ns, "gather", nbp_glo, index_g)
1905	!
1906	var_name= 'snow'
1907	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1908	CALL ioconf_setatt_p('LONG_NAME','Snow mass')
1909	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow, "gather", nbp_glo, index_g)
1910	!
1911	var_name= 'snow_age'
1912	CALL ioconf_setatt_p('UNITS', 'd')
1913	CALL ioconf_setatt_p('LONG_NAME','Snow age')
1914	CALL restget_p (rest_id, var_name, nbp_glo, 1 , 1, kjit, .TRUE., snow_age, "gather", nbp_glo, index_g)
1915	!
1916	var_name= 'snow_nobio'
1917	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1918	CALL ioconf_setatt_p('LONG_NAME','Snow on other surface types')
1919	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio, "gather", nbp_glo, index_g)
1920	!
1921	var_name= 'snow_nobio_age'
1922	CALL ioconf_setatt_p('UNITS', 'd')
1923	CALL ioconf_setatt_p('LONG_NAME','Snow age on other surface types')
1924	CALL restget_p (rest_id, var_name, nbp_glo, nnobio , 1, kjit, .TRUE., snow_nobio_age, "gather", nbp_glo, index_g)
1925	!
1926	var_name= 'qsintveg'
1927	CALL ioconf_setatt_p('UNITS', 'kg/m^2')
1928	CALL ioconf_setatt_p('LONG_NAME','Intercepted moisture')
1929	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., qsintveg, "gather", nbp_glo, index_g)
1930
1931	var_name= 'evap_bare_lim_ns'
1932	CALL ioconf_setatt_p('UNITS', '?')
1933	CALL ioconf_setatt_p('LONG_NAME','?')
1934	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., evap_bare_lim_ns, "gather", nbp_glo, index_g)
1935	CALL setvar_p (evap_bare_lim_ns, val_exp, 'NO_KEYWORD', 0.0)
1936
1937	var_name= 'resdist'
1938	CALL ioconf_setatt_p('UNITS', '-')
1939	CALL ioconf_setatt_p('LONG_NAME','soiltile values from previous time-step')
1940	CALL restget_p (rest_id, var_name, nbp_glo, nstm, 1, kjit, .TRUE., resdist, "gather", nbp_glo, index_g)
1941
1942	var_name= 'vegtot_old'
1943	CALL ioconf_setatt_p('UNITS', '-')
1944	CALL ioconf_setatt_p('LONG_NAME','vegtot from previous time-step')
1945	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., vegtot_old, "gather", nbp_glo, index_g)
1946
1947	! Read drysoil_frac. It will be initalized later in hydrol_var_init if the varaible is not find in restart file.
1948	CALL ioconf_setatt_p('UNITS', '')
1949	CALL ioconf_setatt_p('LONG_NAME','Function of litter wetness')
1950	CALL restget_p (rest_id, 'drysoil_frac', nbp_glo, 1 , 1, kjit, .TRUE., drysoil_frac, "gather", nbp_glo, index_g)
1951
1952	IF(ok_hydrol_arch)THEN
1953	var_name='mc_out'
1954	CALL restget_p (rest_id, var_name, nbp_glo, nslm, nstm, kjit, .TRUE., mc_out, "gather", nbp_glo, index_g)
1955	IF (ALL(mc_out(:,:,:) == val_exp)) mc_out(:,:,:) = zero
1956
1957	var_name='ksoil'
1958	CALL restget_p (rest_id, var_name, nbp_glo, nslm, nstm, kjit, .TRUE., ksoil, "gather", nbp_glo, index_g)
1959	IF (ALL(ksoil(:,:,:) == val_exp)) ksoil(:,:,:) = min_sechiba
1960	ENDIF
1961
1962	!! 5 get restart values if none were found in the restart file
1963	!
1964	!Config Key = HYDROL_MOISTURE_CONTENT
1965	!Config Desc = Soil moisture on each soil tile and levels
1966	!Config If =
1967	!Config Def = 0.3
1968	!Config Help = The initial value of mc if its value is not found
1969	!Config in the restart file. This should only be used if the model is
1970	!Config started without a restart file.
1971	!Config Units = [m3/m3]
1972	!
1973	CALL setvar_p (mc, val_exp, 'HYDROL_MOISTURE_CONTENT', 0.3_r_std)
1974
1975	! Initialize mcl as mc if it is not found in the restart file
1976	IF ( ALL(mcl(:,:,:)==val_exp) ) THEN
1977	mcl(:,:,:) = mc(:,:,:)
1978	END IF
1979
1980	!Config Key = US_INIT
1981	!Config Desc = US_NVM_NSTM_NSLM
1982	!Config If =
1983	!Config Def = 0.0
1984	!Config Help = The initial value of us (relative moisture) if its value is not found
1985	!Config in the restart file. This should only be used if the model is
1986	!Config started without a restart file.
1987	!Config Units = [-]
1988	!
1989	DO jsl=1,nslm
1990	CALL setvar_p (us(:,:,:,jsl), val_exp, 'US_INIT', zero)
1991	ENDDO
1992	!
1993	!Config Key = ZWT_FORCE
1994	!Config Desc = Prescribed water depth, dimension nstm
1995	!Config If =
1996	!Config Def = undef undef undef
1997	!Config Help = The initial value of zwt_force if its value is not found
1998	!Config in the restart file. undef corresponds to a case whith no forced WT.
1999	!Config This should only be used if the model is started without a restart file.
2000	!Config Units = [m]
2001
2002	ALLOCATE (zwt_default(nstm),stat=ier)
2003	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable zwt_default','','')
2004	zwt_default(:) = undef_sechiba
2005	CALL setvar_p (zwt_force, val_exp, 'ZWT_FORCE', zwt_default )
2006
2007	zforce = .FALSE.
2008	DO jst=1,nstm
2009	IF (zwt_force(1,jst) <= zmaxh) zforce = .TRUE. ! AD16*** check if OK with vertical_soil
2010	ENDDO
2011	!
2012	!Config Key = FREE_DRAIN_COEF
2013	!Config Desc = Coefficient for free drainage at bottom, dimension nstm
2014	!Config If =
2015	!Config Def = 1.0 1.0 1.0
2016	!Config Help = The initial value of free drainage coefficient if its value is not found
2017	!Config in the restart file. This should only be used if the model is
2018	!Config started without a restart file.
2019	!Config Units = [-]
2020
2021	ALLOCATE (free_drain_max(nstm),stat=ier)
2022	IF (ier /= 0) CALL ipslerr_p(3,'hydrol_init','Problem in allocate of variable free_drain_max','','')
2023	free_drain_max(:)=1.0
2024
2025	CALL setvar_p (free_drain_coef, val_exp, 'FREE_DRAIN_COEF', free_drain_max)
2026	IF (printlev>=2) WRITE (numout,*) ' hydrol_init => free_drain_coef = ',free_drain_coef(1,:)
2027	DEALLOCATE(free_drain_max)
2028
2029	!
2030	!Config Key = WATER_TO_INFILT
2031	!Config Desc = Water to be infiltrated on top of the soil
2032	!Config If =
2033	!Config Def = 0.0
2034	!Config Help = The initial value of free drainage if its value is not found
2035	!Config in the restart file. This should only be used if the model is
2036	!Config started without a restart file.
2037	!Config Units = [mm]
2038	!
2039	CALL setvar_p (water2infilt, val_exp, 'WATER_TO_INFILT', zero)
2040	!
2041	!Config Key = EVAPNU_SOIL
2042	!Config Desc = Bare soil evap on each soil if not found in restart
2043	!Config If =
2044	!Config Def = 0.0
2045	!Config Help = The initial value of bare soils evap if its value is not found
2046	!Config in the restart file. This should only be used if the model is
2047	!Config started without a restart file.
2048	!Config Units = [mm]
2049	!
2050	CALL setvar_p (ae_ns, val_exp, 'EVAPNU_SOIL', zero)
2051	!
2052	!Config Key = HYDROL_SNOW
2053	!Config Desc = Initial snow mass if not found in restart
2054	!Config If = OK_SECHIBA
2055	!Config Def = 0.0
2056	!Config Help = The initial value of snow mass if its value is not found
2057	!Config in the restart file. This should only be used if the model is
2058	!Config started without a restart file.
2059	!Config Units =
2060	!
2061	CALL setvar_p (snow, val_exp, 'HYDROL_SNOW', zero)
2062	!
2063	!Config Key = HYDROL_SNOWAGE
2064	!Config Desc = Initial snow age if not found in restart
2065	!Config If = OK_SECHIBA
2066	!Config Def = 0.0
2067	!Config Help = The initial value of snow age if its value is not found
2068	!Config in the restart file. This should only be used if the model is
2069	!Config started without a restart file.
2070	!Config Units = ***
2071	!
2072	CALL setvar_p (snow_age, val_exp, 'HYDROL_SNOWAGE', zero)
2073	!
2074	!Config Key = HYDROL_SNOW_NOBIO
2075	!Config Desc = Initial snow amount on ice, lakes, etc. if not found in restart
2076	!Config If = OK_SECHIBA
2077	!Config Def = 0.0
2078	!Config Help = The initial value of snow if its value is not found
2079	!Config in the restart file. This should only be used if the model is
2080	!Config started without a restart file.
2081	!Config Units = [mm]
2082	!
2083	CALL setvar_p (snow_nobio, val_exp, 'HYDROL_SNOW_NOBIO', zero)
2084	!
2085	!Config Key = HYDROL_SNOW_NOBIO_AGE
2086	!Config Desc = Initial snow age on ice, lakes, etc. if not found in restart
2087	!Config If = OK_SECHIBA
2088	!Config Def = 0.0
2089	!Config Help = The initial value of snow age if its value is not found
2090	!Config in the restart file. This should only be used if the model is
2091	!Config started without a restart file.
2092	!Config Units = ***
2093	!
2094	CALL setvar_p (snow_nobio_age, val_exp, 'HYDROL_SNOW_NOBIO_AGE', zero)
2095	!
2096	!Config Key = HYDROL_QSV
2097	!Config Desc = Initial water on canopy if not found in restart
2098	!Config If = OK_SECHIBA
2099	!Config Def = 0.0
2100	!Config Help = The initial value of moisture on canopy if its value
2101	!Config is not found in the restart file. This should only be used if
2102	!Config the model is started without a restart file.
2103	!Config Units = [mm]
2104	!
2105	CALL setvar_p (qsintveg, val_exp, 'HYDROL_QSV', zero)
2106
2107	!! 6 Vegetation array
2108	!
2109	! If resdist is not in restart file, initialize with soiltile
2110	IF ( MINVAL(resdist) .EQ. MAXVAL(resdist) .AND. MINVAL(resdist) .EQ. val_exp) THEN
2111	resdist(:,:) = soiltile(:,:)
2112	ENDIF
2113
2114	!
2115	! Remember that it is only frac_nobio + SUM(veget_max(,:)) that is equal to 1. Thus we need vegtot
2116	!
2117	IF ( ALL(vegtot_old(:) == val_exp) ) THEN
2118	! vegtot_old was not found in restart file
2119	DO ji = 1, kjpindex
2120	vegtot_old(ji) = SUM(veget_max(ji,:))
2121	ENDDO
2122	ENDIF
2123
2124	! In the initialization phase, vegtot must take the value from previous time-step.
2125	! This is because hydrol_main is done before veget_max is updated in the end of the time step.
2126	vegtot(:) = vegtot_old(:)
2127
2128	!
2129	!
2130	! compute the masks for veget
2131
2132	mask_veget(:,:) = 0
2133	mask_soiltile(:,:) = 0
2134
2135	DO jst=1,nstm
2136	DO ji = 1, kjpindex
2137	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
2138	mask_soiltile(ji,jst) = 1
2139	ENDIF
2140	END DO
2141	ENDDO
2142
2143	DO jv = 1, nvm
2144	DO ji = 1, kjpindex
2145	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
2146	mask_veget(ji,jv) = 1
2147	ENDIF
2148	END DO
2149	END DO
2150
2151	humrelv(:,:,:) = SUM(us,dim=4)
2152
2153
2154	!! 7a. Set vegstress
2155
2156	var_name= 'vegstress'
2157	CALL ioconf_setatt_p('UNITS', '-')
2158	CALL ioconf_setatt_p('LONG_NAME','Vegetation growth moisture stress')
2159	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., vegstress, "gather", nbp_glo, index_g)
2160
2161	vegstressv(:,:,:) = humrelv(:,:,:)
2162	! Calculate vegstress if it is not found in restart file
2163	IF (ALL(vegstress(:,:)==val_exp)) THEN
2164	DO jv=1,nvm
2165	DO ji=1,kjpindex
2166	vegstress(ji,jv)=vegstress(ji,jv) + vegstressv(ji,jv,pref_soil_veg(jv))
2167	END DO
2168	END DO
2169	END IF
2170	!! 7b. Set humrel
2171	! Read humrel from restart file
2172	var_name= 'humrel'
2173	IF (is_root_prc) THEN
2174	CALL ioconf_setatt_p('UNITS', '')
2175	CALL ioconf_setatt_p('LONG_NAME','Relative humidity')
2176	ENDIF
2177	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., humrel, "gather", nbp_glo, index_g)
2178
2179	! Calculate humrel if it is not found in restart file
2180	IF (ALL(humrel(:,:)==val_exp)) THEN
2181	! set humrel from humrelv, assuming equi-repartition for the first time step
2182	humrel(:,:) = zero
2183	DO jv=1,nvm
2184	DO ji=1,kjpindex
2185	humrel(ji,jv)=humrel(ji,jv) + humrelv(ji,jv,pref_soil_veg(jv))
2186	END DO
2187	END DO
2188	END IF
2189
2190	! Read evap_bare_lim from restart file
2191	var_name= 'evap_bare_lim'
2192	IF (is_root_prc) THEN
2193	CALL ioconf_setatt_p('UNITS', '')
2194	CALL ioconf_setatt_p('LONG_NAME','Limitation factor for bare soil evaporation')
2195	ENDIF
2196	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., evap_bare_lim, "gather", nbp_glo, index_g)
2197
2198	! Calculate evap_bare_lim if it was not found in the restart file.
2199	IF ( ALL(evap_bare_lim(:) == val_exp) ) THEN
2200	DO ji = 1, kjpindex
2201	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
2202	ENDDO
2203	END IF
2204
2205	! Read root profile from restart file (it is used in hydraul_arch before it is
2206	! calculated in hydrol.f90. Putting it in the restarts avoids zero values the
2207	! first day of each year.
2208	var_name= 'root_profile_struc'
2209	IF (is_root_prc) THEN
2210	CALL ioconf_setatt_p('UNITS', '')
2211	CALL ioconf_setatt_p('LONG_NAME','Structural root profile')
2212	ENDIF
2213	CALL restget_p (rest_id, var_name, nbp_glo, nvm, nslm, kjit, .TRUE., root_profile(:,:,:,istruc), "gather", nbp_glo, index_g)
2214	IF (ALL(root_profile(:,:,:,istruc) == val_exp)) root_profile(:,:,:,istruc) = zero
2215
2216	var_name= 'root_profile_func'
2217	IF (is_root_prc) THEN
2218	CALL ioconf_setatt_p('UNITS', '')
2219	CALL ioconf_setatt_p('LONG_NAME','Functional root profile')
2220	ENDIF
2221	CALL restget_p (rest_id, var_name, nbp_glo, nvm, nslm, kjit, .TRUE., root_profile(:,:,:,ifunc), "gather", nbp_glo, index_g)
2222	IF (ALL(root_profile(:,:,:,ifunc) == val_exp)) root_profile(:,:,:,ifunc) = zero
2223
2224	! Read from restart file
2225	! The variables tot_watsoil_beg, tot_watsoil_beg and snwo_beg will be initialized in the end of
2226	! hydrol_initialize if they were not found in the restart file.
2227
2228	var_name= 'tot_watveg_beg'
2229	IF (is_root_prc) THEN
2230	CALL ioconf_setatt_p('UNITS', '?')
2231	CALL ioconf_setatt_p('LONG_NAME','?')
2232	ENDIF
2233	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watveg_beg, "gather", nbp_glo, index_g)
2234
2235	var_name= 'tot_watsoil_beg'
2236	IF (is_root_prc) THEN
2237	CALL ioconf_setatt_p('UNITS', '?')
2238	CALL ioconf_setatt_p('LONG_NAME','?')
2239	ENDIF
2240	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., tot_watsoil_beg, "gather", nbp_glo, index_g)
2241
2242	var_name= 'snow_beg'
2243	IF (is_root_prc) THEN
2244	CALL ioconf_setatt_p('UNITS', '?')
2245	CALL ioconf_setatt_p('LONG_NAME','?')
2246	ENDIF
2247	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., snow_beg, "gather", nbp_glo, index_g)
2248
2249
2250	! Initialize variables for explictsnow module by reading restart file
2251	CALL explicitsnow_initialize( kjit, kjpindex, rest_id, snowrho, &
2252	snowtemp, snowdz, snowheat, snowgrain)
2253
2254
2255	! Initialize soil moisture for nudging if not found in restart file
2256	IF (ok_nudge_mc) THEN
2257	IF ( ALL(mc_read_next(:,:,:)==val_exp) ) mc_read_next(:,:,:) = mc(:,:,:)
2258	END IF
2259
2260	! Initialize snow variables for nudging if not found in restart file
2261	IF (ok_nudge_snow) THEN
2262	IF ( ALL(snowdz_read_next(:,:)==val_exp) ) snowdz_read_next(:,:) = snowdz(:,:)
2263	IF ( ALL(snowrho_read_next(:,:)==val_exp) ) snowrho_read_next(:,:) = snowrho(:,:)
2264	IF ( ALL(snowtemp_read_next(:,:)==val_exp) ) snowtemp_read_next(:,:) = snowtemp(:,:)
2265	END IF
2266
2267
2268	IF (printlev>=3) WRITE (numout,*) ' hydrol_init done '
2269
2270	END SUBROUTINE hydrol_init
2271
2272
2273	!! ================================================================================================================================
2274	!! SUBROUTINE : hydrol_clear
2275	!!
2276	!>\BRIEF Deallocate arrays
2277	!!
2278	!_ ================================================================================================================================
2279	!_ hydrol_clear
2280
2281	SUBROUTINE hydrol_clear()
2282
2283	! Allocation for soiltile related parameters
2284	IF ( ALLOCATED (pcent)) DEALLOCATE (pcent)
2285	IF ( ALLOCATED (mc_awet)) DEALLOCATE (mc_awet)
2286	IF ( ALLOCATED (mc_adry)) DEALLOCATE (mc_adry)
2287	! Other arrays
2288	IF (ALLOCATED (mask_veget)) DEALLOCATE (mask_veget)
2289	IF (ALLOCATED (mask_soiltile)) DEALLOCATE (mask_soiltile)
2290	IF (ALLOCATED (humrelv)) DEALLOCATE (humrelv)
2291	IF (ALLOCATED (vegstressv)) DEALLOCATE (vegstressv)
2292	IF (ALLOCATED (precisol)) DEALLOCATE (precisol)
2293	IF (ALLOCATED (throughfall)) DEALLOCATE (throughfall)
2294	IF (ALLOCATED (precisol_ns)) DEALLOCATE (precisol_ns)
2295	IF (ALLOCATED (free_drain_coef)) DEALLOCATE (free_drain_coef)
2296	IF (ALLOCATED (frac_bare_ns)) DEALLOCATE (frac_bare_ns)
2297	IF (ALLOCATED (water2infilt)) DEALLOCATE (water2infilt)
2298	IF (ALLOCATED (ae_ns)) DEALLOCATE (ae_ns)
2299	IF (ALLOCATED (rootsink)) DEALLOCATE (rootsink)
2300	IF (ALLOCATED (subsnowveg)) DEALLOCATE (subsnowveg)
2301	IF (ALLOCATED (subsnownobio)) DEALLOCATE (subsnownobio)
2302	IF (ALLOCATED (icemelt)) DEALLOCATE (icemelt)
2303	IF (ALLOCATED (subsinksoil)) DEALLOCATE (subsinksoil)
2304	IF (ALLOCATED (mx_eau_var)) DEALLOCATE (mx_eau_var)
2305	IF (ALLOCATED (vegtot)) DEALLOCATE (vegtot)
2306	IF (ALLOCATED (vegtot_old)) DEALLOCATE (vegtot_old)
2307	IF (ALLOCATED (resdist)) DEALLOCATE (resdist)
2308	IF (ALLOCATED (tot_watveg_beg)) DEALLOCATE (tot_watveg_beg)
2309	IF (ALLOCATED (tot_watveg_end)) DEALLOCATE (tot_watveg_end)
2310	IF (ALLOCATED (tot_watsoil_beg)) DEALLOCATE (tot_watsoil_beg)
2311	IF (ALLOCATED (tot_watsoil_end)) DEALLOCATE (tot_watsoil_end)
2312	IF (ALLOCATED (delsoilmoist)) DEALLOCATE (delsoilmoist)
2313	IF (ALLOCATED (delintercept)) DEALLOCATE (delintercept)
2314	IF (ALLOCATED (snow_beg)) DEALLOCATE (snow_beg)
2315	IF (ALLOCATED (snow_end)) DEALLOCATE (snow_end)
2316	IF (ALLOCATED (delswe)) DEALLOCATE (delswe)
2317	IF (ALLOCATED (undermcr)) DEALLOCATE (undermcr)
2318	IF (ALLOCATED (v1)) DEALLOCATE (v1)
2319	IF (ALLOCATED (humtot)) DEALLOCATE (humtot)
2320	IF (ALLOCATED (resolv)) DEALLOCATE (resolv)
2321	IF (ALLOCATED (k)) DEALLOCATE (k)
2322	IF (ALLOCATED (kk)) DEALLOCATE (kk)
2323	IF (ALLOCATED (kk_moy)) DEALLOCATE (kk_moy)
2324	IF (ALLOCATED (avan_mod_tab)) DEALLOCATE (avan_mod_tab)
2325	IF (ALLOCATED (nvan_mod_tab)) DEALLOCATE (nvan_mod_tab)
2326	IF (ALLOCATED (a)) DEALLOCATE (a)
2327	IF (ALLOCATED (b)) DEALLOCATE (b)
2328	IF (ALLOCATED (d)) DEALLOCATE (d)
2329	IF (ALLOCATED (e)) DEALLOCATE (e)
2330	IF (ALLOCATED (f)) DEALLOCATE (f)
2331	IF (ALLOCATED (g1)) DEALLOCATE (g1)
2332	IF (ALLOCATED (ep)) DEALLOCATE (ep)
2333	IF (ALLOCATED (fp)) DEALLOCATE (fp)
2334	IF (ALLOCATED (gp)) DEALLOCATE (gp)
2335	IF (ALLOCATED (rhs)) DEALLOCATE (rhs)
2336	IF (ALLOCATED (srhs)) DEALLOCATE (srhs)
2337	IF (ALLOCATED (tmc)) DEALLOCATE (tmc)
2338	IF (ALLOCATED (tmcs)) DEALLOCATE (tmcs)
2339	IF (ALLOCATED (tmcr)) DEALLOCATE (tmcr)
2340	IF (ALLOCATED (tmcfc)) DEALLOCATE (tmcfc)
2341	IF (ALLOCATED (tmcw)) DEALLOCATE (tmcw)
2342	IF (ALLOCATED (tmc_litter)) DEALLOCATE (tmc_litter)
2343	IF (ALLOCATED (tmc_litt_mea)) DEALLOCATE (tmc_litt_mea)
2344	IF (ALLOCATED (tmc_litter_res)) DEALLOCATE (tmc_litter_res)
2345	IF (ALLOCATED (tmc_litter_wilt)) DEALLOCATE (tmc_litter_wilt)
2346	IF (ALLOCATED (tmc_litter_field)) DEALLOCATE (tmc_litter_field)
2347	IF (ALLOCATED (tmc_litter_sat)) DEALLOCATE (tmc_litter_sat)
2348	IF (ALLOCATED (tmc_litter_awet)) DEALLOCATE (tmc_litter_awet)
2349	IF (ALLOCATED (tmc_litter_adry)) DEALLOCATE (tmc_litter_adry)
2350	IF (ALLOCATED (tmc_litt_wet_mea)) DEALLOCATE (tmc_litt_wet_mea)
2351	IF (ALLOCATED (tmc_litt_dry_mea)) DEALLOCATE (tmc_litt_dry_mea)
2352	IF (ALLOCATED (ru_ns)) DEALLOCATE (ru_ns)
2353	IF (ALLOCATED (dr_ns)) DEALLOCATE (dr_ns)
2354	IF (ALLOCATED (tr_ns)) DEALLOCATE (tr_ns)
2355	IF (ALLOCATED (vegetmax_soil)) DEALLOCATE (vegetmax_soil)
2356	IF (ALLOCATED (mc)) DEALLOCATE (mc)
2357	IF (ALLOCATED (soilmoist)) DEALLOCATE (soilmoist)
2358	IF (ALLOCATED (soilmoist_s)) DEALLOCATE (soilmoist_s)
2359	IF (ALLOCATED (soilmoist_liquid)) DEALLOCATE (soilmoist_liquid)
2360	IF (ALLOCATED (soil_wet_ns)) DEALLOCATE (soil_wet_ns)
2361	IF (ALLOCATED (soil_wet_litter)) DEALLOCATE (soil_wet_litter)
2362	IF (ALLOCATED (qflux_ns)) DEALLOCATE (qflux_ns)
2363	IF (ALLOCATED (tmat)) DEALLOCATE (tmat)
2364	IF (ALLOCATED (stmat)) DEALLOCATE (stmat)
2365	IF (ALLOCATED (kfact_root)) DEALLOCATE (kfact_root)
2366	IF (ALLOCATED (kfact)) DEALLOCATE (kfact)
2367	IF (ALLOCATED (zz)) DEALLOCATE (zz)
2368	IF (ALLOCATED (dz)) DEALLOCATE (dz)
2369	IF (ALLOCATED (dh)) DEALLOCATE (dh)
2370	IF (ALLOCATED (mc_lin)) DEALLOCATE (mc_lin)
2371	IF (ALLOCATED (k_lin)) DEALLOCATE (k_lin)
2372	IF (ALLOCATED (d_lin)) DEALLOCATE (d_lin)
2373	IF (ALLOCATED (a_lin)) DEALLOCATE (a_lin)
2374	IF (ALLOCATED (b_lin)) DEALLOCATE (b_lin)
2375
2376	END SUBROUTINE hydrol_clear
2377
2378	!! ================================================================================================================================
2379	!! SUBROUTINE : hydrol_tmc_update
2380	!!
2381	!>\BRIEF This routine updates the soil moisture profiles when the vegetation fraction have changed.
2382	!!
2383	!! DESCRIPTION :
2384	!!
2385	!! This routine update tmc and mc with variation of veget_max (LAND_USE or DGVM activated)
2386	!!
2387	!!
2388	!!
2389	!!
2390	!! RECENT CHANGE(S) : Adaptation to excluding nobio from soiltile(1)
2391	!!
2392	!! MAIN OUTPUT VARIABLE(S) :
2393	!!
2394	!! REFERENCE(S) :
2395	!!
2396	!! FLOWCHART : None
2397	!! \n
2398	!_ ================================================================================================================================
2399
2400	SUBROUTINE hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
2401
2402	!! 0.1 Input variables
2403	INTEGER(i_std), INTENT(in) :: kjpindex !! domain size
2404	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! max fraction of vegetation type
2405	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile (0-1, unitless)
2406
2407	!! 0.2 Output variables
2408	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
2409	!! on mc [kg/m2/dt]
2410	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
2411	!! on water2infilt[kg/m2/dt]
2412
2413	!! 0.3 Modified variables
2414	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Amount of water in the canopy interception
2415
2416	!! 0.4 Local variables
2417	INTEGER(i_std) :: ji, jv, jst,jsl, index !! Indices
2418	LOGICAL :: soil_upd !! True if soiltile changed since last time step
2419	LOGICAL :: vegtot_upd !! True if vegtot changed since last time step
2420	REAL(r_std), DIMENSION(kjpindex,nstm) :: vmr !! Change in soiltile (within vegtot)
2421	REAL(r_std), DIMENSION(kjpindex) :: vmr_sum
2422	REAL(r_std), DIMENSION(kjpindex) :: delvegtot
2423	REAL(r_std), DIMENSION(kjpindex,nslm) :: mc_dilu !! Total loss of moisture content
2424	REAL(r_std), DIMENSION(kjpindex) :: infil_dilu !! Total loss for water2infilt
2425	REAL(r_std), DIMENSION(kjpindex,nstm) :: tmc_old !! tmc before calculations
2426	REAL(r_std), DIMENSION(kjpindex,nstm) :: water2infilt_old !! water2infilt before calculations
2427	REAL(r_std), DIMENSION (kjpindex,nvm) :: qsintveg_old !! qsintveg before calculations
2428	REAL(r_std), DIMENSION(kjpindex) :: test
2429	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mcaux !! serves to hold the chnage in mc when vegtot decreases
2430
2431
2432	!! 1. Update canopy interception following a land cover change
2433	! If a PFT has disapperead as result from a veget_max change,
2434	! the intercepted water will have been lost during the removal of the vegetation.
2435	! The water previously stored on the canopy will now be added to surface water.
2436	! Other adaptations of qsintveg are delt by the normal functioning of hydrol_canop
2437	DO ji=1,kjpindex
2438	IF (vegtot_old(ji) .GT.min_sechiba) THEN
2439	DO jv=1,nvm
2440	IF ((veget_max(ji,jv).LT.min_sechiba).AND.(qsintveg(ji,jv).GT.0.)) THEN
2441
2442	! The PFT has been removed but there is still some water on the canopy a solution need to be
2443	! found for this water. If it is a forest PFT that was removed we will just add the water to
2444	! soil water column of the tall vegetation. Note that it is also possible that last forest
2445	! was removed. In that case there is no longer a tall vegetation water column. In that case
2446	! we need to find a different water column to add the canopy water to. Ideally that would be
2447	! to water column to which the new PFT belongs. For example if the last forest became a cropland
2448	! the water previously stored in the forest canopy should be added to the soil water column
2449	! of the short vegetation. Because the current land cover change functionality only deals
2450	! with net land cover changes we don know the exact changes. An approximation will be used.
2451
2452	! Search for a suitable soil tile index to move the canopy water into
2453	jst=pref_soil_veg(jv)
2454	IF(resdist(ji,jst).GT.zero)THEN
2455	index = jst
2456	ELSE
2457	! Note that dim=1 refers to the dimensions of the answer
2458	index = MAXLOC(resdist(ji,:),DIM=1)
2459	IF(resdist(ji,index).LE.zero)THEN
2460	WRITE(numout,*) 'ipts, index, resdist, ', ji, index, resdist(ji,:)
2461	CALL ipslerr_p(3,'hydrol_tmc_update','if all resdist - see above- are zero',&
2462	'the last vegetation may have been replaced by a non biological land cover',&
2463	'This transfer has not yet been implemented in the code')
2464	END IF
2465	END IF
2466
2467	! Move the canopy water into the surface water
2468	water2infilt(ji,index) = water2infilt(ji,index) + qsintveg(ji,jv)/(resdist(ji,index)*vegtot_old(ji))
2469	qsintveg(ji,jv) = zero
2470
2471	END IF
2472	END DO
2473	END IF
2474	END DO
2475
2476	!! 2. We now deal with the changes of soiltile and corresponding soil moistures
2477	!! Because sum(soiltile)=1 whatever vegtot, we need to distinguish two cases:
2478	!! - when vegtot changes (meaning that the nobio fraction changes too),
2479	!! - and when vegtot does not changes (a priori the most frequent case)
2480
2481	vegtot_upd = SUM(ABS((vegtot(:)-vegtot_old(:)))) .GT. zero ! True if at least one land point with a vegtot change
2482	runoff_upd(:) = zero
2483	drain_upd(:) = zero
2484	IF (vegtot_upd) THEN
2485
2486	! We find here the processing specific to the chnages of nobio fraction and vegtot
2487	delvegtot(:) = vegtot(:) - vegtot_old(:)
2488
2489	DO jst=1,nstm
2490	DO ji=1,kjpindex
2491
2492	IF (delvegtot(ji) .GT. min_sechiba) THEN
2493
2494	!! 2.1. If vegtot increases (nobio decreases), then the mc in each soiltile is decreased
2495	!! assuming the same proportions for each soiltile, and each soil layer
2496
2497	mc(ji,:,jst) = mc(ji,:,jst) * vegtot_old(ji)/vegtot(ji) ! vegtot cannot be zero as > vegtot_old
2498	water2infilt(ji,jst) = water2infilt(ji,jst) * vegtot_old(ji)/vegtot(ji)
2499
2500	ELSE
2501
2502	!! 2.2 If vegtot decreases (nobio increases), then the mc in each soiltile should increase,
2503	!! but should not exceed mcs
2504	!! For simplicity, we choose to send the corresponding water volume to drainage
2505	!! We do the same for water2infilt but send the excess to surface runoff
2506
2507	IF (vegtot(ji) .GT.min_sechiba) THEN
2508	mcaux(ji,:,jst) = mc(ji,:,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji) ! mcaux is the delta mc
2509	ELSE ! we just have nobio in the grid-cell
2510	mcaux(ji,:,jst) = mc(ji,:,jst)
2511	ENDIF
2512
2513	drain_upd(ji) = drain_upd(ji) + dz(2) * ( trois*mcaux(ji,1,jst) + mcaux(ji,2,jst) )/huit
2514	DO jsl = 2,nslm-1
2515	drain_upd(ji) = drain_upd(ji) + dz(jsl) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl-1,jst))/huit &
2516	+ dz(jsl+1) * (trois*mcaux(ji,jsl,jst)+mcaux(ji,jsl+1,jst))/huit
2517	ENDDO
2518	drain_upd(ji) = drain_upd(ji) + dz(nslm) * (trois*mcaux(ji,nslm,jst) + mcaux(ji,nslm-1,jst))/huit
2519
2520	IF (vegtot(ji) .GT.min_sechiba) THEN
2521	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst) * (vegtot_old(ji)-vegtot(ji))/vegtot(ji)
2522	ELSE ! we just have nobio in the grid-cell
2523	runoff_upd(ji) = runoff_upd(ji) + water2infilt(ji,jst)
2524	ENDIF
2525
2526	ENDIF
2527
2528	ENDDO
2529	ENDDO
2530
2531	ENDIF
2532
2533	!! 3. At the end of step 2, we are back to a case where vegtot changes are treated, so we can use soiltile
2534	!! as a fraction of vegtot to process the mc transfers between soil tiles due to the changes of vegetation map
2535
2536	!! 3.1 Check if soiltiles changed since last time step
2537	soil_upd=SUM(ABS(soiltile(:,:)-resdist(:,:))) .GT. zero
2538	IF (printlev>=3) WRITE (numout,*) 'soil_upd ', soil_upd
2539
2540	IF (soil_upd) THEN
2541
2542	!! 3.2 Define the change in soiltile
2543	vmr(:,:) = soiltile(:,:) - resdist(:,:) ! resdist is the previous values of soiltiles, previous timestep, so before new map
2544
2545	! Total area loss by the three soil tiles
2546	DO ji=1,kjpindex
2547	vmr_sum(ji)=SUM(vmr(ji,:),MASK=vmr(ji,:).LT.zero)
2548	ENDDO
2549
2550	!! 3.3 Shrinking soil tiles
2551	!! 3.3.1 Total loss of moisture content from the shrinking soil tiles, expressed by soil layer
2552	mc_dilu(:,:)=zero
2553	DO jst=1,nstm
2554	DO jsl = 1, nslm
2555	DO ji=1,kjpindex
2556	IF ( vmr(ji,jst) < -min_sechiba ) THEN
2557	mc_dilu(ji,jsl) = mc_dilu(ji,jsl) + mc(ji,jsl,jst) * vmr(ji,jst) / vmr_sum(ji)
2558	ENDIF
2559	ENDDO
2560	ENDDO
2561	ENDDO
2562
2563	!! 3.3.2 Total loss of water2inft from the shrinking soil tiles
2564	infil_dilu(:)=zero
2565	DO jst=1,nstm
2566	DO ji=1,kjpindex
2567	IF ( vmr(ji,jst) < -min_sechiba ) THEN
2568	infil_dilu(ji) = infil_dilu(ji) + water2infilt(ji,jst) * vmr(ji,jst) / vmr_sum(ji)
2569	ENDIF
2570	ENDDO
2571	ENDDO
2572
2573	!! 3.4 Each gaining soil tile gets moisture proportionally to both the total loss and its areal increase
2574
2575	! As the original mc from each soil tile are in [mcr,mcs] and we do weighted avrage, the new mc are in [mcr,mcs]
2576	! The case where the soiltile is created (soiltile_old=0) works as the other cases
2577
2578	! 3.4.1 Update mc(kjpindex,nslm,nstm) !m3/m3
2579	DO jst=1,nstm
2580	DO jsl = 1, nslm
2581	DO ji=1,kjpindex
2582	IF ( vmr(ji,jst) > min_sechiba ) THEN
2583	mc(ji,jsl,jst) = ( mc(ji,jsl,jst) * resdist(ji,jst) + mc_dilu(ji,jsl) * vmr(ji,jst) ) / soiltile(ji,jst)
2584	! NB : soiltile can not be zero for case vmr > zero, see slowproc_veget
2585	ENDIF
2586	ENDDO
2587	ENDDO
2588	ENDDO
2589
2590	! 3.4.2 Update water2inft
2591	DO jst=1,nstm
2592	DO ji=1,kjpindex
2593	IF ( vmr(ji,jst) > min_sechiba ) THEN !donc soiltile>0
2594	water2infilt(ji,jst) = ( water2infilt(ji,jst) * resdist(ji,jst) + infil_dilu(ji) * vmr(ji,jst) ) / soiltile(ji,jst)
2595	ENDIF !donc resdist>0
2596	ENDDO
2597	ENDDO
2598
2599	! 3.4.3 Case where soiltile < min_sechiba
2600	DO jst=1,nstm
2601	DO ji=1,kjpindex
2602	IF ( soiltile(ji,jst) .LT. min_sechiba ) THEN
2603	water2infilt(ji,jst) = zero
2604	mc(ji,:,jst) = zero
2605	ENDIF
2606	ENDDO
2607	ENDDO
2608
2609	ENDIF ! soil_upd
2610
2611	!! 4. Update tmc and humtot
2612
2613	DO jst=1,nstm
2614	DO ji=1,kjpindex
2615	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
2616	DO jsl = 2,nslm-1
2617	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
2618	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
2619	ENDDO
2620	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
2621	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
2622	! WARNING tmc is increased by includes water2infilt(ji,jst)
2623	ENDDO
2624	ENDDO
2625
2626	humtot(:) = zero
2627	DO jst=1,nstm
2628	DO ji=1,kjpindex
2629	humtot(ji) = humtot(ji) + vegtot(ji) * soiltile(ji,jst) * tmc(ji,jst) ! average over grid-cell (i.e. total land)
2630	ENDDO
2631	ENDDO
2632
2633
2634	!! Now that the work is done, update resdist
2635	resdist(:,:) = soiltile(:,:)
2636
2637	IF (printlev>=3) WRITE (numout,*) ' hydrol_tmc_update done '
2638
2639	END SUBROUTINE hydrol_tmc_update
2640
2641	!! ================================================================================================================================
2642	!! SUBROUTINE : hydrol_var_init
2643	!!
2644	!>\BRIEF This routine initializes hydrologic parameters to define K and D, and diagnostic hydrologic variables.
2645	!!
2646	!! DESCRIPTION :
2647	!! - 1 compute the depths
2648	!! - 2 compute the profile for roots
2649	!! - 3 compute the profile for a and n Van Genuchten parameter
2650	!! - 4 compute the linearized values of k, a, b and d for the resolution of Fokker Planck equation
2651	!! - 5 water reservoirs initialisation
2652	!!
2653	!! RECENT CHANGE(S) : None
2654	!!
2655	!! MAIN OUTPUT VARIABLE(S) :
2656	!!
2657	!! REFERENCE(S) :
2658	!!
2659	!! FLOWCHART : None
2660	!! \n
2661	!_ ================================================================================================================================
2662	!_ hydrol_var_init
2663
2664	SUBROUTINE hydrol_var_init (ks, nvan, avan, mcr, mcs, mcfc, mcw, &
2665	kjpindex, veget, veget_max, soiltile, njsc, altmax, &
2666	mx_eau_var, shumdiag_perma, &
2667	drysoil_frac, qsintveg, mc_layh, mcl_layh, mc_layh_s, mcl_layh_s)
2668
2669	! interface description
2670
2671	!! 0. Variable and parameter declaration
2672
2673	! input scalar
2674	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size (number of grid cells) (1)
2675	! input fields
2676	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! PFT fractions within grid-cells (1; 1)
2677	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Effective fraction of vegetation by PFT (1; 1)
2678	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
2679	!! in the grid cell (1-nscm, unitless)
2680	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
2681	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
2682	!! Not related with the active soil carbon pool.
2683	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
2684	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
2685	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
2686	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
2687	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
2688	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
2689	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
2690
2691	!! 0.2 Output variables
2692
2693	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mx_eau_var !! Maximum water content of the soil
2694	!! @tex $(kg m^{-2})$ @endtex
2695	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma!! Percent of porosity filled with water (mc/mcs)
2696	!! used for the thermal computations
2697	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: drysoil_frac !! function of litter humidity
2698	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out):: mc_layh !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
2699	REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT (out):: mc_layh_s !! Volumetric soil moisture content for each layer in hydrol(liquid+ice) [m3/m3]
2700	REAL(r_std), DIMENSION(kjpindex,nslm), INTENT (out):: mcl_layh !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
2701	REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT (out):: mcl_layh_s!! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
2702
2703	!! 0.3 Modified variables
2704	REAL(r_std),DIMENSION(kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on vegetation due to interception
2705	!! @tex $(kg m^{-2})$ @endtex
2706
2707
2708	!! 0.4 Local variables
2709	INTEGER(i_std) :: ji, jv !! Grid-cell and PFT indices (1)
2710	INTEGER(i_std) :: jst, jsc, jsl !! Soiltile, Soil Texture, and Soil layer indices (1)
2711	INTEGER(i_std) :: i !! Index (1)
2712	REAL(r_std) :: m !! m=1-1/n (unitless)
2713	REAL(r_std) :: frac !! Relative linearized VWC (unitless)
2714	REAL(r_std) :: avan_mod !! VG parameter a modified from exponantial profile
2715	!! @tex $(mm^{-1})$ @endtex
2716	REAL(r_std) :: nvan_mod !! VG parameter n modified from exponantial profile
2717	!! (unitless)
2718	REAL(r_std), DIMENSION(nslm,kjpindex) :: afact, nfact !! Multiplicative factor for decay of a and n with depth
2719	!! (unitless)
2720	! parameters for "soil densification" with depth
2721	REAL(r_std) :: dp_comp !! Depth at which the 'compacted' value of ksat
2722	!! is reached (m)
2723	REAL(r_std) :: f_ks !! Exponential factor for decay of ksat with depth
2724	!! @tex $(m^{-1})$ @endtex
2725	! Fixed parameters from fitted relationships
2726	REAL(r_std) :: n0 !! fitted value for relation log((n-n0)/(n_ref-n0)) =
2727	!! nk_rel * log(k/k_ref)
2728	!! (unitless)
2729	REAL(r_std) :: nk_rel !! fitted value for relation log((n-n0)/(n_ref-n0)) =
2730	!! nk_rel * log(k/k_ref)
2731	!! (unitless)
2732	REAL(r_std) :: a0 !! fitted value for relation log((a-a0)/(a_ref-a0)) =
2733	!! ak_rel * log(k/k_ref)
2734	!! @tex $(mm^{-1})$ @endtex
2735	REAL(r_std) :: ak_rel !! fitted value for relation log((a-a0)/(a_ref-a0)) =
2736	!! ak_rel * log(k/k_ref)
2737	!! (unitless)
2738	REAL(r_std) :: kfact_max !! Maximum factor for Ks decay with depth (unitless)
2739	REAL(r_std) :: k_tmp, tmc_litter_ratio
2740	INTEGER(i_std), PARAMETER :: error_level = 3 !! Error level for consistency check
2741	!! Switch to 2 tu turn fatal errors into warnings
2742	REAL(r_std), DIMENSION (kjpindex,nslm) :: alphavg !! VG param a modified with depth at each node
2743	!! @tex $(mm^{-1})$ @endtexe
2744	REAL(r_std), DIMENSION (kjpindex,nslm) :: nvg !! VG param n modified with depth at each node
2745	!! (unitless)
2746	!! need special treatment
2747	INTEGER(i_std) :: ii
2748	INTEGER(i_std) :: iiref !! To identify the mc_lins where k_lin and d_lin
2749	!! need special treatment
2750	REAL(r_std) :: nroot_tmp
2751	!_ ================================================================================================================================
2752
2753	!Config Key = CWRR_NKS_N0
2754	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
2755	!Config Def = 0.0
2756	!Config If =
2757	!Config Help =
2758	!Config Units = [-]
2759	n0 = 0.0
2760	CALL getin_p("CWRR_NKS_N0",n0)
2761
2762	!! Check parameter value (correct range)
2763	IF ( n0 < zero ) THEN
2764	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2765	& "Wrong parameter value for CWRR_NKS_N0.", &
2766	& "This parameter should be non-negative. ", &
2767	& "Please, check parameter value in run.def. ")
2768	END IF
2769
2770
2771	!Config Key = CWRR_NKS_POWER
2772	!Config Desc = fitted value for relation log((n-n0)/(n_ref-n0)) = nk_rel * log(k/k_ref)
2773	!Config Def = 0.0
2774	!Config If =
2775	!Config Help =
2776	!Config Units = [-]
2777	nk_rel = 0.0
2778	CALL getin_p("CWRR_NKS_POWER",nk_rel)
2779
2780	!! Check parameter value (correct range)
2781	IF ( nk_rel < zero ) THEN
2782	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2783	& "Wrong parameter value for CWRR_NKS_POWER.", &
2784	& "This parameter should be non-negative. ", &
2785	& "Please, check parameter value in run.def. ")
2786	END IF
2787
2788
2789	!Config Key = CWRR_AKS_A0
2790	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
2791	!Config Def = 0.0
2792	!Config If =
2793	!Config Help =
2794	!Config Units = [1/mm]
2795	a0 = 0.0
2796	CALL getin_p("CWRR_AKS_A0",a0)
2797
2798	!! Check parameter value (correct range)
2799	IF ( a0 < zero ) THEN
2800	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2801	& "Wrong parameter value for CWRR_AKS_A0.", &
2802	& "This parameter should be non-negative. ", &
2803	& "Please, check parameter value in run.def. ")
2804	END IF
2805
2806
2807	!Config Key = CWRR_AKS_POWER
2808	!Config Desc = fitted value for relation log((a-a0)/(a_ref-a0)) = ak_rel * log(k/k_ref)
2809	!Config Def = 0.0
2810	!Config If =
2811	!Config Help =
2812	!Config Units = [-]
2813	ak_rel = 0.0
2814	CALL getin_p("CWRR_AKS_POWER",ak_rel)
2815
2816	!! Check parameter value (correct range)
2817	IF ( nk_rel < zero ) THEN
2818	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2819	& "Wrong parameter value for CWRR_AKS_POWER.", &
2820	& "This parameter should be non-negative. ", &
2821	& "Please, check parameter value in run.def. ")
2822	END IF
2823
2824
2825	!Config Key = KFACT_DECAY_RATE
2826	!Config Desc = Factor for Ks decay with depth
2827	!Config Def = 2.0
2828	!Config If =
2829	!Config Help =
2830	!Config Units = [1/m]
2831	f_ks = 2.0
2832	CALL getin_p ("KFACT_DECAY_RATE", f_ks)
2833
2834	!! Check parameter value (correct range)
2835	IF ( f_ks < zero ) THEN
2836	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2837	& "Wrong parameter value for KFACT_DECAY_RATE.", &
2838	& "This parameter should be positive. ", &
2839	& "Please, check parameter value in run.def. ")
2840	END IF
2841
2842
2843	!Config Key = KFACT_STARTING_DEPTH
2844	!Config Desc = Depth for compacted value of Ks
2845	!Config Def = 0.3
2846	!Config If =
2847	!Config Help =
2848	!Config Units = [m]
2849	dp_comp = 0.3
2850	CALL getin_p ("KFACT_STARTING_DEPTH", dp_comp)
2851
2852	!! Check parameter value (correct range)
2853	IF ( dp_comp <= zero ) THEN
2854	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2855	& "Wrong parameter value for KFACT_STARTING_DEPTH.", &
2856	& "This parameter should be positive. ", &
2857	& "Please, check parameter value in run.def. ")
2858	END IF
2859
2860
2861	!Config Key = KFACT_MAX
2862	!Config Desc = Maximum Factor for Ks increase due to vegetation
2863	!Config Def = 10.0
2864	!Config If =
2865	!Config Help =
2866	!Config Units = [-]
2867	kfact_max = 10.0
2868	CALL getin_p ("KFACT_MAX", kfact_max)
2869
2870	!! Check parameter value (correct range)
2871	IF ( kfact_max < 10. ) THEN
2872	CALL ipslerr_p(error_level, "hydrol_var_init.", &
2873	& "Wrong parameter value for KFACT_MAX.", &
2874	& "This parameter should be greater than 10. ", &
2875	& "Please, check parameter value in run.def. ")
2876	END IF
2877
2878
2879
2880	!Config Key = KFACT_ROOT_CONST
2881	!Config Desc = Set constant kfact_root in every soil layer. Otherwise kfact_root increase over soil depth in the rootzone.
2882	!Config If =
2883	!Config Def = n
2884	!Config Help = Use KFACT_ROOT_CONST=true to impose kfact_root=1 in every soil layer. Otherwise kfact_root increase over soil depth in the rootzone.
2885	!Config Units = [y/n]
2886	kfact_root_const = .FALSE.
2887	CALL getin_p("KFACT_ROOT_CONST",kfact_root_const)
2888
2889
2890	!-
2891	!! 1 Create local variables in mm for the vertical depths
2892	!! Vertical depth variables (znh, dnh, dlh) are stored in module vertical_soil_var in m.
2893	DO jsl=1,nslm
2894	zz(jsl) = znh(jsl)*mille
2895	dz(jsl) = dnh(jsl)*mille
2896	dh(jsl) = dlh(jsl)*mille
2897	ENDDO
2898
2899	!-
2900	!! 3 Compute the profile for a and n
2901	!-
2902
2903	! For every soil texture
2904	DO ji = 1, kjpindex
2905	DO jsl=1,nslm
2906	! PhD thesis of d'Orgeval, 2006, p81, Eq. 4.38; d'Orgeval et al. 2008, Eq. 2
2907	! Calibrated against Hapex-Sahel measurements
2908	kfact(jsl,ji) = MIN(MAX(EXP(- f_ks * (zz(jsl)/mille - dp_comp)), un/kfact_max),un)
2909	! PhD thesis of d'Orgeval, 2006, p81, Eqs. 4.39; 4.42, and Fig 4.14
2910
2911	nfact(jsl,ji) = ( kfact(jsl,ji) )**nk_rel
2912	afact(jsl,ji) = ( kfact(jsl,ji) )**ak_rel
2913	ENDDO
2914	ENDDO
2915
2916
2917	! For every grid cell
2918	DO ji = 1, kjpindex
2919	!-
2920	!! 4 Compute the linearized values of k, a, b and d
2921	!! The effect of kfact_root on ks thus on k, a, n and d, is taken into account further in the code,
2922	!! in hydrol_soil_coef.
2923	!-
2924	! Calculate the matrix coef for Dublin model (de Rosnay, 1999; p149)
2925	! piece-wise linearised hydraulic conductivity k_lin=alin * mc_lin + b_lin
2926	! and diffusivity d_lin in each interval of mc, called mc_lin,
2927	! between imin, for residual mcr, and imax for saturation mcs.
2928
2929	! We define 51 bounds for 50 bins of mc between mcr and mcs
2930	mc_lin(imin,ji)=mcr(ji)
2931	mc_lin(imax,ji)=mcs(ji)
2932	DO ii= imin+1, imax-1 ! ii=2,50
2933	mc_lin(ii,ji) = mcr(ji) + (ii-imin)*(mcs(ji)-mcr(ji))/(imax-imin)
2934	ENDDO
2935
2936	DO jsl = 1, nslm
2937	! From PhD thesis of d'Orgeval, 2006, p81, Eq. 4.42
2938	nvan_mod = n0 + (nvan(ji)-n0) * nfact(jsl,ji)
2939	avan_mod = a0 + (avan(ji)-a0) * afact(jsl,ji)
2940	m = un - un / nvan_mod
2941	! Creation of arrays for SP-MIP output by landpoint
2942	nvan_mod_tab(jsl,ji) = nvan_mod
2943	avan_mod_tab(jsl,ji) = avan_mod
2944	! We apply Van Genuchten equation for K(theta) based on Ks(z)=ks(ji) * kfact(jsl,ji)
2945	DO ii = imax,imin,-1
2946	frac=MIN(un,(mc_lin(ii,ji)-mcr(ji))/(mcs(ji)-mcr(ji)))
2947	k_lin(ii,jsl,ji) = ks(ji) * kfact(jsl,ji) * (frac*0.5) ( un - ( un - frac (un/m)) m )**2
2948	ENDDO
2949
2950	! k_lin should not be zero, nor too small
2951	! We track iiref, the bin under which mc is too small and we may get zero k_lin
2952	!salma: ji replaced with ii and jiref replaced with iiref and jsc with ji
2953	ii=imax-1
2954	DO WHILE ((k_lin(ii,jsl,ji) > 1.e-32) .and. (ii>0))
2955	iiref=ii
2956	ii=ii-1
2957	ENDDO
2958	DO ii=iiref-1,imin,-1
2959	k_lin(ii,jsl,ji)=k_lin(ii+1,jsl,ji)/10.
2960	ENDDO
2961
2962	DO ii = imin,imax-1 ! ii=1,50
2963	! We deduce a_lin and b_lin based on continuity between segments k_lin = a_lin*mc-lin+b_lin
2964	a_lin(ii,jsl,ji) = (k_lin(ii+1,jsl,ji)-k_lin(ii,jsl,ji)) / (mc_lin(ii+1,ji)-mc_lin(ii,ji))
2965	b_lin(ii,jsl,ji) = k_lin(ii,jsl,ji) - a_lin(ii,jsl,ji)*mc_lin(ii,ji)
2966
2967	! We calculate the d_lin for each mc bin, from Van Genuchten equation for D(theta)
2968	! d_lin is constant and taken as the arithmetic mean between the values at the bounds of each bin
2969	IF (ii.NE.imin .AND. ii.NE.imax-1) THEN
2970	frac=MIN(un,(mc_lin(ii,ji)-mcr(ji))/(mcs(ji)-mcr(ji)))
2971	d_lin(ii,jsl,ji) =(k_lin(ii,jsl,ji) / (avan_modmnvan_mod)) * &
2972	( (frac*(-un/m))/(mc_lin(ii,ji)-mcr(ji)) ) &
2973	( frac(-un/m) -un ) (-m)
2974	frac=MIN(un,(mc_lin(ii+1,ji)-mcr(ji))/(mcs(ji)-mcr(ji)))
2975	d_lin(ii+1,jsl,ji) =(k_lin(ii+1,jsl,ji) / (avan_modmnvan_mod))*&
2976	( (frac*(-un/m))/(mc_lin(ii+1,ji)-mcr(ji)) ) &
2977	( frac(-un/m) -un ) (-m)
2978	d_lin(ii,jsl,ji) = undemi * (d_lin(ii,jsl,ji)+d_lin(ii+1,jsl,ji))
2979	ELSE IF(ii.EQ.imax-1) THEN
2980	d_lin(ii,jsl,ji) =(k_lin(ii,jsl,ji) / (avan_modmnvan_mod)) * &
2981	( (frac*(-un/m))/(mc_lin(ii,ji)-mcr(ji)) ) &
2982	( frac(-un/m) -un ) (-m)
2983	ENDIF
2984	ENDDO !Salma end loop over landpoints
2985
2986	! Special case for ii=imin
2987	d_lin(imin,jsl,ji) = d_lin(imin+1,jsl,ji)/1000.
2988
2989	! We adjust d_lin where k_lin was previously adjusted otherwise we might get non-monotonous variations
2990	! We don't want d_lin = zero
2991	DO ii=iiref-1,imin,-1
2992	d_lin(ii,jsl,ji)=d_lin(ii+1,jsl,ji)/10.
2993	ENDDO
2994
2995	ENDDO
2996	ENDDO
2997
2998	! Output of alphavg and nvg at each node for SP-MIP
2999	DO jsl = 1, nslm
3000	alphavg(:,jsl) = avan_mod_tab(jsl,:)*1000. ! from mm-1 to m-1
3001	nvg(:,jsl) = nvan_mod_tab(jsl,:)
3002	ENDDO
3003	CALL xios_orchidee_send_field("alphavg",alphavg) ! in m-1
3004	CALL xios_orchidee_send_field("nvg",nvg) ! unitless
3005
3006	!! 5 Water reservoir initialisation
3007	!
3008	!!$ DO jst = 1,nstm
3009	!!$ DO ji = 1, kjpindex
3010	!!$ mx_eau_var(ji) = mx_eau_var(ji) + soiltile(ji,jst)*&
3011	!!$ & zmaxhmillemcs(njsc(ji))
3012	!!$ END DO
3013	!!$ END DO
3014
3015	mx_eau_var(:) = zero
3016	mx_eau_var(:) = zmaxhmillemcs(:)
3017
3018	DO ji = 1,kjpindex
3019	IF (vegtot(ji) .LE. zero) THEN
3020	mx_eau_var(ji) = mx_eau_nobio*zmaxh
3021	! Aurelien: what does vegtot=0 mean? is it like frac_nobio=1? But if 0<frac_nobio<1 ???
3022	ENDIF
3023
3024	END DO
3025
3026	! Compute the litter humidity, shumdiag and fry
3027	shumdiag_perma(:,:) = zero
3028	humtot(:) = zero
3029	tmc(:,:) = zero
3030
3031	! Loop on soiltiles to compute the variables (ji,jst)
3032	DO jst=1,nstm
3033	DO ji = 1, kjpindex
3034	tmcs(ji,jst)=zmaxh* mille*mcs(ji)
3035	tmcr(ji,jst)=zmaxh* mille*mcr(ji)
3036	tmcfc(ji,jst)=zmaxh* mille*mcfc(ji)
3037	tmcw(ji,jst)=zmaxh* mille*mcw(ji)
3038	ENDDO
3039	ENDDO
3040
3041	! The total soil moisture for each soiltile:
3042	DO jst=1,nstm
3043	DO ji=1,kjpindex
3044	tmc(ji,jst)= dz(2) * ( trois*mc(ji,1,jst)+ mc(ji,2,jst))/huit
3045	END DO
3046	ENDDO
3047
3048	DO jst=1,nstm
3049	DO jsl=2,nslm-1
3050	DO ji=1,kjpindex
3051	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) * ( trois*mc(ji,jsl,jst) + mc(ji,jsl-1,jst))/huit &
3052	& + dz(jsl+1)(troismc(ji,jsl,jst) + mc(ji,jsl+1,jst))/huit
3053	END DO
3054	END DO
3055	ENDDO
3056
3057	DO jst=1,nstm
3058	DO ji=1,kjpindex
3059	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3060	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
3061	ENDDO
3062	END DO
3063
3064	! Initialize humtot such that twbr is also closed at the first time step
3065	humtot(:) = zero
3066	DO jst=1,nstm
3067	DO ji=1,kjpindex
3068	!average over grid-cell (i.e. total land)
3069	humtot(ji) = humtot(ji) + vegtot(ji) * resdist(ji,jst) * tmc(ji,jst)
3070	ENDDO
3071	ENDDO
3072
3073	!JG: hydrol_tmc_update should not be called in the initialization phase. Call of hydrol_tmc_update makes the model restart differenlty.
3074	! ! If veget has been updated before restart (with LAND USE or DGVM),
3075	! ! tmc and mc must be modified with respect to humtot conservation.
3076	! CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg)
3077
3078	! The litter variables:
3079	! level 1
3080	DO jst=1,nstm
3081	DO ji=1,kjpindex
3082	tmc_litter(ji,jst) = dz(2) * (trois*mcl(ji,1,jst)+mcl(ji,2,jst))/huit
3083	tmc_litter_wilt(ji,jst) = dz(2) * mcw(ji) / deux
3084	tmc_litter_res(ji,jst) = dz(2) * mcr(ji) / deux
3085	tmc_litter_field(ji,jst) = dz(2) * mcfc(ji) / deux
3086	tmc_litter_sat(ji,jst) = dz(2) * mcs(ji) / deux
3087	tmc_litter_awet(ji,jst) = dz(2) * mc_awet(njsc(ji)) / deux
3088	tmc_litter_adry(ji,jst) = dz(2) * mc_adry(njsc(ji)) / deux
3089	ENDDO
3090	END DO
3091	! sum from level 2 to 4
3092	DO jst=1,nstm
3093	DO jsl=2,4
3094	DO ji=1,kjpindex
3095	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
3096	& ( trois*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
3097	& + dz(jsl+1)(troismcl(ji,jsl,jst) + mcl(ji,jsl+1,jst))/huit
3098	tmc_litter_wilt(ji,jst) = tmc_litter_wilt(ji,jst) + &
3099	&(dz(jsl)+ dz(jsl+1))*&
3100	& mcw(ji)/deux
3101	tmc_litter_res(ji,jst) = tmc_litter_res(ji,jst) + &
3102	&(dz(jsl)+ dz(jsl+1))*&
3103	& mcr(ji)/deux
3104	tmc_litter_sat(ji,jst) = tmc_litter_sat(ji,jst) + &
3105	&(dz(jsl)+ dz(jsl+1))* &
3106	& mcs(ji)/deux
3107	tmc_litter_field(ji,jst) = tmc_litter_field(ji,jst) + &
3108	& (dz(jsl)+ dz(jsl+1))* &
3109	& mcfc(ji)/deux
3110	tmc_litter_awet(ji,jst) = tmc_litter_awet(ji,jst) + &
3111	&(dz(jsl)+ dz(jsl+1))* &
3112	& mc_awet(njsc(ji))/deux
3113	tmc_litter_adry(ji,jst) = tmc_litter_adry(ji,jst) + &
3114	& (dz(jsl)+ dz(jsl+1))* &
3115	& mc_adry(njsc(ji))/deux
3116	END DO
3117	END DO
3118	END DO
3119
3120
3121	DO jst=1,nstm
3122	DO ji=1,kjpindex
3123	! here we set that humrelv=0 in PFT1
3124	humrelv(ji,1,jst) = zero
3125	ENDDO
3126	END DO
3127
3128
3129	! Calculate shumdiag_perma for thermosoil
3130	! Use resdist instead of soiltile because we here need to have
3131	! shumdiag_perma at the value from previous time step.
3132	! Here, soilmoist is only used as a temporary variable to calculate shumdiag_perma
3133	! (based on resdist=soiltile from previous timestep, but normally equal to soiltile)
3134	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3135	soilmoist(:,:) = zero
3136	DO jst=1,nstm
3137	DO ji=1,kjpindex
3138	soilmoist(ji,1) = soilmoist(ji,1) + resdist(ji,jst) * &
3139	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
3140	DO jsl = 2,nslm-1
3141	soilmoist(ji,jsl) = soilmoist(ji,jsl) + resdist(ji,jst) * &
3142	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
3143	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
3144	END DO
3145	soilmoist(ji,nslm) = soilmoist(ji,nslm) + resdist(ji,jst) * &
3146	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3147	ENDDO
3148	ENDDO
3149	DO ji=1,kjpindex
3150	soilmoist(ji,:) = soilmoist(ji,:) * vegtot_old(ji) ! grid cell average
3151	ENDDO
3152
3153	soilmoist_s(:,:,:) = zero
3154	DO jst=1,nstm
3155	DO ji=1,kjpindex
3156	soilmoist_s(ji,1,jst) = soilmoist_s(ji,1,jst) + resdist(ji,jst) * &
3157	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
3158	DO jsl = 2,nslm-1
3159	soilmoist_s(ji,jsl,jst) = soilmoist_s(ji,jsl,jst) + resdist(ji,jst) * &
3160	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
3161	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
3162	END DO
3163	soilmoist_s(ji,nslm,jst) = soilmoist_s(ji,nslm,jst) + resdist(ji,jst) * &
3164	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
3165	ENDDO
3166	ENDDO
3167	DO ji=1,kjpindex
3168	soilmoist_s(ji,:,:) = soilmoist_s(ji,:,:) * vegtot_old(ji) ! grid cell average
3169	ENDDO
3170
3171	! -- shumdiag_perma for restart
3172	! For consistency with hydrol_soil, we want to calculate a grid-cell average
3173	DO jsl = 1, nslm
3174	DO ji=1,kjpindex
3175	shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(ji))
3176	shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), un), zero)
3177	ENDDO
3178	ENDDO
3179
3180	! Calculate drysoil_frac if it was not found in the restart file
3181	! For simplicity, we set drysoil_frac to 0.5 in this case
3182	IF (ALL(drysoil_frac(:) == val_exp)) THEN
3183	DO ji=1,kjpindex
3184	drysoil_frac(ji) = 0.5
3185	END DO
3186	END IF
3187
3188	!! Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
3189	!! thermosoil for the thermal conductivity.
3190	! These values are only used in thermosoil_init in absence of a restart file
3191
3192	mc_layh(:,:) = zero
3193	mcl_layh(:,:) = zero
3194	mc_layh_s = mc
3195	mcl_layh_s = mc
3196
3197	DO jst=1,nstm
3198	DO jsl=1,nslm
3199	DO ji=1,kjpindex
3200	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * resdist(ji,jst) * vegtot_old(ji)
3201	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * resdist(ji,jst) * vegtot_old(ji)
3202	ENDDO
3203	END DO
3204	END DO
3205
3206	IF (printlev>=3) WRITE (numout,*) ' hydrol_var_init done '
3207
3208	END SUBROUTINE hydrol_var_init
3209
3210
3211
3212
3213	!! ================================================================================================================================
3214	!! SUBROUTINE : hydrol_canop
3215	!!
3216	!>\BRIEF This routine computes canopy processes.
3217	!!
3218	!! DESCRIPTION :
3219	!! - 1 evaporation off the continents
3220	!! - 1.1 The interception loss is take off the canopy.
3221	!! - 1.2 precip_rain is shared for each vegetation type
3222	!! - 1.3 Limits the effect and sum what receives soil
3223	!! - 1.4 swap qsintveg to the new value
3224	!!
3225	!! RECENT CHANGE(S) : None
3226	!!
3227	!! MAIN OUTPUT VARIABLE(S) :
3228	!!
3229	!! REFERENCE(S) :
3230	!!
3231	!! FLOWCHART : None
3232	!! \n
3233	!_ ================================================================================================================================
3234	!_ hydrol_canop
3235
3236	SUBROUTINE hydrol_canop (kjpindex, precip_rain, vevapwet, veget_max, veget, qsintmax, &
3237	& qsintveg,precisol,tot_melt)
3238
3239	!
3240	! interface description
3241	!
3242
3243	!! 0. Variable and parameter declaration
3244
3245	!! 0.1 Input variables
3246
3247	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
3248	! input fields
3249	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
3250	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max !! max fraction of vegetation type
3251	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: veget !! Fraction of vegetation type
3252	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: qsintmax !! Maximum water on vegetation for interception
3253	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: tot_melt !! Total melt
3254	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: vevapwet !! Interception loss
3255
3256	!! 0.2 Output variables
3257
3258	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: precisol !! Water fallen onto the ground (throughfall+Totmelt)
3259
3260	!! 0.3 Modified variables
3261
3262	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg !! Water on vegetation due to interception
3263
3264	!! 0.4 Local variables
3265
3266	INTEGER(i_std) :: ji, jv
3267	REAL(r_std), DIMENSION (kjpindex,nvm) :: zqsintvegnew
3268
3269	!_ ================================================================================================================================
3270
3271	! boucle sur les points continentaux
3272	! calcul de qsintveg au pas de temps suivant
3273	! par ajout du flux interception loss
3274	! calcule par enerbil en fonction
3275	! des calculs faits dans diffuco
3276	! calcul de ce qui tombe sur le sol
3277	! avec accumulation dans precisol
3278	! essayer d'harmoniser le traitement du sol nu
3279	! avec celui des differents types de vegetation
3280	! fait si on impose qsintmax ( ,1) = 0.0
3281
3282	!! 1 evaporation off the continents
3283
3284	!! 1.1 Precipitation on bare soil
3285	! Precip_rain (mm) needs to be distributed over the different PFTs. Bare soil will also
3286	! receive precipitation but because there is no canopy on bare soil, there is no precipitation
3287	! accumulated on the leaves.
3288	qsintveg(:,1) = zero
3289	precisol(:,1) = veget_max(:,1)*precip_rain(:)
3290
3291	!! 1.2 Interception loss
3292	! Interception loss is taken off the water that is stored on the leaves of the canopy.
3293	! qsintveg has been observed to take on small negative values (-10-e5 to -10e-11). This was
3294	! assumed to be be a consequence of the implicit coupling (see ticket 201). The negative value
3295	! should hovere be small (not clear what small means in this context), At the next time step
3296	! vbeta2 should be zero. In diffuco there are some efforts to avoid this situation but it seems
3297	! that those efforts are not 100%.
3298	DO jv=2,nvm
3299	qsintveg(:,jv) = qsintveg(:,jv) - vevapwet(:,jv)
3300	END DO
3301
3302	!! 1.3 Calculate the water stored on the leaves
3303	! It is raining: precip_rain is shared over the different PFTs. Because the time step
3304	! is rather long (30 minutes) it is unrealistic to assume that all the precipitation
3305	! falling during the time step will be stored on the leaves. If this assumption is not made
3306	! the interception loss will likely be too high. ORCHIDEE overcomes this issue by
3307	! assuming that part of the preciption that intercats with the canopy will be stored
3308	! on the leaves. The leaves will, however, become too heavy and tip. This tipping water will
3309	! become throughfall before it can be intercepted and evaporated. This approach overcomes the
3310	! need to explicitly calculate leaf tipping due to precipitation accumulation. The share of the
3311	! intercepted water that will contribute to this type of throughfall is given by the parameter
3312	! throughfall_by_pft.
3313	DO jv=2,nvm
3314	qsintveg(:,jv) = qsintveg(:,jv) + veget(:,jv) * ((1-throughfall_by_pft(jv))*precip_rain(:))
3315	END DO
3316
3317	!! 1.4 Limits the effect and sum what receives soil
3318	! Calculate the precipitation that is stored on the leaves (zqsintvegnew). Precipitation that
3319	! passes through a canopy gap will not interact with the canopy (veget_max - veget) and will
3320	! therefore contribute directly to throughfall. veget is calculated as the projected leaf area.
3321	! By definition all the precipitation that falls over veget will interact with the canopy
3322	! (as there are no gaps left in veget) but part of this precipitation (described by throughfall_by_pft)
3323	! is moved directly to the throughfall.
3324	DO jv=2,nvm
3325	DO ji = 1, kjpindex
3326	! Calculate the water that remains on the leaf as a water film
3327	zqsintvegnew(ji,jv) = MIN (qsintveg(ji,jv),qsintmax(ji,jv))
3328	! Throughfall is composed by a the precipitation that passes through the gaps without interaction
3329	! and the fraction that interacts. A share of the fraction that intercats with the canopy
3330	! is expected to drip of the leaves due to leaf tipping. This fraction also contributes
3331	! to the throughfall.
3332	precisol(ji,jv) = (veget(ji,jv)throughfall_by_pft(jv)precip_rain(ji)) + &
3333	qsintveg(ji,jv) - zqsintvegnew (ji,jv) + &
3334	(veget_max(ji,jv) - veget(ji,jv))*precip_rain(ji)
3335	ENDDO
3336	END DO
3337
3338	! Precisol is currently the same as throughfall, save it for diagnostics
3339	throughfall(:,:) = precisol(:,:)
3340
3341	!! 1.5 Account for the contribution of snowmelt to throughfall
3342	DO jv=1,nvm
3343	DO ji = 1, kjpindex
3344	IF (vegtot(ji).GT.min_sechiba) THEN
3345	precisol(ji,jv) = precisol(ji,jv)+tot_melt(ji)*veget_max(ji,jv)/vegtot(ji)
3346	ENDIF
3347	ENDDO
3348	END DO
3349
3350	!! 1.6 swap qsintveg to the new value
3351	DO jv=2,nvm
3352	qsintveg(:,jv) = zqsintvegnew (:,jv)
3353	END DO
3354
3355	IF (printlev>=3) WRITE (numout,*) ' hydrol_canop done '
3356
3357	END SUBROUTINE hydrol_canop
3358
3359
3360	!! ================================================================================================================================
3361	!! SUBROUTINE : hydrol_vegupd
3362	!!
3363	!>\BRIEF Vegetation update
3364	!!
3365	!! DESCRIPTION :
3366	!! The vegetation cover has changed and we need to adapt the reservoir distribution
3367	!! and the distribution of plants on different soil types.
3368	!! You may note that this occurs after evaporation and so on have been computed. It is
3369	!! not a problem as a new vegetation fraction will start with humrel=0 and thus will have no
3370	!! evaporation. If this is not the case it should have been caught above.
3371	!!
3372	!! - 1 Update of vegetation is it needed?
3373	!! - 2 calculate water mass that we have to redistribute
3374	!! - 3 put it into reservoir of plant whose surface area has grown
3375	!! - 4 Soil tile gestion
3376	!! - 5 update the corresponding masks
3377	!!
3378	!! RECENT CHANGE(S) : None
3379	!!
3380	!! MAIN OUTPUT VARIABLE(S) :
3381	!!
3382	!! REFERENCE(S) :
3383	!!
3384	!! FLOWCHART : None
3385	!! \n
3386	!_ ================================================================================================================================
3387	!_ hydrol_vegupd
3388
3389	SUBROUTINE hydrol_vegupd(kjpindex, veget, veget_max, soiltile, qsintveg, frac_bare, drain_upd, runoff_upd)
3390
3391
3392	!! 0. Variable and parameter declaration
3393
3394	!! 0.1 Input variables
3395
3396	! input scalar
3397	INTEGER(i_std), INTENT(in) :: kjpindex
3398	! input fields
3399	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget !! New vegetation map
3400	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. fraction of vegetation type
3401	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3402
3403	!! 0.2 Output variables
3404	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: frac_bare !! Fraction(of veget_max) of bare soil
3405	!! in each vegetation type
3406	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: drain_upd !! Change in drainage due to decrease in vegtot
3407	!! on mc [kg/m2/dt]
3408	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: runoff_upd !! Change in runoff due to decrease in vegtot
3409	!! on water2infilt[kg/m2/dt]
3410
3411
3412	!! 0.3 Modified variables
3413
3414	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintveg !! Water on old vegetation
3415
3416	!! 0.4 Local variables
3417
3418	INTEGER(i_std) :: ji,jv,jst
3419
3420	!_ ================================================================================================================================
3421
3422	!! 1 If veget has been updated at last time step (with LAND USE or DGVM),
3423	!! tmc and mc must be modified with respect to humtot conservation.
3424	CALL hydrol_tmc_update ( kjpindex, veget_max, soiltile, qsintveg, drain_upd, runoff_upd)
3425
3426
3427	! Compute the masks for veget
3428
3429	mask_veget(:,:) = 0
3430	mask_soiltile(:,:) = 0
3431
3432	DO jst=1,nstm
3433	DO ji = 1, kjpindex
3434	IF(soiltile(ji,jst) .GT. min_sechiba) THEN
3435	mask_soiltile(ji,jst) = 1
3436	ENDIF
3437	END DO
3438	ENDDO
3439
3440	DO jv = 1, nvm
3441	DO ji = 1, kjpindex
3442	IF(veget_max(ji,jv) .GT. min_sechiba) THEN
3443	mask_veget(ji,jv) = 1
3444	ENDIF
3445	END DO
3446	END DO
3447
3448	! Compute vegetmax_soil
3449	vegetmax_soil(:,:,:) = zero
3450	DO jv = 1, nvm
3451	jst = pref_soil_veg(jv)
3452	DO ji=1,kjpindex
3453	! for veget distribution used in sechiba via humrel
3454	IF (mask_soiltile(ji,jst).GT.0 .AND. vegtot(ji) > min_sechiba) THEN
3455	vegetmax_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
3456	ENDIF
3457	ENDDO
3458	ENDDO
3459
3460	! Calculate frac_bare (previosly done in slowproc_veget)
3461	DO ji =1, kjpindex
3462	IF( veget_max(ji,1) .GT. min_sechiba ) THEN
3463	frac_bare(ji,1) = un
3464	ELSE
3465	frac_bare(ji,1) = zero
3466	ENDIF
3467	ENDDO
3468
3469	IF (ok_bare_soil_new) THEN
3470	! Since the flag ok_bare_soil_new no longer treats the gaps in the canopy as
3471	! bare soil, frac_bare for other PFTs than 1 will be zero.
3472	! Note that the same thing is done in slowproc for tot_bare_soil.
3473	frac_bare(:,2:nvm) = zero
3474
3475	ELSE
3476
3477	DO jv = 2, nvm
3478	DO ji =1, kjpindex
3479	IF( veget_max(ji,jv) .GT. min_sechiba ) THEN
3480	frac_bare(ji,jv) = un - veget(ji,jv)/veget_max(ji,jv)
3481	ELSE
3482	frac_bare(ji,jv) = zero
3483	ENDIF
3484	ENDDO
3485	ENDDO
3486	ENDIF
3487
3488	! Tout dans cette routine est maintenant certainement obsolete (veget_max etant constant) en dehors des lignes
3489	! suivantes et le calcul de frac_bare:
3490	frac_bare_ns(:,:) = zero
3491	DO jst = 1, nstm
3492	DO jv = 1, nvm
3493	DO ji =1, kjpindex
3494	IF(vegtot(ji) .GT. min_sechiba) THEN
3495	frac_bare_ns(ji,jst) = frac_bare_ns(ji,jst) + vegetmax_soil(ji,jv,jst) * frac_bare(ji,jv) / vegtot(ji)
3496	ENDIF
3497	END DO
3498	ENDDO
3499	END DO
3500
3501	IF (printlev>=3) WRITE (numout,*) ' hydrol_vegupd done '
3502
3503	END SUBROUTINE hydrol_vegupd
3504
3505
3506	!! ================================================================================================================================
3507	!! SUBROUTINE : hydrol_flood
3508	!!
3509	!>\BRIEF This routine computes the evolution of the surface reservoir (floodplain).
3510	!!
3511	!! DESCRIPTION :
3512	!! - 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
3513	!! - 2 Compute the total flux from floodplain floodout (transfered to routing)
3514	!! - 3 Discriminate between precip over land and over floodplain
3515	!!
3516	!! RECENT CHANGE(S) : None
3517	!!
3518	!! MAIN OUTPUT VARIABLE(S) :
3519	!!
3520	!! REFERENCE(S) :
3521	!!
3522	!! FLOWCHART : None
3523	!! \n
3524	!_ ================================================================================================================================
3525	!_ hydrol_flood
3526
3527	SUBROUTINE hydrol_flood (kjpindex, vevapflo, flood_frac, flood_res, floodout)
3528
3529	!! 0. Variable and parameter declaration
3530
3531	!! 0.1 Input variables
3532
3533	! input scalar
3534	INTEGER(i_std), INTENT(in) :: kjpindex !!
3535	! input fields
3536	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flood_frac !! Fraction of floodplains in grid box
3537
3538	!! 0.2 Output variables
3539
3540	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: floodout !! Flux to take out from floodplains
3541
3542	!! 0.3 Modified variables
3543
3544	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: flood_res !! Floodplains reservoir estimate
3545	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapflo !! Evaporation over floodplains
3546
3547	!! 0.4 Local variables
3548
3549	INTEGER(i_std) :: ji, jv !! Indices
3550	REAL(r_std), DIMENSION (kjpindex) :: temp !!
3551
3552	!_ ================================================================================================================================
3553	!-
3554	!! 1 Take out vevapflo from the reservoir and transfer the remaining to subsinksoil
3555	!-
3556	DO ji = 1,kjpindex
3557	temp(ji) = MIN(flood_res(ji), vevapflo(ji))
3558	ENDDO
3559	DO ji = 1,kjpindex
3560	flood_res(ji) = flood_res(ji) - temp(ji)
3561	subsinksoil(ji) = subsinksoil(ji) + vevapflo(ji) - temp(ji)
3562	vevapflo(ji) = temp(ji)
3563	ENDDO
3564
3565	!-
3566	!! 2 Compute the total flux from floodplain floodout (transfered to routing)
3567	!-
3568	DO ji = 1,kjpindex
3569	floodout(ji) = vevapflo(ji) - flood_frac(ji) * SUM(precisol(ji,:))
3570	ENDDO
3571
3572	!-
3573	!! 3 Discriminate between precip over land and over floodplain
3574	!-
3575	DO jv=1, nvm
3576	DO ji = 1,kjpindex
3577	precisol(ji,jv) = precisol(ji,jv) * (1 - flood_frac(ji))
3578	ENDDO
3579	ENDDO
3580
3581	IF (printlev>=3) WRITE (numout,*) ' hydrol_flood done'
3582
3583	END SUBROUTINE hydrol_flood
3584
3585
3586	!! ================================================================================================================================
3587	!! SUBROUTINE : hydrol_soil
3588	!!
3589	!>\BRIEF This routine computes soil processes with CWRR scheme (Richards equation solved by finite differences).
3590	!! Note that the water fluxes are in kg/m2/dt_sechiba.
3591	!!
3592	!! DESCRIPTION :
3593	!! 0. Initialisation, and split 2d variables to 3d variables, per soil tile
3594	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
3595	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
3596	!! 1.1 Reduces water2infilt and water2extract to their difference
3597	!! 1.2 To remove water2extract (including bare soilevaporation) from top layer
3598	!! 1.3 Infiltration
3599	!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
3600	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
3601	!! This will act on mcl (liquid water content) only
3602	!! 2.1 K and D are recomputed after infiltration
3603	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
3604	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
3605	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
3606	!! 2.5 Defining where diffusion is solved : everywhere
3607	!! 2.6 We define the system of linear equations for mcl redistribution
3608	!! 2.7 Solves diffusion equations
3609	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
3610	!! 2.9 For water conservation check during redistribution, we calculate the total liquid SM
3611	!! at the end of the routine tridiag, and we compare the difference with the flux...
3612	!! 3. AFTER DIFFUSION/REDISTRIBUTION
3613	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
3614	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
3615	!! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
3616	!! 3.3 Negative runoff is reported to drainage
3617	!! 3.4 Optional block to force saturation below zwt_force
3618	!! 3.5 Diagnosing the effective water table depth
3619	!! 3.6 Diagnose under_mcr to adapt water stress calculation below
3620	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
3621	!! 4.1 Total soil moisture content (water2infilt added below)
3622	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
3623	!! 5. Optional check of the water balance of soil column (if check_cwrr)
3624	!! 5.1 Computation of the vertical water fluxes
3625	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
3626	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
3627	!! 6.2 We need to turn off evaporation when is_under_mcr
3628	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in thermosoil
3629	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
3630	!! -- ENDING THE MAIN LOOP ON SOILTILES
3631	!! 7. Summing 3d variables into 2d variables
3632	!! 8. XIOS export of local variables, including water conservation checks
3633	!! 9. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
3634	!! The principle is to run a dummy integration of the water redistribution scheme
3635	!! to check if the SM profile can sustain a potential evaporation.
3636	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
3637	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
3638	!! 10. evap_bar_lim is the grid-cell scale beta
3639	!!
3640	!! RECENT CHANGE(S) : 2016 by A. Ducharne
3641	!!
3642	!! MAIN OUTPUT VARIABLE(S) :
3643	!!
3644	!! REFERENCE(S) :
3645	!!
3646	!! FLOWCHART : None
3647	!! \n
3648	!_ ================================================================================================================================
3649	!_ hydrol_soil
3650
3651	SUBROUTINE hydrol_soil (ks, nvan, avan, mcr, mcs, mcfc, mcw, &
3652	& kjpindex, veget_max, soiltile, njsc, reinf_slope, &
3653	& transpir, vevapnu, evapot, evapot_penm, runoff, drainage, &
3654	& returnflow, reinfiltration, irrigation, &
3655	& tot_melt, evap_bare_lim, evap_bare_lim_ns, shumdiag, shumdiag_perma,&
3656	& k_litt, litterhumdiag, humrel,vegstress, drysoil_frac, &
3657	& stempdiag,snow, &
3658	& snowdz, tot_bare_soil, u, v, tq_cdrag, mc_layh, mcl_layh, mc_layh_s, &
3659	& mcl_layh_s, e_frac, ksoil, altmax, root_profile, root_depth, &
3660	& circ_class_biomass, us)
3661
3662	!
3663	! interface description
3664
3665	!! 0. Variable and parameter declaration
3666
3667	!! 0.1 Input variables
3668	INTEGER(i_std), INTENT(in) :: kjpindex
3669	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Map of max vegetation types [-]
3670	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class
3671	!! in the grid cell (1-nscm, unitless)
3672	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
3673	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
3674	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
3675	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
3676	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
3677	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
3678	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
3679	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3680	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: transpir !! Transpiration
3681	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3682	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: reinf_slope !! Fraction of surface runoff that reinfiltrates
3683	!! (unitless, [0-1])
3684	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the soil from the bottom
3685	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3686	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
3687	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3688	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Irrigation
3689	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3690	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !! Potential evaporation
3691	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3692	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot_penm !! Potential evaporation "Penman" (Milly's correction)
3693	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3694	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !! Total melt from snow and ice
3695	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3696	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag !! Diagnostic temp profile from thermosoil
3697	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: snow !! Snow mass
3698	!! @tex $(kg m^{-2})$ @endtex
3699	REAL(r_std), DIMENSION (kjpindex,nsnow),INTENT(in) :: snowdz !! Snow depth (m)
3700	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
3701	!! (unitless, [0-1])
3702	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u,v !! Horizontal wind speed
3703	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: tq_cdrag !! Surface drag coefficient
3704	REAL(r_std), DIMENSION(kjpindex,nvm,nslm,nstm),INTENT(in):: e_frac !! Fraction of water transpired supplied by individual layers (no units)
3705	REAL(r_std),DIMENSION (kjpindex,nvm),INTENT(in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
3706	!! Not related with the active soil carbon pool.
3707	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass !! Biomass components of the model tree
3708	!! within a circumference class
3709	!! class @tex $(g C ind^{-1})$ @endtex
3710
3711
3712	!! 0.2 Output variables
3713
3714	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! Surface runoff
3715	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3716	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
3717	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3718	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: evap_bare_lim !! Limitation factor (beta) for bare soil evaporation
3719	!! on each soil column (unitless, [0-1])
3720	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out) :: evap_bare_lim_ns !! Limitation factor (beta) for bare soil evaporation
3721	!! on each soil column (unitless, [0-1])
3722	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag !! Relative soil moisture in each diag soil layer
3723	!! with respect to (mcfc-mcw) (unitless, [0-1])
3724	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs)
3725	!! in each diag soil layer (for the thermal computations)
3726	!! (unitless, [0-1])
3727	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: k_litt !! Litter approximated hydraulic conductivity
3728	!! @tex $(mm d^{-1})$ @endtex
3729	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! Mean of soil_wet_litter across soil tiles
3730	!! (unitless, [0-1])
3731	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation
3732	!! growth) (unitless, [0-1])
3733	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of the litter humidity
3734	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mc_layh !! Volumetric water content (liquid + ice) for each soil layer
3735	!! averaged over the mesh (for thermosoil)
3736	!! @tex $(m^{3} m^{-3})$ @endtex
3737	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT (out) :: mcl_layh !! Volumetric liquid water content for each soil layer
3738	!! averaged over the mesh (for thermosoil)
3739	!! @tex $(m^{3} m^{-3})$ @endtex
3740	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mc_layh_s !! Volumetric soil moisture content for each layer in hydrol(liquid + ice) [m3/m3]
3741	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT (out) :: mcl_layh_s !! Volumetric soil moisture content for each layer in hydrol(liquid) [m3/m3]
3742	REAL(r_std),DIMENSION (kjpindex,nvm,nslm,nroot_prof), INTENT(out) :: root_profile !! Normalized root mass/length fraction in each soil layer
3743	!! (0-1, unitless)
3744	REAL(r_std), DIMENSION (kjpindex,nvm,ndepths), INTENT(out) :: root_depth !! Node and interface numbers at which the deepest roots
3745	!! occur (1 to nslm, unitless)
3746
3747
3748	!! 0.3 Modified variables
3749
3750	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !! Bare soil evaporation
3751	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3752	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel !! Relative humidity (0-1, dimensionless)
3753	REAL(r_std), DIMENSION (kjpindex,nslm,nstm), INTENT(inout) :: ksoil !! Soil conductivity (a copy of k for each soil type)
3754	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(inout) :: us !! Water stress index for transpiration
3755	!! (by soil layer and PFT) (0-1, unitless)
3756
3757
3758
3759	!! 0.4 Local variables
3760
3761	INTEGER(i_std) :: ji, jv, jsl, jst !! Indice
3762	INTEGER(i_std) :: jst_kfact_root !! Indice for kfact_root calculation
3763	REAL(r_std), PARAMETER :: frac_mcs = 0.66 !! Temporary depth
3764	REAL(r_std), DIMENSION(kjpindex) :: temp !! Temporary value for fluxes
3765	REAL(r_std), DIMENSION(kjpindex) :: tmcold !! Total SM at beginning of hydrol_soil (kg/m2)
3766	REAL(r_std), DIMENSION(kjpindex) :: tmcint !! Ancillary total SM (kg/m2)
3767	REAL(r_std), DIMENSION(kjpindex,nslm) :: mcint !! To save mc values for future use
3768	REAL(r_std), DIMENSION(kjpindex,nslm) :: mclint !! To save mcl values for future use
3769	LOGICAL, DIMENSION(kjpindex,nstm) :: is_under_mcr !! Identifies under residual soil moisture points
3770	LOGICAL, DIMENSION(kjpindex) :: is_over_mcs !! Identifies over saturated soil moisture points
3771	REAL(r_std), DIMENSION(kjpindex) :: deltahum,diff !!
3772	LOGICAL(r_std), DIMENSION(kjpindex) :: test !!
3773	REAL(r_std), DIMENSION(kjpindex) :: water2extract !! Water flux to be extracted at the soil surface
3774	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3775	REAL(r_std), DIMENSION(kjpindex) :: returnflow_soil !! Water from the routing back to the bottom of
3776	!! the soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3777	REAL(r_std), DIMENSION(kjpindex) :: reinfiltration_soil !! Water from the routing back to the top of the
3778	!! soil @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3779	REAL(r_std), DIMENSION(kjpindex) :: irrigation_soil !! Water from irrigation returning to soil moisture
3780	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3781	REAL(r_std), DIMENSION(kjpindex) :: flux_infilt !! Water to infiltrate
3782	!! @tex $(kg m^{-2})$ @endtex
3783	REAL(r_std), DIMENSION(kjpindex) :: flux_bottom !! Flux at bottom of the soil column
3784	!! @tex $(kg m^{-2})$ @endtex
3785	REAL(r_std), DIMENSION(kjpindex) :: flux_top !! Flux at top of the soil column (for bare soil evap)
3786	!! @tex $(kg m^{-2})$ @endtex
3787	REAL(r_std), DIMENSION (kjpindex,nstm) :: qinfilt_ns !! Effective infiltration flux per soil tile
3788	!! @tex $(kg m^{-2})$ @endtex
3789	REAL(r_std), DIMENSION (kjpindex) :: qinfilt !! Effective infiltration flux
3790	!! @tex $(kg m^{-2})$ @endtex
3791	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_infilt_ns !! Surface runoff from hydrol_soil_infilt per soil tile
3792	!! @tex $(kg m^{-2})$ @endtex
3793	REAL(r_std), DIMENSION (kjpindex) :: ru_infilt !! Surface runoff from hydrol_soil_infilt
3794	!! @tex $(kg m^{-2})$ @endtex
3795	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr_ns !! Surface runoff produced to correct excess per soil tile
3796	!! @tex $(kg m^{-2})$ @endtex
3797	REAL(r_std), DIMENSION (kjpindex) :: ru_corr !! Surface runoff produced to correct excess
3798	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3799	REAL(r_std), DIMENSION (kjpindex,nstm) :: ru_corr2_ns !! Correction of negative surface runoff per soil tile
3800	!! @tex $(kg m^{-2})$ @endtex
3801	REAL(r_std), DIMENSION (kjpindex) :: ru_corr2 !! Correction of negative surface runoff
3802	!! @tex $(kg m^{-2})$ @endtex
3803	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corr_ns !! Drainage produced to correct excess
3804	!! @tex $(kg m^{-2})$ @endtex
3805	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_corrnum_ns !! Drainage produced to correct numerical errors in tridiag
3806	!! @tex $(kg m^{-2})$ @endtex
3807	REAL(r_std), DIMENSION (kjpindex) :: dr_corr !! Drainage produced to correct excess
3808	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3809	REAL(r_std), DIMENSION (kjpindex) :: dr_corrnum !! Drainage produced to correct numerical errors in tridiag
3810	!! @tex $(kg m^{-2} dt\_sechiba^{-1})$ @endtex
3811	REAL(r_std), DIMENSION (kjpindex,nslm) :: dmc !! Delta mc when forcing saturation (zwt_force)
3812	!! @tex $(m^{3} m^{-3})$ @endtex
3813	REAL(r_std), DIMENSION (kjpindex,nstm) :: dr_force_ns !! Delta drainage when forcing saturation (zwt_force)
3814	!! per soil tile @tex $(kg m^{-2})$ @endtex
3815	REAL(r_std), DIMENSION (kjpindex) :: dr_force !! Delta drainage when forcing saturation (zwt_force)
3816	!! @tex $(kg m^{-2})$ @endtex
3817	REAL(r_std), DIMENSION (kjpindex,nstm) :: wtd_ns !! Effective water table depth (m)
3818	REAL(r_std), DIMENSION (kjpindex) :: wtd !! Mean water table depth in the grid-cell (m)
3819
3820	! For the calculation of soil_wet_ns and us/humrel/vegstress
3821	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm !! Soil moisture of each layer (liquid phase)
3822	!! @tex $(kg m^{-2})$ @endtex
3823	REAL(r_std), DIMENSION (kjpindex,nslm) :: smt !! Soil moisture of each layer (liquid+solid phase)
3824	!! @tex $(kg m^{-2})$ @endtex
3825	REAL(r_std), DIMENSION (kjpindex,nslm) :: smw !! Soil moisture of each layer at wilting point
3826	!! @tex $(kg m^{-2})$ @endtex
3827	REAL(r_std), DIMENSION (kjpindex,nslm) :: smf !! Soil moisture of each layer at field capacity
3828	!! @tex $(kg m^{-2})$ @endtex
3829	REAL(r_std), DIMENSION (kjpindex,nslm) :: sms !! Soil moisture of each layer at saturation
3830	!! @tex $(kg m^{-2})$ @endtex
3831	REAL(r_std), DIMENSION (kjpindex,nslm) :: sm_nostress !! Soil moisture of each layer at which us reaches 1
3832	!! @tex $(kg m^{-2})$ @endtex
3833	! For water conservation checks (in mm/dtstep unless otherwise mentioned)
3834	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_infilt_ns !! Water conservation diagnostic at routine scale
3835	REAL(r_std), DIMENSION (kjpindex,nstm) :: check1_ns !! Water conservation diagnostic at routine scale
3836	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_tr_ns !! Water conservation diagnostic at routine scale
3837	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_over_ns !! Water conservation diagnostic at routine scale
3838	REAL(r_std), DIMENSION (kjpindex,nstm) :: check_under_ns !! Water conservation diagnostic at routine scale
3839	REAL(r_std), DIMENSION(kjpindex) :: tmci !! Total soil moisture at beginning of routine (kg/m2)
3840	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! Total soil moisture at end of routine (kg/m2)
3841	REAL(r_std), DIMENSION(kjpindex) :: diag_tr !! Transpiration flux
3842	REAL(r_std), DIMENSION (kjpindex) :: check_infilt !! Water conservation diagnostic at routine scale
3843	REAL(r_std), DIMENSION (kjpindex) :: check1 !! Water conservation diagnostic at routine scale
3844	REAL(r_std), DIMENSION (kjpindex) :: check_tr !! Water conservation diagnostic at routine scale
3845	REAL(r_std), DIMENSION (kjpindex) :: check_over !! Water conservation diagnostic at routine scale
3846	REAL(r_std), DIMENSION (kjpindex) :: check_under !! Water conservation diagnostic at routine scale
3847
3848	! Diagnostic of the vertical soil water fluxes
3849	REAL(r_std), DIMENSION (kjpindex,nslm) :: qflux !! Local upward flux into soil layer
3850	!! from lower interface
3851	!! @tex $(kg m^{-2})$ @endtex
3852	REAL(r_std), DIMENSION (kjpindex) :: check_top !! Water budget residu in top soil layer
3853	!! @tex $(kg m^{-2})$ @endtex
3854
3855	! Variables for calculation of a soil resistance, option do_rsoil (following the formulation of Sellers et al 1992, implemented in Oleson et al. 2008)
3856	REAL(r_std) :: speed !! magnitude of wind speed required for Aerodynamic resistance
3857	REAL(r_std) :: ra !! diagnosed aerodynamic resistance
3858	REAL(r_std), DIMENSION(kjpindex) :: mc_rel !! first layer relative soil moisture, required for rsoil
3859	REAL(r_std), DIMENSION(kjpindex) :: evap_soil !! soil evaporation from Oleson et al 2008
3860	REAL(r_std), DIMENSION(kjpindex,nstm) :: r_soil_ns !! soil resistance from Oleson et al 2008
3861	REAL(r_std), DIMENSION(kjpindex) :: r_soil !! soil resistance from Oleson et al 2008
3862	REAL(r_std), DIMENSION(kjpindex) :: tmcs_litter !! Saturated soil moisture in the 4 "litter" soil layers
3863	REAL(r_std), DIMENSION(nslm) :: root_profile_tmp !! Temporary variable to calculate the root_profile
3864
3865	! For CMIP6 and SP-MIP : ksat and matric pressure head psi(theta)
3866	REAL(r_std) :: mc_ratio, mvg, avg
3867	REAL(r_std) :: psi !! Matric head (per soil layer and soil tile) [mm=kg/m2]
3868	REAL(r_std), DIMENSION (kjpindex,nslm) :: psi_moy !! Mean matric head per soil layer [mm=kg/m2]
3869	REAL(r_std), DIMENSION (kjpindex,nslm) :: ksat !! Saturated hydraulic conductivity at each node (mm/d)
3870	REAL(r_std), DIMENSION (kjpindex,nvm,nslm,nroot_prof) :: tmp !! temporary variable for writing the root profiles to XIOS
3871
3872	!_ ================================================================================================================================
3873
3874	!! 0.1 Arrays with DIMENSION(kjpindex)
3875
3876	returnflow_soil(:) = zero
3877	reinfiltration_soil(:) = zero
3878	irrigation_soil(:) = zero
3879	qflux_ns(:,:,:) = zero
3880	mc_layh(:,:) = zero ! for thermosoil
3881	mcl_layh(:,:) = zero ! for thermosoil
3882	kk(:,:,:) = zero
3883	kk_moy(:,:) = zero
3884	undermcr(:) = zero ! needs to be initialized outside from jst loop
3885	ksat(:,:) = zero
3886	psi_moy(:,:) = zero
3887
3888	!! Calculate kfact_root
3889	IF ( kfact_root_const ) THEN
3890	kfact_root(:,:,:) = un
3891	ELSE
3892	!! An exponential factor is used to increase ks near the surface depending on the amount of roots in the soil
3893	!! through a geometric average over the vegets
3894	!! This comes from the PhD thesis of d'Orgeval, 2006, p82; d'Orgeval et al. 2008, Eqs. 3-4
3895	!! (Calibrated against Hapex-Sahel measurements)
3896	!! Since rev 2916: veget_max/2 is used instead of veget
3897	kfact_root(:,:,:) = un
3898	DO jsl = 1, nslm
3899	DO jv = 2, nvm
3900	jst_kfact_root = pref_soil_veg(jv)
3901	DO ji = 1, kjpindex
3902	IF (soiltile(ji,jst_kfact_root) .GT. min_sechiba) THEN
3903	kfact_root(ji,jsl,jst_kfact_root) = kfact_root(ji,jsl,jst_kfact_root) * &
3904	MAX((MAXVAL(ks_usda)/ks(ji))*(- vegetmax_soil(ji,jv,jst_kfact_root)/2 (humcste(jv)*zz(jsl)/mille - un)/deux), un)
3905	ENDIF
3906	ENDDO
3907	ENDDO
3908	ENDDO
3909	END IF
3910
3911
3912
3913	IF (ok_freeze_cwrr) THEN
3914
3915	! 0.1 Calculate the temperature and fozen fraction at the hydrological levels
3916	! Calculates profil_froz_hydro_ns as a function of stempdiag and mc if ok_thermodynamical_freezing
3917	! These values will be kept till the end of the prognostic loop
3918	DO jst=1,nstm
3919	CALL hydrol_soil_froz(nvan, avan, mcr, mcs, kjpindex,jst,njsc,stempdiag)
3920	ENDDO
3921
3922	ELSE
3923
3924	profil_froz_hydro_ns(:,:,:) = zero
3925
3926	ENDIF
3927
3928	!! 0.2 Split 2d variables to 3d variables, per soil tile
3929	! Here, the evaporative fluxes are distributed over the soiltiles as a function of the
3930	! corresponding control factors; they are normalized to vegtot
3931	! At step 7, the reverse transformation is used for the fluxes produced in hydrol_soil
3932	! flux_cell(ji)=sum(flux_ns(ji,jst)soiltile(ji,jst)vegtot(ji))
3933
3934	IF(ok_hydrol_arch)THEN
3935
3936	CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, &
3937	evap_bare_lim, evap_bare_lim_ns, tot_bare_soil, us, e_frac)
3938
3939	ELSE
3940
3941	CALL hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, &
3942	evap_bare_lim, evap_bare_lim_ns, tot_bare_soil, us)
3943
3944	ENDIF ! (ok_hydrol_arch)
3945
3946
3947
3948	!! 0.3 Common variables related to routing, with all return flow applied to the soil surface
3949	! The fluxes coming from the routing are uniformly splitted into the soiltiles,
3950	! but are normalized to vegtot like the above fluxes:
3951	! flux_ns(ji,jst)=flux_cell(ji)/vegtot(ji)
3952	! It is the case for : irrigation_soil(ji) and reinfiltration_soil(ji) cf below
3953	! It is also the case for subsinksoil(ji), which is divided by (1-tot_frac_nobio) at creation in hydrol_snow
3954	! AD16*** The transformation in 0.2 and 0.3 is likely to induce conservation problems
3955	! when tot_frac_nobio NE 0, since sum(soiltile) NE vegtot in this case
3956
3957	DO ji=1,kjpindex
3958	IF(vegtot(ji).GT.min_sechiba) THEN
3959	! returnflow_soil is assumed to enter from the bottom, but it is not possible with CWRR
3960	returnflow_soil(ji) = zero
3961	reinfiltration_soil(ji) = (returnflow(ji) + reinfiltration(ji))/vegtot(ji)
3962	irrigation_soil(ji) = irrigation(ji)/vegtot(ji)
3963	ELSE
3964	returnflow_soil(ji) = zero
3965	reinfiltration_soil(ji) = zero
3966	irrigation_soil(ji) = zero
3967	ENDIF
3968	ENDDO
3969
3970	!! -- START MAIN LOOP (prognostic loop to update mc and mcl) OVER SOILTILES
3971	!! The called subroutines work on arrays with DIMENSION(kjpindex),
3972	!! recursively used for each soiltile jst
3973
3974	DO jst = 1,nstm
3975
3976	is_under_mcr(:,jst) = .FALSE.
3977	is_over_mcs(:) = .FALSE.
3978
3979	!! 0.4. Keep initial values for future check-up
3980
3981	! Total moisture content (including water2infilt) is saved for balance checks at the end
3982	! In hydrol_tmc_update, tmc is increased by water2infilt(ji,jst), but mc is not modified !
3983	tmcold(:) = tmc(:,jst)
3984
3985	! The value of mc is kept in mcint (nstm dimension removed), in case needed for water balance checks
3986	DO jsl = 1, nslm
3987	DO ji = 1, kjpindex
3988	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
3989	ENDDO
3990	ENDDO
3991	!
3992	! Initial total moisture content : tmcint does not include water2infilt, contrarily to tmcold
3993	DO ji = 1, kjpindex
3994	tmcint(ji) = dz(2) * ( trois*mcint(ji,1) + mcint(ji,2) )/huit
3995	ENDDO
3996	DO jsl = 2,nslm-1
3997	DO ji = 1, kjpindex
3998	tmcint(ji) = tmcint(ji) + dz(jsl) &
3999	& * (trois*mcint(ji,jsl)+mcint(ji,jsl-1))/huit &
4000	& + dz(jsl+1) * (trois*mcint(ji,jsl)+mcint(ji,jsl+1))/huit
4001	ENDDO
4002	ENDDO
4003	DO ji = 1, kjpindex
4004	tmcint(ji) = tmcint(ji) + dz(nslm) &
4005	& * (trois * mcint(ji,nslm) + mcint(ji,nslm-1))/huit
4006	ENDDO
4007
4008	!! 1. FIRSTLY, WE CHANGE MC BASED ON EXTERNAL FLUXES, ALL APPLIED AT THE SOIL SURFACE
4009	!! Input = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) + precisol_ns(ji,jst)
4010	!! - negative evaporation fluxes (MIN(ae_ns(ji,jst),zero)+ MIN(subsinksoil(ji),zero))
4011	!! Output = MAX(ae_ns(ji,jst),zero) + subsinksoil(ji) = positive evaporation flux = water2extract
4012	! In practice, negative subsinksoil(ji) is not possible
4013
4014	!! 1.1 Reduces water2infilt and water2extract to their difference
4015
4016	! Compares water2infilt and water2extract to keep only difference
4017	! Here, temp is used as a temporary variable to store the min of water to infiltrate vs evaporate
4018	DO ji = 1, kjpindex
4019	temp(ji) = MIN(water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
4020	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst), &
4021	MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) )
4022	ENDDO
4023
4024	! The water to infiltrate at the soil surface is either 0, or the difference to what has to be evaporated
4025	! - the initial water2infilt (right hand side) results from qsintveg changes with vegetation updates
4026	! - irrigation_soil is the input flux to the soil surface from irrigation
4027	! - reinfiltration_soil is the input flux to the soil surface from routing 'including returnflow)
4028	! - eventually, water2infilt holds all fluxes to the soil surface except precisol (reduced by water2extract)
4029	DO ji = 1, kjpindex
4030	water2infilt(ji,jst) = water2infilt(ji,jst) + irrigation_soil(ji) + reinfiltration_soil(ji) &
4031	- MIN(ae_ns(ji,jst),zero) - MIN(subsinksoil(ji),zero) + precisol_ns(ji,jst) &
4032	- temp(ji)
4033	ENDDO
4034
4035	! The water to evaporate from the sol surface is either the difference to what has to be infiltrated, or 0
4036	! - subsinksoil is the residual from sublimation is the snowpack is not sufficient
4037	! - how are the negative values of ae_ns taken into account ???
4038	DO ji = 1, kjpindex
4039	water2extract(ji) = MAX(ae_ns(ji,jst),zero) + MAX(subsinksoil(ji),zero) - temp(ji)
4040	ENDDO
4041
4042	! Here we acknowledge that subsinksoil is part of ae_ns, but ae_ns is not used further
4043	ae_ns(:,jst) = ae_ns(:,jst) + subsinksoil(:)
4044
4045	!! 1.2 To remove water2extract (including bare soil) from top layer
4046	flux_top(:) = water2extract(:)
4047
4048	!! 1.3 Infiltration
4049
4050	!! Definition of flux_infilt
4051	DO ji = 1, kjpindex
4052	! Initialise the flux to be infiltrated
4053	flux_infilt(ji) = water2infilt(ji,jst)
4054	ENDDO
4055
4056	!! K and D are computed for the profile of mc before infiltration
4057	!! They depend on the fraction of soil ice, given by profil_froz_hydro_ns
4058	CALL hydrol_soil_coef(mcr, mcs, kjpindex,jst,njsc)
4059
4060	!! Infiltration and surface runoff are computed
4061	!! Infiltration stems from comparing liquid water2infilt to initial total mc (liquid+ice)
4062	!! The conductivity comes from hydrol_soil_coef and relates to the liquid phase only
4063	! This seems consistent with ok_freeze
4064	CALL hydrol_soil_infilt(ks, nvan, avan, mcr, mcs, mcfc, mcw, kjpindex, jst, njsc, flux_infilt, stempdiag, &
4065	qinfilt_ns, ru_infilt_ns, check_infilt_ns)
4066	ru_ns(:,jst) = ru_infilt_ns(:,jst)
4067
4068	!! 1.4 Reinfiltration of surface runoff : compute temporary surface water and extract from runoff
4069	! Evrything here is liquid
4070	! RK: water2infilt is both a volume for future reinfiltration (in mm) and a correction term for surface runoff (in mm/dt_sechiba)
4071	IF ( .NOT. doponds ) THEN ! this is the general case...
4072	DO ji = 1, kjpindex
4073	water2infilt(ji,jst) = reinf_slope(ji) * ru_ns(ji,jst)
4074	ENDDO
4075	ELSE
4076	DO ji = 1, kjpindex
4077	water2infilt(ji,jst) = zero
4078	ENDDO
4079	ENDIF
4080	!
4081	DO ji = 1, kjpindex
4082	ru_ns(ji,jst) = ru_ns(ji,jst) - water2infilt(ji,jst)
4083	END DO
4084
4085	!! 2. SECONDLY, WE UPDATE MC FROM DIFFUSION, INCLUDING DRAINAGE AND ROOTSINK
4086	!! This will act on mcl only
4087
4088	!! 2.1 K and D are recomputed after infiltration
4089	!! They depend on the fraction of soil ice, still given by profil_froz_hydro_ns
4090	CALL hydrol_soil_coef(mcr, mcs, kjpindex,jst,njsc)
4091
4092	!! 2.2 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
4093	!! This process will further act on mcl only, based on a, b, d from hydrol_soil_coef
4094	CALL hydrol_soil_setup(kjpindex,jst)
4095
4096	!! 2.3 We define mcl (liquid water content) based on mc and profil_froz_hydro_ns
4097	DO jsl = 1, nslm
4098	DO ji =1, kjpindex
4099	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(ji) + &
4100	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(ji)) )
4101	! we always have mcl<=mc
4102	! if mc>mcr, then mcl>mcr; if mc=mcr,mcl=mcr; if mc<mcr, then mcl<mcr
4103	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4104	ENDDO
4105	ENDDO
4106
4107	! The value of mcl is kept in mclint (nstm dimension removed), used in the flux computation after diffusion
4108	DO jsl = 1, nslm
4109	DO ji = 1, kjpindex
4110	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
4111	ENDDO
4112	ENDDO
4113
4114	!! 2.3bis Diagnostic of the matric potential used for redistribution by Richards/tridiag (in m)
4115	! We use VG relationship giving psi as a function of mc (mcl in our case)
4116	! With patches against numerical pbs when (mc_ratio - un) becomes very slightly negative (gives NaN)
4117	! or if psi become too strongly negative (pbs with xios output)
4118	DO jsl=1, nslm
4119	DO ji = 1, kjpindex
4120	IF (soiltile(ji,jst) .GT. zero) THEN
4121	mvg = un - un / nvan_mod_tab(jsl,ji)
4122	avg = avan_mod_tab(jsl,ji)*1000. ! to convert in m-1
4123	mc_ratio = MAX( 10.*(-14mvg), (mcl(ji,jsl,jst) - mcr(ji))/(mcs(ji) - mcr(ji)) )**(-un/mvg)
4124	psi = - MAX(zero,(mc_ratio - un))**(un/nvan_mod_tab(jsl,ji)) / avg ! in m
4125	psi_moy(ji,jsl) = psi_moy(ji,jsl) + soiltile(ji,jst) * psi ! average across soil tiles
4126	ENDIF
4127	ENDDO
4128	ENDDO
4129
4130	!! 2.4 We calculate the total SM at the beginning of the routine tridiag for water conservation check
4131	! (on mcl only, since the diffusion only modifies mcl)
4132	tmci(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
4133	DO jsl = 2,nslm-1
4134	tmci(:) = tmci(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4135	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4136	ENDDO
4137	tmci(:) = tmci(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4138
4139	!! 2.5 Defining where diffusion is solved : everywhere
4140	!! Since mc>mcs is not possible after infiltration, and we accept that mc<mcr
4141	!! (corrected later by shutting off all evaporative fluxes in this case)
4142	! Nothing is done if resolv=F
4143	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
4144
4145	!! 2.6 We define the system of linear equations for mcl redistribution,
4146	!! based on the matrix coefficients from hydrol_soil_setup
4147	!! following the PhD thesis of de Rosnay (1999), p155-157
4148	!! The bare soil evaporation (subtracted from infiltration) is used directly as flux_top
4149	! rhs for right-hand side term; fp for f'; gp for g'; ep for e'; with flux=0 !
4150
4151	!- First layer
4152	DO ji = 1, kjpindex
4153	tmat(ji,1,1) = zero
4154	tmat(ji,1,2) = f(ji,1)
4155	tmat(ji,1,3) = g1(ji,1)
4156	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
4157	& - flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day) - rootsink(ji,1,jst)
4158	ENDDO
4159	!- soil body
4160	DO jsl=2, nslm-1
4161	DO ji = 1, kjpindex
4162	tmat(ji,jsl,1) = e(ji,jsl)
4163	tmat(ji,jsl,2) = f(ji,jsl)
4164	tmat(ji,jsl,3) = g1(ji,jsl)
4165	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4166	& + gp(ji,jsl) * mcl(ji,jsl+1,jst) &
4167	& + (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux &
4168	& - rootsink(ji,jsl,jst)
4169	ENDDO
4170	ENDDO
4171	!- Last layer, including drainage
4172	DO ji = 1, kjpindex
4173	jsl=nslm
4174	tmat(ji,jsl,1) = e(ji,jsl)
4175	tmat(ji,jsl,2) = f(ji,jsl)
4176	tmat(ji,jsl,3) = zero
4177	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4178	& + (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux &
4179	& - rootsink(ji,jsl,jst)
4180	ENDDO
4181	!- Store the equations in case needed again
4182	DO jsl=1,nslm
4183	DO ji = 1, kjpindex
4184	srhs(ji,jsl) = rhs(ji,jsl)
4185	stmat(ji,jsl,1) = tmat(ji,jsl,1)
4186	stmat(ji,jsl,2) = tmat(ji,jsl,2)
4187	stmat(ji,jsl,3) = tmat(ji,jsl,3)
4188	ENDDO
4189	ENDDO
4190
4191	!! 2.7 Solves diffusion equations, but only in grid-cells where resolv is true, i.e. everywhere (cf 2.2)
4192	!! The result is an updated mcl profile
4193
4194	CALL hydrol_soil_tridiag(kjpindex,jst)
4195
4196	!! 2.8 Computes drainage = bottom boundary condition, consistent with rhs(ji,jsl=nslm)
4197	! dr_ns in mm/dt_sechiba, from k in mm/d
4198	! This should be done where resolv=T, like tridiag (drainage is part of the linear system !)
4199	DO ji = 1, kjpindex
4200	IF (resolv(ji)) THEN
4201	dr_ns(ji,jst) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst) * (dt_sechiba/one_day)
4202	ELSE
4203	dr_ns(ji,jst) = zero
4204	ENDIF
4205	ENDDO
4206
4207	!! 2.9 For water conservation check during redistribution AND CORRECTION,
4208	!! we calculate the total liquid SM at the end of the routine tridiag
4209	tmcf(:) = dz(2) * ( trois*mcl(:,1,jst) + mcl(:,2,jst) )/huit
4210	DO jsl = 2,nslm-1
4211	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4212	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4213	ENDDO
4214	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4215
4216	!! And we compare the difference with the flux...
4217	! Normally, tcmf=tmci-flux_top(ji)-transpir-dr_ns
4218	DO ji=1,kjpindex
4219	diag_tr(ji)=SUM(rootsink(ji,:,jst))
4220	ENDDO
4221	! Here, check_tr_ns holds the inaccuracy during the redistribution phase
4222	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:))
4223
4224	!! We solve here the numerical errors that happen when the soil is close to saturation
4225	!! and drainage very high, and which lead to negative check_tr_ns: the soil dries more
4226	!! than what is demanded by the fluxes, so we need to increase the fluxes.
4227	!! This is done by increasing the drainage.
4228	!! There are also instances of positive check_tr_ns, larger when the drainage is high
4229	!! They are similarly corrected by a decrease of dr_ns, in the limit of keeping a positive drainage.
4230	DO ji=1,kjpindex
4231	IF ( check_tr_ns(ji,jst) .LT. zero ) THEN
4232	dr_corrnum_ns(ji,jst) = -check_tr_ns(ji,jst)
4233	ELSE
4234	dr_corrnum_ns(ji,jst) = -MIN(dr_ns(ji,jst),check_tr_ns(ji,jst))
4235	ENDIF
4236	dr_ns(ji,jst) = dr_ns(ji,jst) + dr_corrnum_ns(ji,jst) ! dr_ns increases/decrease if check_tr negative/positive
4237	ENDDO
4238	!! For water conservation check during redistribution
4239	IF (check_cwrr) THEN
4240	check_tr_ns(:,jst) = tmcf(:)-(tmci(:)-flux_top(:)-dr_ns(:,jst)-diag_tr(:))
4241	ENDIF
4242
4243	!! 3. AFTER DIFFUSION/REDISTRIBUTION
4244
4245	!! 3.1 Updating mc, as all the following checks against saturation will compare mc to mcs
4246	! The frozen fraction is constant, so that any water flux to/from a layer changes
4247	! both mcl and the ice amount. The assumption behind this is that water entering/leaving
4248	! a soil layer immediately freezes/melts with the proportion profil_froz_hydro_ns/(1-profil_...)
4249	DO jsl = 1, nslm
4250	DO ji =1, kjpindex
4251	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
4252	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(ji)) )
4253	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
4254	ENDDO
4255	ENDDO
4256
4257	!! 3.2 Correct here the possible over-saturation values (subroutine hydrol_soil_smooth_over_mcs2 acts on mc)
4258	! Oversaturation results from numerical inaccuracies and can be frequent if free_drain_coef=0
4259	! Here hydrol_soil_smooth_over_mcs2 discard all excess as ru_corr_ns, oriented to either ru_ns or dr_ns
4260	! The former routine hydrol_soil_smooth_over_mcs, which keeps most of the excess in the soiltile
4261	! after smoothing, first downward then upward, is kept in the module but not used here
4262	dr_corr_ns(:,jst) = zero
4263	ru_corr_ns(:,jst) = zero
4264	call hydrol_soil_smooth_over_mcs2(mcs, kjpindex, jst, njsc, is_over_mcs, ru_corr_ns, check_over_ns)
4265
4266	! In absence of freezing, if F is large enough, the correction of oversaturation is sent to drainage
4267	DO ji = 1, kjpindex
4268	IF ((free_drain_coef(ji,jst) .GE. 0.5) .AND. (.NOT. ok_freeze_cwrr) ) THEN
4269	dr_corr_ns(ji,jst) = ru_corr_ns(ji,jst)
4270	ru_corr_ns(ji,jst) = zero
4271	ENDIF
4272	ENDDO
4273	dr_ns(:,jst) = dr_ns(:,jst) + dr_corr_ns(:,jst)
4274	ru_ns(:,jst) = ru_ns(:,jst) + ru_corr_ns(:,jst)
4275
4276	!! 3.3 Negative runoff is reported to drainage
4277	! Since we computed ru_ns directly from hydrol_soil_infilt, ru_ns should not be negative
4278
4279	ru_corr2_ns(:,jst) = zero
4280	DO ji = 1, kjpindex
4281	IF (ru_ns(ji,jst) .LT. zero) THEN
4282	IF (printlev>=3) WRITE (numout,*) 'NEGATIVE RU_NS: runoff and drainage before correction',&
4283	ru_ns(ji,jst),dr_ns(ji,jst)
4284	dr_ns(ji,jst)=dr_ns(ji,jst)+ru_ns(ji,jst)
4285	ru_corr2_ns(ji,jst) = -ru_ns(ji,jst)
4286	ru_ns(ji,jst)= 0.
4287	END IF
4288	ENDDO
4289
4290	!! 3.4.1 Optional nudging for soil moisture
4291	IF (ok_nudge_mc) THEN
4292	CALL hydrol_nudge_mc(kjpindex, jst, mc)
4293	END IF
4294
4295
4296	!! 3.4.2 Optional block to force saturation below zwt_force
4297	! This block is not compatible with freezing; in this case, mcl must be corrected too
4298	! We test if zwt_force(1,jst) <= zmaxh, to avoid steps 1 and 2 if unnecessary
4299
4300	IF (zwt_force(1,jst) <= zmaxh) THEN
4301
4302	!! We force the nodes below zwt_force to be saturated
4303	! As above, we compare mc to mcs
4304	DO jsl = 1,nslm
4305	DO ji = 1, kjpindex
4306	dmc(ji,jsl) = zero
4307	IF ( ( zz(jsl) >= zwt_force(ji,jst)*mille ) ) THEN
4308	dmc(ji,jsl) = mcs(ji) - mc(ji,jsl,jst) ! addition to reach mcs (m3/m3) = positive value
4309	mc(ji,jsl,jst) = mcs(ji)
4310	ENDIF
4311	ENDDO
4312	ENDDO
4313
4314	!! To ensure conservation, this needs to be balanced by a negative change in drainage (in kg/m2/dt)
4315	DO ji = 1, kjpindex
4316	dr_force_ns(ji,jst) = dz(2) * ( trois*dmc(ji,1) + dmc(ji,2) )/huit ! top layer = initialization
4317	ENDDO
4318	DO jsl = 2,nslm-1 ! intermediate layers
4319	DO ji = 1, kjpindex
4320	dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(jsl) &
4321	& * (trois*dmc(ji,jsl)+dmc(ji,jsl-1))/huit &
4322	& + dz(jsl+1) * (trois*dmc(ji,jsl)+dmc(ji,jsl+1))/huit
4323	ENDDO
4324	ENDDO
4325	DO ji = 1, kjpindex
4326	dr_force_ns(ji,jst) = dr_force_ns(ji,jst) + dz(nslm) & ! bottom layer
4327	& * (trois * dmc(ji,nslm) + dmc(ji,nslm-1))/huit
4328	dr_ns(ji,jst) = dr_ns(ji,jst) - dr_force_ns(ji,jst) ! dr_force_ns is positive and dr_ns must be reduced
4329	END DO
4330
4331	ELSE
4332
4333	dr_force_ns(:,jst) = zero
4334
4335	ENDIF
4336
4337	!! 3.5 Diagnosing the effective water table depth:
4338	!! Defined as as the smallest jsl value when mc(jsl) is no more at saturation (mcs), starting from the bottom
4339	! If there is a part of the soil which is saturated but underlain with unsaturated nodes,
4340	! this is not considered as a water table
4341	DO ji = 1, kjpindex
4342	wtd_ns(ji,jst) = undef_sechiba ! in meters
4343	jsl=nslm
4344	DO WHILE ( (mc(ji,jsl,jst) .EQ. mcs(ji)) .AND. (jsl > 1) )
4345	wtd_ns(ji,jst) = zz(jsl)/mille ! in meters
4346	jsl=jsl-1
4347	ENDDO
4348	ENDDO
4349
4350	!! 3.6 Diagnose under_mcr to adapt water stress calculation below
4351	! This routine does not change tmc but decides where we should turn off ET to prevent further mc decrease
4352	! Like above, the tests are made on total mc, compared to mcr
4353	CALL hydrol_soil_smooth_under_mcr(mcr, kjpindex, jst, njsc, is_under_mcr, check_under_ns)
4354
4355	!! 4. At the end of the prognostic calculations, we recompute important moisture variables
4356
4357	!! 4.1 Total soil moisture content (water2infilt added below)
4358	DO ji = 1, kjpindex
4359	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
4360	ENDDO
4361	DO jsl = 2,nslm-1
4362	DO ji = 1, kjpindex
4363	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
4364	& * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
4365	& + dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
4366	ENDDO
4367	ENDDO
4368	DO ji = 1, kjpindex
4369	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
4370	& * (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
4371	END DO
4372
4373	!! 4.2 mcl is a module variable; we update it here for calculating bare soil evaporation,
4374	!! and in case we would like to export it (xios)
4375	DO jsl = 1, nslm
4376	DO ji =1, kjpindex
4377	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(ji) + &
4378	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(ji)) )
4379	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4380	ENDDO
4381	ENDDO
4382
4383	!! 5. Optional check of the water balance of soil column (if check_cwrr)
4384
4385	IF (check_cwrr) THEN
4386
4387	!! 5.1 Computation of the vertical water fluxes and water balance of the top layer
4388	CALL hydrol_diag_soil_flux(kjpindex,jst,mclint,flux_top)
4389
4390	ENDIF
4391
4392	!! 6. SM DIAGNOSTICS FOR OTHER ROUTINES, MODULES, OR NEXT STEP
4393	! Starting here, mc and mcl should not change anymore
4394
4395	!! 6.1 Total soil moisture, soil moisture at litter levels, soil wetness, us, humrelv, vesgtressv
4396	!! (based on mc)
4397
4398	!! In output, tmc includes water2infilt(ji,jst)
4399	DO ji=1,kjpindex
4400	tmc(ji,jst) = tmc(ji,jst) + water2infilt(ji,jst)
4401	END DO
4402
4403	! The litter is the 4 top levels of the soil
4404	! Compute various field of soil moisture for the litter (used for stomate and for albedo)
4405	! We exclude the frozen water from the calculation
4406	DO ji=1,kjpindex
4407	tmc_litter(ji,jst) = dz(2) * ( trois*mcl(ji,1,jst)+ mcl(ji,2,jst))/huit
4408	END DO
4409	! sum from level 1 to 4
4410	DO jsl=2,4
4411	DO ji=1,kjpindex
4412	tmc_litter(ji,jst) = tmc_litter(ji,jst) + dz(jsl) * &
4413	& ( trois*mcl(ji,jsl,jst) + mcl(ji,jsl-1,jst))/huit &
4414	& + dz(jsl+1)(troismcl(ji,jsl,jst) + mcl(ji,jsl+1,jst))/huit
4415	END DO
4416	END DO
4417
4418	! Subsequent calculation of soil_wet_litter (tmc-tmcw)/(tmcfc-tmcw)
4419	! Based on liquid water content
4420	DO ji=1,kjpindex
4421	soil_wet_litter(ji,jst) = MIN(un, MAX(zero,&
4422	& (tmc_litter(ji,jst)-tmc_litter_wilt(ji,jst)) / &
4423	& (tmc_litter_field(ji,jst)-tmc_litter_wilt(ji,jst)) ))
4424	END DO
4425
4426	! Preliminary calculation of various soil moistures (for each layer, in kg/m2)
4427	sm(:,1) = dz(2) * (trois*mcl(:,1,jst) + mcl(:,2,jst))/huit
4428	smt(:,1) = dz(2) * (trois*mc(:,1,jst) + mc(:,2,jst))/huit
4429	smw(:,1) = dz(2) * (quatre*mcw(:))/huit
4430	smf(:,1) = dz(2) * (quatre*mcfc(:))/huit
4431	sms(:,1) = dz(2) * (quatre*mcs(:))/huit
4432	DO jsl = 2,nslm-1
4433	sm(:,jsl) = dz(jsl) * (trois*mcl(:,jsl,jst)+mcl(:,jsl-1,jst))/huit &
4434	+ dz(jsl+1) * (trois*mcl(:,jsl,jst)+mcl(:,jsl+1,jst))/huit
4435	smt(:,jsl) = dz(jsl) * (trois*mc(:,jsl,jst)+mc(:,jsl-1,jst))/huit &
4436	+ dz(jsl+1) * (trois*mc(:,jsl,jst)+mc(:,jsl+1,jst))/huit
4437	smw(:,jsl) = dz(jsl) * ( quatre*mcw(:) )/huit &
4438	+ dz(jsl+1) * ( quatre*mcw(:) )/huit
4439	smf(:,jsl) = dz(jsl) * ( quatre*mcfc(:) )/huit &
4440	+ dz(jsl+1) * ( quatre*mcfc(:) )/huit
4441	sms(:,jsl) = dz(jsl) * ( quatre*mcs(:) )/huit &
4442	+ dz(jsl+1) * ( quatre*mcs(:) )/huit
4443	ENDDO
4444	sm(:,nslm) = dz(nslm) * (trois*mcl(:,nslm,jst) + mcl(:,nslm-1,jst))/huit
4445	smt(:,nslm) = dz(nslm) * (trois*mc(:,nslm,jst) + mc(:,nslm-1,jst))/huit
4446	smw(:,nslm) = dz(nslm) * (quatre*mcw(:))/huit
4447	smf(:,nslm) = dz(nslm) * (quatre*mcfc(:))/huit
4448	sms(:,nslm) = dz(nslm) * (quatre*mcs(:))/huit
4449	! sm_nostress = soil moisture of each layer at which us reaches 1, here at the middle of [smw,smf]
4450	DO jsl = 1,nslm
4451	sm_nostress(:,jsl) = smw(:,jsl) + pcent(njsc(:)) * (smf(:,jsl)-smw(:,jsl))
4452	END DO
4453
4454	! Saturated litter soil moisture for rsoil
4455	tmcs_litter(:) = zero
4456	DO jsl = 1,4
4457	tmcs_litter(:) = tmcs_litter(:) + sms(:,jsl)
4458	END DO
4459
4460	! Soil wetness profiles (W-Ww)/(Ws-Ww)
4461	! soil_wet_ns is the ratio of available soil moisture to max available soil moisture
4462	! (ie soil moisture at saturation minus soil moisture at wilting point).
4463	! soil wet is a water stress for stomate, to control C decomposition
4464	! Based on liquid water content
4465	DO jsl=1,nslm
4466	DO ji=1,kjpindex
4467	soil_wet_ns(ji,jsl,jst) = MIN(un, MAX(zero, &
4468	(sm(ji,jsl)-smw(ji,jsl))/(sms(ji,jsl)-smw(ji,jsl)) ))
4469	END DO
4470	END DO
4471
4472	! Compute us and the new humrelv to use in sechiba (with loops on the vegetation types)
4473	! This is the water stress for transpiration (diffuco) and photosynthesis (diffuco)
4474	! humrel is never used in stomate
4475	! Based on liquid water content
4476
4477	! -- PFT1
4478	humrelv(:,1,jst) = zero
4479	! -- Top layer
4480	DO jv = 2,nvm
4481	DO ji=1,kjpindex
4482	!- Here we make the assumption that roots do not take water from the 1st layer.
4483	us(ji,jv,jst,1) = zero
4484	humrelv(ji,jv,jst) = zero ! initialisation of the sum
4485	END DO
4486	ENDDO
4487
4488	! There are two different ways of looking at a root profile in the code. It
4489	! could reflect "structure" or "function". The code uses a different
4490	! root profile depending on what it is used for. A structural and functional
4491	! root profile are calculated below.
4492	CALL hydrol_root_profile(kjpindex, altmax, sm, smw, root_profile, root_depth)
4493
4494	! Make root_dens XIOS proof. Use NAN instead of zero to obtain the correct mean
4495	! value for the period that roots are present.
4496	tmp(:,:,:,:) = root_profile(:,:,:,:)
4497	DO jv = 1,nvm
4498	DO jsl=1,nslm
4499	WHERE (SUM(circ_class_biomass(:,jv,:,iroot,icarbon),dim=2).LT.min_stomate)
4500	tmp(:,jv,jsl,istruc) = xios_default_val
4501	tmp(:,jv,jsl,ifunc) = xios_default_val
4502	END WHERE
4503	END DO
4504	END DO
4505	CALL xios_orchidee_send_field("ROOT_PROF_STRUC",tmp(:,:,:,istruc))
4506	CALL xios_orchidee_send_field("ROOT_PROF_FUNC",tmp(:,:,:,ifunc))
4507
4508	! Intermediate and bottom layers
4509	DO jsl = 2,nslm
4510	DO jv = 2, nvm
4511	DO ji=1,kjpindex
4512	! AD16*** Although plants can only withdraw liquid water, we compute here the water stress
4513	! based on mc and the corresponding thresholds mcs, pcent, or potentially mcw and mcfc
4514	! This is consistent with assuming that ice is uniformly distributed within the poral space
4515	! In such a case, freezing makes mcl and the "liquid" porosity smaller than the "total" values
4516	! And it is the same for all the moisture thresholds, which are proportional to porosity.
4517	! Since the stress is based on relative moisture, it could thus independent from the porosity
4518	! at first order, thus independent from freezing.
4519	! 26-07-2017: us and humrel now based on liquid soil moisture, so the stress is stronger
4520	IF(new_watstress) THEN
4521	IF((sm(ji,jsl)-smw(ji,jsl)) .GT. min_sechiba) THEN
4522	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
4523	(EXP(- alpha_watstress * &
4524	( (smf(ji,jsl) - smw(ji,jsl)) / ( sm_nostress(ji,jsl) - smw(ji,jsl)) ) * &
4525	( (sm_nostress(ji,jsl) - sm(ji,jsl)) / ( sm(ji,jsl) - smw(ji,jsl)) ) ) ) ))&
4526	* root_profile(ji,jv,jsl,ifunc)
4527	ELSE
4528	us(ji,jv,jst,jsl) = 0.
4529	ENDIF
4530	ELSE
4531	us(ji,jv,jst,jsl) = MIN(un, MAX(zero, &
4532	(sm(ji,jsl)-smw(ji,jsl))/(sm_nostress(ji,jsl)-smw(ji,jsl)) )) * root_profile(ji,jv,jsl,ifunc)
4533	ENDIF
4534	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) + us(ji,jv,jst,jsl)
4535	END DO
4536	END DO
4537	ENDDO
4538
4539	!! vegstressv is the water stress for phenology in stomate
4540	!! It varies linearly from zero at wilting point to 1 at field capacity
4541	vegstressv(:,:,jst) = zero
4542	DO jv = 2, nvm
4543	DO ji=1,kjpindex
4544	DO jsl=1,nslm
4545	vegstressv(ji,jv,jst) = vegstressv(ji,jv,jst) + &
4546	MIN(un, MAX(zero, (sm(ji,jsl)-smw(ji,jsl))/(smf(ji,jsl)-smw(ji,jsl)) )) &
4547	* root_profile(ji,jv,jsl,ifunc)
4548	END DO
4549	END DO
4550	END DO
4551
4552
4553	! -- If the PFT is absent, the corresponding humrelv and vegstressv = 0
4554	DO jv = 2, nvm
4555	DO ji = 1, kjpindex
4556	IF (vegetmax_soil(ji,jv,jst) .LT. min_sechiba) THEN
4557	humrelv(ji,jv,jst) = zero
4558	vegstressv(ji,jv,jst) = zero
4559	us(ji,jv,jst,:) = zero
4560	ENDIF
4561	END DO
4562	END DO
4563
4564	!! 6.2 We need to turn off evaporation when is_under_mcr
4565	!! We set us, humrelv and vegstressv to zero in this case
4566	!! WARNING: It's different from having locally us=0 in the soil layers(s) where mc<mcr
4567	!! This part is crucial to preserve water conservation
4568	DO jsl = 1,nslm
4569	DO jv = 2, nvm
4570	WHERE (is_under_mcr(:,jst))
4571	us(:,jv,jst,jsl) = zero
4572	ENDWHERE
4573	ENDDO
4574	ENDDO
4575	DO jv = 2, nvm
4576	WHERE (is_under_mcr(:,jst))
4577	humrelv(:,jv,jst) = zero
4578	ENDWHERE
4579	ENDDO
4580	!rwilt and soil_wet_ns to zero in this case.
4581	! They are used later for shumdiag and shumdiag_perma
4582	DO jsl = 1,nslm
4583	WHERE (is_under_mcr(:,jst))
4584	soil_wet_ns(:,jsl,jst) = zero
4585	ENDWHERE
4586	ENDDO
4587
4588	! Counting the nb of under_mcr occurences in each grid-cell
4589	WHERE (is_under_mcr(:,jst))
4590	undermcr = undermcr + un
4591	ENDWHERE
4592
4593	!! 6.3 Calculate the volumetric soil moisture content (mc_layh and mcl_layh) needed in
4594	!! thermosoil for the thermal conductivity.
4595	!! The multiplication by vegtot creates grid-cell average values
4596	! *** To be checked for consistency with the use of nobio properties in thermosoil
4597	mc_layh_s = mc
4598	mcl_layh_s = mc
4599	DO jsl=1,nslm
4600	DO ji=1,kjpindex
4601	mc_layh(ji,jsl) = mc_layh(ji,jsl) + mc(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
4602	mcl_layh(ji,jsl) = mcl_layh(ji,jsl) + mcl(ji,jsl,jst) * soiltile(ji,jst) * vegtot(ji)
4603	ENDDO
4604	END DO
4605
4606	!! 6.4 The hydraulic conductivities exported here are the ones used in the diffusion/redistribution
4607	! (no call of hydrol_soil_coef since 2.1)
4608	! We average the values of each soiltile and keep the specific value (no multiplication by vegtot)
4609	DO ji = 1, kjpindex
4610	kk_moy(ji,:) = kk_moy(ji,:) + soiltile(ji,jst) * k(ji,:)
4611	kk(ji,:,jst) = k(ji,:)
4612	ENDDO
4613
4614	!! 6.5 We also want to export ksat at each node for CMIP6
4615	! (In the output, done only once according to field_def_orchidee.xml; same averaging as for kk)
4616	DO jsl = 1, nslm
4617	ksat(:,jsl) = ksat(:,jsl) + soiltile(:,jst) * &
4618	( ks(:) * kfact(jsl,:) * kfact_root(:,jsl,jst) )
4619	ENDDO
4620
4621	IF (printlev>=3) WRITE (numout,*) ' prognostic/diagnostic part of hydrol_soil done for jst =', jst
4622
4623	END DO ! end of loop on soiltile
4624
4625
4626	!! -- ENDING THE MAIN LOOP ON SOILTILES
4627
4628	!! 7. Summing 3d variables into 2d variables
4629	CALL hydrol_diag_soil (ks, nvan, avan, mcr, mcs, mcfc, mcw, kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
4630	& evapot, vevapnu, returnflow, reinfiltration, irrigation, &
4631	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, &
4632	& vegstress, drysoil_frac, tot_melt, us)
4633
4634	! Means of wtd, runoff and drainage corrections, across soiltiles
4635	wtd(:) = zero
4636	ru_corr(:) = zero
4637	ru_corr2(:) = zero
4638	dr_corr(:) = zero
4639	dr_corrnum(:) = zero
4640	dr_force(:) = zero
4641	DO jst = 1, nstm
4642	DO ji = 1, kjpindex
4643	wtd(ji) = wtd(ji) + soiltile(ji,jst) * wtd_ns(ji,jst) ! average over vegtot only
4644	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4645	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4646	ru_corr(ji) = ru_corr(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr_ns(ji,jst)
4647	ru_corr2(ji) = ru_corr2(ji) + vegtot(ji) * soiltile(ji,jst) * ru_corr2_ns(ji,jst)
4648	dr_corr(ji) = dr_corr(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corr_ns(ji,jst)
4649	dr_corrnum(ji) = dr_corrnum(ji) + vegtot(ji) * soiltile(ji,jst) * dr_corrnum_ns(ji,jst)
4650	dr_force(ji) = dr_force(ji) - vegtot(ji) * soiltile(ji,jst) * dr_force_ns(ji,jst)
4651	! the sign is OK to get a negative drainage flux
4652	ENDIF
4653	ENDDO
4654	ENDDO
4655
4656	! Means local variables, including water conservation checks
4657	ru_infilt(:)=0.
4658	qinfilt(:)=0.
4659	check_infilt(:)=0.
4660	check_tr(:)=0.
4661	check_over(:)=0.
4662	check_under(:)=0.
4663	qflux(:,:)=0.
4664	check_top(:)=0.
4665	DO jst = 1, nstm
4666	DO ji = 1, kjpindex
4667	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4668	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4669	ru_infilt(ji) = ru_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * ru_infilt_ns(ji,jst)
4670	qinfilt(ji) = qinfilt(ji) + vegtot(ji) * soiltile(ji,jst) * qinfilt_ns(ji,jst)
4671	ENDIF
4672	ENDDO
4673	ENDDO
4674
4675	IF (check_cwrr) THEN
4676	DO jst = 1, nstm
4677	DO ji = 1, kjpindex
4678	IF (vegtot(ji) .GT. min_sechiba) THEN ! to mimic hydrol_diag_soil
4679	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
4680	check_infilt(ji) = check_infilt(ji) + vegtot(ji) * soiltile(ji,jst) * check_infilt_ns(ji,jst)
4681	check_tr(ji) = check_tr(ji) + vegtot(ji) * soiltile(ji,jst) * check_tr_ns(ji,jst)
4682	check_over(ji) = check_over(ji) + vegtot(ji) * soiltile(ji,jst) * check_over_ns(ji,jst)
4683	check_under(ji) = check_under(ji) + vegtot(ji) * soiltile(ji,jst) * check_under_ns(ji,jst)
4684	!
4685	qflux(ji,:) = qflux(ji,:) + vegtot(ji) * soiltile(ji,jst) * qflux_ns(ji,:,jst)
4686	check_top(ji) = check_top(ji) + vegtot(ji) * soiltile(ji,jst) * check_top_ns(ji,jst)
4687	ENDIF
4688	ENDDO
4689	ENDDO
4690	END IF
4691
4692	!! 8. COMPUTING EVAP_BARE_LIM_NS FOR NEXT TIME STEP, WITH A LOOP ON SOILTILES
4693	!! The principle is to run a dummy integration of the water redistribution scheme
4694	!! to check if the SM profile can sustain a potential evaporation.
4695	!! If not, the dummy integration is redone from the SM profile of the end of the normal integration,
4696	!! with a boundary condition leading to a very severe water limitation: mc(1)=mcr
4697
4698	! evap_bare_lim = beta factor for bare soil evaporation
4699	evap_bare_lim(:) = zero
4700	evap_bare_lim_ns(:,:) = zero
4701
4702	! Loop on soil tiles
4703	DO jst = 1,nstm
4704
4705	!! 8.1 Save actual mc, mcl, and tmc for restoring at the end of the time step
4706	!! and calculate tmcint corresponding to mc without water2infilt
4707	DO jsl = 1, nslm
4708	DO ji = 1, kjpindex
4709	mcint(ji,jsl) = mask_soiltile(ji,jst) * mc(ji,jsl,jst)
4710	mclint(ji,jsl) = mask_soiltile(ji,jst) * mcl(ji,jsl,jst)
4711	ENDDO
4712	ENDDO
4713
4714	DO ji = 1, kjpindex
4715	temp(ji) = tmc(ji,jst)
4716	tmcint(ji) = temp(ji) - water2infilt(ji,jst) ! to estimate bare soil evap based on water budget
4717	ENDDO
4718
4719	!! 8.2 Since we estimate bare soile evap for the next time step, we update profil_froz_hydro and mcl
4720	! (effect of mc only, the change in stempdiag is neglected)
4721	IF ( ok_freeze_cwrr ) CALL hydrol_soil_froz(nvan, avan, mcr, mcs,kjpindex,jst,njsc,stempdiag)
4722	DO jsl = 1, nslm
4723	DO ji =1, kjpindex
4724	mcl(ji,jsl,jst)= MIN( mc(ji,jsl,jst), mcr(ji) + &
4725	(un-profil_froz_hydro_ns(ji,jsl,jst))*(mc(ji,jsl,jst)-mcr(ji)) )
4726	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we keep mcl=mc
4727	ENDDO
4728	ENDDO
4729
4730	!! 8.3 K and D are recomputed for the updated profile of mc/mcl
4731	CALL hydrol_soil_coef(mcr, mcs, kjpindex,jst,njsc)
4732	!! for the hydraulic architecture we need to pass the hydraulic
4733	! conductivity. We save this variable in ksoil
4734	ksoil(:,:,jst) = k
4735
4736	!! 8.4 Set the tridiagonal matrix coefficients for the diffusion/redistribution scheme
4737	CALL hydrol_soil_setup(kjpindex,jst)
4738	resolv(:) = (mask_soiltile(:,jst) .GT. 0)
4739
4740	!! 8.5 We define the system of linear equations, based on matrix coefficients,
4741
4742	!- Impose potential evaporation as flux_top in mm/step, assuming the water is available
4743	! Note that this should lead to never have evapnu>evapot_penm(ji)
4744
4745	DO ji = 1, kjpindex
4746
4747	IF (vegtot(ji).GT.min_sechiba) THEN
4748
4749	! We calculate a reduced demand, by means of a soil resistance (Sellers et al., 1992)
4750	! It is based on the liquid SM only, like for us and humrel
4751	IF (do_rsoil) THEN
4752	mc_rel(ji) = tmc_litter(ji,jst)/tmcs_litter(ji) ! tmc_litter based on mcl
4753	! based on SM in the top 4 soil layers (litter) to smooth variability
4754	r_soil_ns(ji,jst) = exp(8.206 - 4.255 * mc_rel(ji))
4755	ELSE
4756	r_soil_ns(ji,jst) = zero
4757	ENDIF
4758
4759	! Aerodynamic resistance
4760	speed = MAX(min_wind, SQRT (u(ji)u(ji) + v(ji)v(ji)))
4761	IF (speed * tq_cdrag(ji) .GT. min_sechiba) THEN
4762	ra = un / (speed * tq_cdrag(ji))
4763	evap_soil(ji) = evapot_penm(ji) / (un + r_soil_ns(ji,jst)/ra)
4764	ELSE
4765	evap_soil(ji) = evapot_penm(ji)
4766	ENDIF
4767
4768	flux_top(ji) = evap_soil(ji) * &
4769	AINT(frac_bare_ns(ji,jst)+un-min_sechiba)
4770	ELSE
4771
4772	flux_top(ji) = zero
4773	! r_soil_ns needs a value to support the calculation in
4774	! section "evap_bar_lim is the grid-cell scale beta"
4775	r_soil_ns(ji,jst) = zero
4776
4777	ENDIF
4778	ENDDO
4779
4780	! We don't use rootsinks, because we assume there is no transpiration in the bare soil fraction (??)
4781	!- First layer
4782	DO ji = 1, kjpindex
4783	tmat(ji,1,1) = zero
4784	tmat(ji,1,2) = f(ji,1)
4785	tmat(ji,1,3) = g1(ji,1)
4786	rhs(ji,1) = fp(ji,1) * mcl(ji,1,jst) + gp(ji,1)*mcl(ji,2,jst) &
4787	- flux_top(ji) - (b(ji,1)+b(ji,2))/deux *(dt_sechiba/one_day)
4788	ENDDO
4789	!- soil body
4790	DO jsl=2, nslm-1
4791	DO ji = 1, kjpindex
4792	tmat(ji,jsl,1) = e(ji,jsl)
4793	tmat(ji,jsl,2) = f(ji,jsl)
4794	tmat(ji,jsl,3) = g1(ji,jsl)
4795	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4796	+ gp(ji,jsl) * mcl(ji,jsl+1,jst) &
4797	+ (b(ji,jsl-1) - b(ji,jsl+1)) * (dt_sechiba/one_day) / deux
4798	ENDDO
4799	ENDDO
4800	!- Last layer
4801	DO ji = 1, kjpindex
4802	jsl=nslm
4803	tmat(ji,jsl,1) = e(ji,jsl)
4804	tmat(ji,jsl,2) = f(ji,jsl)
4805	tmat(ji,jsl,3) = zero
4806	rhs(ji,jsl) = ep(ji,jsl)mcl(ji,jsl-1,jst) + fp(ji,jsl)mcl(ji,jsl,jst) &
4807	+ (b(ji,jsl-1) + b(ji,jsl)(un-deuxfree_drain_coef(ji,jst))) * (dt_sechiba/one_day) / deux
4808	ENDDO
4809	!- Store the equations for later use (9.6)
4810	DO jsl=1,nslm
4811	DO ji = 1, kjpindex
4812	srhs(ji,jsl) = rhs(ji,jsl)
4813	stmat(ji,jsl,1) = tmat(ji,jsl,1)
4814	stmat(ji,jsl,2) = tmat(ji,jsl,2)
4815	stmat(ji,jsl,3) = tmat(ji,jsl,3)
4816	ENDDO
4817	ENDDO
4818
4819	!! 8.6 Solve the diffusion equation, assuming that flux_top=evapot_penm (updates mcl)
4820	CALL hydrol_soil_tridiag(kjpindex,jst)
4821
4822	!! 9.7 Alternative solution with mc(1)=mcr in points where the above solution leads to mcl<mcr
4823	! hydrol_soil_tridiag calculates mc recursively from the top as a fonction of rhs and tmat
4824	! We re-use these the above values, but for mc(1)=mcr and the related tmat
4825
4826	DO ji = 1, kjpindex
4827	! by construction, mc and mcl are always on the same side of mcr, so we can use mcl here
4828	resolv(ji) = (mcl(ji,1,jst).LT.(mcr(ji)).AND.flux_top(ji).GT.min_sechiba)
4829	ENDDO
4830	!! Reset the coefficient for diffusion (tridiag is only solved if resolv(ji) = .TRUE.)O
4831	DO jsl=1,nslm
4832	!- The new condition is to put the upper layer at residual soil moisture
4833	DO ji = 1, kjpindex
4834	rhs(ji,jsl) = srhs(ji,jsl)
4835	tmat(ji,jsl,1) = stmat(ji,jsl,1)
4836	tmat(ji,jsl,2) = stmat(ji,jsl,2)
4837	tmat(ji,jsl,3) = stmat(ji,jsl,3)
4838	END DO
4839	END DO
4840
4841	DO ji = 1, kjpindex
4842	tmat(ji,1,2) = un
4843	tmat(ji,1,3) = zero
4844	rhs(ji,1) = mcr(ji)
4845	ENDDO
4846
4847	! Solves the diffusion equation with new surface bc where resolv=T
4848	CALL hydrol_soil_tridiag(kjpindex,jst)
4849
4850	!! 8.8 In both case, we have drainage to be consistent with rhs
4851	DO ji = 1, kjpindex
4852	flux_bottom(ji) = mask_soiltile(ji,jst)k(ji,nslm)free_drain_coef(ji,jst) * (dt_sechiba/one_day)
4853	ENDDO
4854
4855	!! 8.9 Water budget to assess the top flux = soil evaporation
4856	! Where resolv=F at the 2nd step (9.6), it should simply be the potential evaporation
4857
4858	! Total soil moisture content for water budget
4859
4860	DO jsl = 1, nslm
4861	DO ji =1, kjpindex
4862	mc(ji,jsl,jst) = MAX( mcl(ji,jsl,jst), mcl(ji,jsl,jst) + &
4863	profil_froz_hydro_ns(ji,jsl,jst)*(mc(ji,jsl,jst)-mcr(ji)) )
4864	! if profil_froz_hydro_ns=0 (including NOT ok_freeze_cwrr) we get mc=mcl
4865	ENDDO
4866	ENDDO
4867
4868	DO ji = 1, kjpindex
4869	tmc(ji,jst) = dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
4870	ENDDO
4871	DO jsl = 2,nslm-1
4872	DO ji = 1, kjpindex
4873	tmc(ji,jst) = tmc(ji,jst) + dz(jsl) &
4874	* (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
4875	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit
4876	ENDDO
4877	ENDDO
4878	DO ji = 1, kjpindex
4879	tmc(ji,jst) = tmc(ji,jst) + dz(nslm) &
4880	* (trois * mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
4881	END DO
4882
4883	! Deduce upper flux from soil moisture variation and bottom flux
4884	! TMCi-D-BSE=TMC (BSE=bare soil evap=TMCi-TMC-D)
4885	! The numerical errors of tridiag close to saturation cannot be simply solved here,
4886	! we can only hope they are not too large because we don't add water at this stage...
4887	DO ji = 1, kjpindex
4888	evap_bare_lim_ns(ji,jst) = mask_soiltile(ji,jst) * &
4889	(tmcint(ji)-tmc(ji,jst)-flux_bottom(ji))
4890	END DO
4891
4892	!! 8.10 evap_bare_lim_ns is turned from an evaporation rate to a beta
4893	DO ji = 1, kjpindex
4894	! Here we weight evap_bare_lim_ns by the fraction of bare evaporating soil.
4895	! This is given by frac_bare_ns, taking into account bare soil under vegetation
4896	IF(vegtot(ji) .GT. min_sechiba) THEN
4897	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) * frac_bare_ns(ji,jst)
4898	ELSE
4899	evap_bare_lim_ns(ji,jst) = 0.
4900	ENDIF
4901	END DO
4902
4903	! We divide by evapot, which is consistent with diffuco (evap_bare_lim_ns < evapot_penm/evapot)
4904	! Further decrease if tmc_litter is below the wilting point
4905
4906	IF (do_rsoil) THEN
4907	DO ji=1,kjpindex
4908	IF (evapot(ji).GT.min_sechiba) THEN
4909	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
4910	ELSE
4911	evap_bare_lim_ns(ji,jst) = zero ! not redundant with the is_under_mcr case below
4912	! but not necessarily useful
4913	END IF
4914	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
4915	END DO
4916	ELSE
4917	DO ji=1,kjpindex
4918	IF ((evapot(ji).GT.min_sechiba) .AND. &
4919	(tmc_litter(ji,jst).GT.(tmc_litter_wilt(ji,jst)))) THEN
4920	evap_bare_lim_ns(ji,jst) = evap_bare_lim_ns(ji,jst) / evapot(ji)
4921	ELSEIF((evapot(ji).GT.min_sechiba).AND. &
4922	(tmc_litter(ji,jst).GT.(tmc_litter_res(ji,jst)))) THEN
4923	evap_bare_lim_ns(ji,jst) = (un/deux) * evap_bare_lim_ns(ji,jst) / evapot(ji)
4924	! This is very arbitrary, with no justification from the literature
4925	ELSE
4926	evap_bare_lim_ns(ji,jst) = zero
4927	END IF
4928	evap_bare_lim_ns(ji,jst)=MAX(MIN(evap_bare_lim_ns(ji,jst),1.),0.)
4929	END DO
4930	ENDIF
4931
4932	!! 8.11 Set evap_bare_lim_ns to zero if is_under_mcr at the end of the prognostic loop
4933	!! (cf us, humrelv, vegstressv in 5.2)
4934	WHERE (is_under_mcr(:,jst))
4935	evap_bare_lim_ns(:,jst) = zero
4936	ENDWHERE
4937
4938	!! 8.12 Restores mc, mcl, and tmc, to erase the effect of the dummy integrations
4939	!! on these prognostic variables
4940	DO jsl = 1, nslm
4941	DO ji = 1, kjpindex
4942	mc(ji,jsl,jst) = mask_soiltile(ji,jst) * mcint(ji,jsl)
4943	mcl(ji,jsl,jst) = mask_soiltile(ji,jst) * mclint(ji,jsl)
4944	ENDDO
4945	ENDDO
4946	DO ji = 1, kjpindex
4947	tmc(ji,jst) = temp(ji)
4948	ENDDO
4949
4950	ENDDO !end loop on tiles for dummy integration
4951
4952	!! 9. evap_bar_lim is the grid-cell scale beta
4953	DO ji = 1, kjpindex
4954	evap_bare_lim(ji) = SUM(evap_bare_lim_ns(ji,:)vegtot(ji)soiltile(ji,:))
4955	r_soil(ji) = SUM(r_soil_ns(ji,:)vegtot(ji)soiltile(ji,:))
4956	ENDDO
4957	! si vegtot LE min_sechiba, evap_bare_lim_ns et evap_bare_lim valent zero
4958
4959
4960	!! 10. XIOS export of local variables, including water conservation checks
4961	CALL xios_orchidee_send_field("ksat",ksat) ! mm/d (for CMIP6, once)
4962	CALL xios_orchidee_send_field("psi_moy",psi_moy) ! mm (for SP-MIP)
4963	CALL xios_orchidee_send_field("wtd",wtd) ! in m
4964	CALL xios_orchidee_send_field("ru_corr",ru_corr/dt_sechiba) ! adjustment flux added to surface runoff (included in runoff)
4965	CALL xios_orchidee_send_field("ru_corr2",ru_corr2/dt_sechiba)
4966	CALL xios_orchidee_send_field("dr_corr",dr_corr/dt_sechiba) ! adjustment flux added to drainage (included in drainage)
4967	CALL xios_orchidee_send_field("dr_corrnum",dr_corrnum/dt_sechiba)
4968	CALL xios_orchidee_send_field("dr_force",dr_force/dt_sechiba) ! adjustement flux added to drainage to sustain a forced wtd
4969	CALL xios_orchidee_send_field("qinfilt",qinfilt/dt_sechiba)
4970	CALL xios_orchidee_send_field("ru_infilt",ru_infilt/dt_sechiba)
4971	CALL xios_orchidee_send_field("r_soil",r_soil) ! s/m
4972
4973	IF (check_cwrr) THEN
4974	CALL xios_orchidee_send_field("check_infilt",check_infilt/dt_sechiba)
4975	CALL xios_orchidee_send_field("check_tr",check_tr/dt_sechiba)
4976	CALL xios_orchidee_send_field("check_over",check_over/dt_sechiba)
4977	CALL xios_orchidee_send_field("check_under",check_under/dt_sechiba)
4978	! Variables calculated in hydrol_diag_soil_flux
4979	CALL xios_orchidee_send_field("qflux",qflux/dt_sechiba) ! upward water flux at the low interface of each layer
4980	CALL xios_orchidee_send_field("check_top",check_top/dt_sechiba) !water budget residu in top layer
4981	END IF
4982
4983
4984	END SUBROUTINE hydrol_soil
4985
4986
4987	!! ================================================================================================================================
4988	!! SUBROUTINE : hydrol_soil_infilt
4989	!!
4990	!>\BRIEF Infiltration
4991	!!
4992	!! DESCRIPTION :
4993	!! 1. We calculate the total SM at the beginning of the routine
4994	!! 2. Infiltration process
4995	!! 2.1 Initialization of time counter and infiltration rate
4996	!! 2.2 Infiltration layer by layer, accounting for an exponential law for subgrid variability
4997	!! 2.3 Resulting infiltration and surface runoff
4998	!! 3. For water conservation check, we calculate the total SM at the beginning of the routine,
4999	!! and export the difference with the flux
5000	!! 5. Local verification
5001	!!
5002	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5003	!! Adding checks and interactions variables with hydrol_soil, but the processes are unchanged
5004	!!
5005	!! MAIN OUTPUT VARIABLE(S) :
5006	!!
5007	!! REFERENCE(S) :
5008	!!
5009	!! FLOWCHART : None
5010	!! \n
5011	!_ ================================================================================================================================
5012	!_ hydrol_soil_infilt
5013
5014	SUBROUTINE hydrol_soil_infilt(ks, nvan, avan, mcr, mcs, mcfc, mcw, kjpindex, ins, njsc, flux_infilt, stempdiag,&
5015	qinfilt_ns, ru_infilt, check)
5016
5017	!! 0. Variable and parameter declaration
5018
5019	!! 0.1 Input variables
5020	! GLOBAL (in or inout)
5021	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5022	INTEGER(i_std), INTENT(in) :: ins
5023	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell
5024	!! (1-nscm, unitless)
5025	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
5026	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
5027	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
5028	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
5029	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
5030	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
5031	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
5032	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: flux_infilt !! Water to infiltrate
5033	!! @tex $(kg m^{-2})$ @endtex
5034	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in):: stempdiag !! Diagnostic temp profile from thermosoil
5035
5036	!! 0.2 Output variables
5037	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux (mm/dt_sechiba)
5038	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: ru_infilt !! Surface runoff from soil_infilt (mm/dt_sechiba)
5039	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: qinfilt_ns !! Effective infiltration flux (mm/dt_sechiba)
5040
5041	!! 0.3 Modified variables
5042
5043	!! 0.4 Local variables
5044
5045	INTEGER(i_std) :: ji, jsl !! Indices
5046	REAL(r_std), DIMENSION (kjpindex) :: wat_inf_pot !! infiltrable water in the layer
5047	REAL(r_std), DIMENSION (kjpindex) :: wat_inf !! infiltrated water in the layer
5048	REAL(r_std), DIMENSION (kjpindex) :: dt_tmp !! time remaining before the end of the time step
5049	REAL(r_std), DIMENSION (kjpindex) :: dt_inf !! the time it takes to complete the infiltration in the
5050	!! layer
5051	REAL(r_std) :: k_m !! the mean conductivity used for the saturated front
5052	REAL(r_std), DIMENSION (kjpindex) :: infilt_tmp !! infiltration rate for the considered layer
5053	REAL(r_std), DIMENSION (kjpindex) :: infilt_tot !! total infiltration
5054	REAL(r_std), DIMENSION (kjpindex) :: flux_tmp !! rate at which precip hits the ground
5055
5056	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine (kg/m2)
5057	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine (kg/m2)
5058
5059
5060	!_ ================================================================================================================================
5061
5062	! If data (or coupling with GCM) was available, a parameterization for subgrid rainfall could be performed
5063
5064	!! 1. We calculate the total SM at the beginning of the routine
5065	IF (check_cwrr) THEN
5066	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5067	DO jsl = 2,nslm-1
5068	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5069	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5070	ENDDO
5071	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5072	ENDIF
5073
5074	!! 2. Infiltration process
5075
5076	!! 2.1 Initialization
5077
5078	DO ji = 1, kjpindex
5079	!! First we fill up the first layer (about 1mm) without any resistance and quasi-immediately
5080	wat_inf_pot(ji) = MAX((mcs(ji)-mc(ji,1,ins)) * dz(2) / deux, zero)
5081	wat_inf(ji) = MIN(wat_inf_pot(ji), flux_infilt(ji))
5082	mc(ji,1,ins) = mc(ji,1,ins) + wat_inf(ji) * deux / dz(2)
5083	!
5084	ENDDO
5085
5086	!! Initialize a countdown for infiltration during the time-step and the value of potential runoff
5087	dt_tmp(:) = dt_sechiba / one_day
5088	infilt_tot(:) = wat_inf(:)
5089	!! Compute the rate at which water will try to infiltrate each layer
5090	! flux_temp is converted here to the same unit as k_m
5091	flux_tmp(:) = (flux_infilt(:)-wat_inf(:)) / dt_tmp(:)
5092
5093	!! 2.2 Infiltration layer by layer
5094	DO jsl = 2, nslm-1
5095	DO ji = 1, kjpindex
5096	!! Infiltrability of each layer if under a saturated one
5097	! This is computed by an simple arithmetic average because
5098	! the time step (30min) is not appropriate for a geometric average (advised by Haverkamp and Vauclin)
5099	k_m = (k(ji,jsl) + ks(ji)kfact(jsl-1,ji)kfact_root(ji,jsl,ins)) / deux
5100
5101	IF (ok_freeze_cwrr) THEN
5102	IF (stempdiag(ji, jsl) .LT. ZeroCelsius) THEN
5103	k_m = k(ji,jsl)
5104	ENDIF
5105	ENDIF
5106
5107	!! We compute the mean rate at which water actually infiltrate:
5108	! Subgrid: Exponential distribution of k around k_m, but average p directly used
5109	! See d'Orgeval 2006, p 78, but it's not fully clear to me (AD16***)
5110	infilt_tmp(ji) = k_m * (un - EXP(- flux_tmp(ji) / k_m))
5111
5112	!! From which we deduce the time it takes to fill up the layer or to end the time step...
5113	wat_inf_pot(ji) = MAX((mcs(ji)-mc(ji,jsl,ins)) * (dz(jsl) + dz(jsl+1)) / deux, zero)
5114	IF ( infilt_tmp(ji) > min_sechiba) THEN
5115	dt_inf(ji) = MIN(wat_inf_pot(ji)/infilt_tmp(ji), dt_tmp(ji))
5116	! The water infiltration TIME has to limited by what is still available for infiltration.
5117	IF ( dt_inf(ji) * infilt_tmp(ji) > flux_infilt(ji)-infilt_tot(ji) ) THEN
5118	dt_inf(ji) = MAX(flux_infilt(ji)-infilt_tot(ji),zero)/infilt_tmp(ji)
5119	ENDIF
5120	ELSE
5121	dt_inf(ji) = dt_tmp(ji)
5122	ENDIF
5123
5124	!! The water enters in the layer
5125	wat_inf(ji) = dt_inf(ji) * infilt_tmp(ji)
5126	! bviously the moisture content
5127	mc(ji,jsl,ins) = mc(ji,jsl,ins) + &
5128	& wat_inf(ji) * deux / (dz(jsl) + dz(jsl+1))
5129	! the time remaining before the next time step
5130	dt_tmp(ji) = dt_tmp(ji) - dt_inf(ji)
5131	! and finally the infilt_tot (which is just used to check if there is a problem, below)
5132	infilt_tot(ji) = infilt_tot(ji) + infilt_tmp(ji) * dt_inf(ji)
5133	ENDDO
5134	ENDDO
5135
5136	!! 2.3 Resulting infiltration and surface runoff
5137	ru_infilt(:,ins) = flux_infilt(:) - infilt_tot(:)
5138	qinfilt_ns(:,ins) = infilt_tot(:)
5139
5140	!! 3. For water conservation check: we calculate the total SM at the beginning of the routine
5141	!! and export the difference with the flux
5142	IF (check_cwrr) THEN
5143	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5144	DO jsl = 2,nslm-1
5145	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5146	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5147	ENDDO
5148	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5149	! Normally, tcmf=tmci+infilt_tot
5150	check(:,ins) = tmcf(:)-(tmci(:)+infilt_tot(:))
5151	ENDIF
5152
5153	!! 5. Local verification
5154	DO ji = 1, kjpindex
5155	IF (infilt_tot(ji) .LT. -min_sechiba .OR. infilt_tot(ji) .GT. flux_infilt(ji) + min_sechiba) THEN
5156	WRITE (numout,*) 'Error in the calculation of infilt tot', infilt_tot(ji)
5157	WRITE (numout,*) 'k, ji, jst, mc', k(ji,1:2), ji, ins, mc(ji,1,ins)
5158	CALL ipslerr_p(3, 'hydrol_soil_infilt', 'We will STOP now.','Error in calculation of infilt tot','')
5159	ENDIF
5160	ENDDO
5161
5162	END SUBROUTINE hydrol_soil_infilt
5163
5164
5165	!! ================================================================================================================================
5166	!! SUBROUTINE : hydrol_soil_smooth_under_mcr
5167	!!
5168	!>\BRIEF : Modifies the soil moisture profile to avoid under-residual values,
5169	!! then diagnoses the points where such "excess" values remain.
5170	!!
5171	!! DESCRIPTION :
5172	!! The "excesses" under-residual are corrected from top to bottom, by transfer of excesses
5173	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
5174	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
5175	!! and the remaining "excess" is necessarily concentrated in the top layer.
5176	!! This allowing diagnosing the flag is_under_mcr.
5177	!! Eventually, the remaining "excess" is split over the entire profile
5178	!! 1. We calculate the total SM at the beginning of the routine
5179	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
5180	!! Note that we check that mc > min_sechiba in hydrol_soil
5181	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
5182	!! and export the difference with the flux
5183	!!
5184	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5185	!!
5186	!! MAIN OUTPUT VARIABLE(S) :
5187	!!
5188	!! REFERENCE(S) :
5189	!!
5190	!! FLOWCHART : None
5191	!! \n
5192	!_ ================================================================================================================================
5193	!_ hydrol_soil_smooth_under_mcr
5194
5195	SUBROUTINE hydrol_soil_smooth_under_mcr(mcr, kjpindex, ins, njsc, is_under_mcr, check)
5196
5197	!- arguments
5198
5199	!! 0. Variable and parameter declaration
5200
5201	!! 0.1 Input variables
5202	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5203	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
5204	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
5205	!! (1-nscm, unitless)
5206	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
5207
5208	!! 0.2 Output variables
5209
5210	LOGICAL, DIMENSION(kjpindex,nstm), INTENT(out) :: is_under_mcr !! Flag diagnosing under residual soil moisture
5211	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
5212
5213	!! 0.3 Modified variables
5214
5215	!! 0.4 Local variables
5216
5217	INTEGER(i_std) :: ji,jsl
5218	REAL(r_std) :: excess
5219	REAL(r_std), DIMENSION(kjpindex) :: excessji
5220	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
5221	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
5222
5223	!_ ================================================================================================================================
5224
5225	!! 1. We calculate the total SM at the beginning of the routine
5226	IF (check_cwrr) THEN
5227	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5228	DO jsl = 2,nslm-1
5229	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5230	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5231	ENDDO
5232	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5233	ENDIF
5234
5235	!! 2. Smoothes the profile to avoid negative values of punctual soil moisture
5236
5237	! 2.1 smoothing from top to bottom
5238	DO jsl = 1,nslm-2
5239	DO ji=1, kjpindex
5240	excess = MAX(mcr(ji)-mc(ji,jsl,ins),zero)
5241	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5242	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
5243	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
5244	ENDDO
5245	ENDDO
5246
5247	jsl = nslm-1
5248	DO ji=1, kjpindex
5249	excess = MAX(mcr(ji)-mc(ji,jsl,ins),zero)
5250	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5251	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) - excess * &
5252	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
5253	ENDDO
5254
5255	jsl = nslm
5256	DO ji=1, kjpindex
5257	excess = MAX(mcr(ji)-mc(ji,jsl,ins),zero)
5258	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5259	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
5260	& dz(jsl)/(dz(jsl-1)+dz(jsl))
5261	ENDDO
5262
5263	! 2.2 smoothing from bottom to top
5264	DO jsl = nslm-1,2,-1
5265	DO ji=1, kjpindex
5266	excess = MAX(mcr(ji)-mc(ji,jsl,ins),zero)
5267	mc(ji,jsl,ins) = mc(ji,jsl,ins) + excess
5268	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) - excess * &
5269	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
5270	ENDDO
5271	ENDDO
5272
5273	! 2.3 diagnoses is_under_mcr(ji), and updates the entire profile
5274	! excess > 0
5275	DO ji=1, kjpindex
5276	excessji(ji) = mask_soiltile(ji,ins) * MAX(mcr(ji)-mc(ji,1,ins),zero)
5277	ENDDO
5278	DO ji=1, kjpindex
5279	mc(ji,1,ins) = mc(ji,1,ins) + excessji(ji) ! then mc(1)=mcr
5280	is_under_mcr(ji,ins) = (excessji(ji) .GT. min_sechiba)
5281	ENDDO
5282
5283	! 2.4 The amount of water corresponding to excess in the top soil layer is redistributed in all soil layers
5284	! -excess(ji) * dz(2) / deux donne le deficit total, negatif, en mm
5285	! diviser par la profondeur totale en mm donne des delta_mc identiques en chaque couche, en mm
5286	! retransformes en delta_mm par couche selon les bonnes eqs (eqs_hydrol.pdf, Eqs 13-15), puis sommes
5287	! retourne bien le deficit total en mm
5288	DO jsl = 1, nslm
5289	DO ji=1, kjpindex
5290	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excessji(ji) * dz(2) / (deux * zmaxh*mille)
5291	ENDDO
5292	ENDDO
5293	! This can lead to mc(jsl) < mcr depending on the value of excess,
5294	! but this is no major pb for the diffusion
5295	! Yet, we need to prevent evaporation if is_under_mcr
5296
5297	!! Note that we check that mc > min_sechiba in hydrol_soil
5298
5299	! We just make sure that mc remains at 0 where soiltile=0
5300	DO jsl = 1, nslm
5301	DO ji=1, kjpindex
5302	mc(ji,jsl,ins) = mask_soiltile(ji,ins) * mc(ji,jsl,ins)
5303	ENDDO
5304	ENDDO
5305
5306	!! 3. For water conservation check, We calculate the total SM at the beginning of the routine,
5307	!! and export the difference with the flux
5308	IF (check_cwrr) THEN
5309	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5310	DO jsl = 2,nslm-1
5311	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5312	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5313	ENDDO
5314	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5315	! Normally, tcmf=tmci since we just redistribute the deficit
5316	check(:,ins) = tmcf(:)-tmci(:)
5317	ENDIF
5318
5319	END SUBROUTINE hydrol_soil_smooth_under_mcr
5320
5321
5322	!! ================================================================================================================================
5323	!! SUBROUTINE : hydrol_soil_smooth_over_mcs
5324	!!
5325	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
5326	!! by putting the excess in ru_ns
5327	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
5328	!!
5329	!! DESCRIPTION :
5330	!! The "excesses" over-saturation are corrected from top to bottom, by transfer of excesses
5331	!! to the lower layers. The reverse transfer is performed to smooth any remaining "excess" in the bottom layer.
5332	!! If some "excess" remain afterwards, the entire soil profile is at the threshold value (mcs or mcr),
5333	!! and the remaining "excess" is necessarily concentrated in the top layer.
5334	!! Eventually, the remaining "excess" creates rudr_corr, to be added to ru_ns or dr_ns
5335	!! 1. We calculate the total SM at the beginning of the routine
5336	!! 2. In case of over-saturation we put the water where it is possible by smoothing
5337	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
5338	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
5339	!! and export the difference with the flux
5340	!!
5341	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5342	!!
5343	!! MAIN OUTPUT VARIABLE(S) :
5344	!!
5345	!! REFERENCE(S) :
5346	!!
5347	!! FLOWCHART : None
5348	!! \n
5349	!_ ================================================================================================================================
5350	!_ hydrol_soil_smooth_over_mcs
5351
5352	SUBROUTINE hydrol_soil_smooth_over_mcs(mcs, kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
5353
5354	!- arguments
5355
5356	!! 0. Variable and parameter declaration
5357
5358	!! 0.1 Input variables
5359	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5360	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
5361	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
5362	!! (1-nscm, unitless)
5363	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
5364
5365	!! 0.2 Output variables
5366
5367	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
5368	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
5369
5370	!! 0.3 Modified variables
5371	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
5372
5373	!! 0.4 Local variables
5374
5375	INTEGER(i_std) :: ji,jsl
5376	REAL(r_std) :: excess
5377	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
5378	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
5379
5380	!_ ================================================================================================================================
5381
5382	!! 1. We calculate the total SM at the beginning of the routine
5383	IF (check_cwrr) THEN
5384	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5385	DO jsl = 2,nslm-1
5386	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5387	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5388	ENDDO
5389	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5390	ENDIF
5391
5392	!! 2. In case of over-saturation we put the water where it is possible by smoothing
5393
5394	! 2.1 smoothing from top to bottom
5395	DO jsl = 1, nslm-2
5396	DO ji=1, kjpindex
5397	excess = MAX(mc(ji,jsl,ins)-mcs(ji),zero)
5398	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5399	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
5400	& (dz(jsl)+dz(jsl+1))/(dz(jsl+1)+dz(jsl+2))
5401	ENDDO
5402	ENDDO
5403
5404	jsl = nslm-1
5405	DO ji=1, kjpindex
5406	excess = MAX(mc(ji,jsl,ins)-mcs(ji),zero)
5407	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5408	mc(ji,jsl+1,ins) = mc(ji,jsl+1,ins) + excess * &
5409	& (dz(jsl)+dz(jsl+1))/dz(jsl+1)
5410	ENDDO
5411
5412	jsl = nslm
5413	DO ji=1, kjpindex
5414	excess = MAX(mc(ji,jsl,ins)-mcs(ji),zero)
5415	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5416	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
5417	& dz(jsl)/(dz(jsl-1)+dz(jsl))
5418	ENDDO
5419
5420	! 2.2 smoothing from bottom to top, leading to keep most of the excess in the soil column
5421	DO jsl = nslm-1,2,-1
5422	DO ji=1, kjpindex
5423	excess = MAX(mc(ji,jsl,ins)-mcs(ji),zero)
5424	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess
5425	mc(ji,jsl-1,ins) = mc(ji,jsl-1,ins) + excess * &
5426	& (dz(jsl)+dz(jsl+1))/(dz(jsl-1)+dz(jsl))
5427	ENDDO
5428	ENDDO
5429
5430	!! 3. The excess is transformed into surface runoff, with conversion from m3/m3 to kg/m2
5431
5432	DO ji=1, kjpindex
5433	excess = mask_soiltile(ji,ins) * MAX(mc(ji,1,ins)-mcs(ji),zero)
5434	mc(ji,1,ins) = mc(ji,1,ins) - excess ! then mc(1)=mcs
5435	rudr_corr(ji,ins) = rudr_corr(ji,ins) + excess * dz(2) / deux
5436	is_over_mcs(ji) = .FALSE.
5437	ENDDO
5438
5439	!! 4. For water conservation checks, we calculate the total SM at the beginning of the routine,
5440	!! and export the difference with the flux
5441
5442	IF (check_cwrr) THEN
5443	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5444	DO jsl = 2,nslm-1
5445	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5446	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5447	ENDDO
5448	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5449	! Normally, tcmf=tmci-rudr_corr
5450	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
5451	ENDIF
5452
5453	END SUBROUTINE hydrol_soil_smooth_over_mcs
5454
5455	!! ================================================================================================================================
5456	!! SUBROUTINE : hydrol_soil_smooth_over_mcs2
5457	!!
5458	!>\BRIEF : Modifies the soil moisture profile to avoid over-saturation values,
5459	!! by putting the excess in ru_ns
5460	!! Thus, no point remain where such "excess" values remain (is_over_mcs becomes useless)
5461	!!
5462	!! DESCRIPTION :
5463	!! The "excesses" over-saturation are corrected, by directly discarding the excess as rudr_corr,
5464	!! to be added to ru_ns or dr_nsrunoff (via rudr_corr).
5465	!! Therefore, there is no more smoothing, and this helps preventing the saturation of too many layers,
5466	!! which leads to numerical errors with tridiag.
5467	!! 1. We calculate the total SM at the beginning of the routine
5468	!! 2. In case of over-saturation, we directly eliminate the excess via rudr_corr
5469	!! The calculation of the adjustement flux needs to account for nodes n-1 and n+1.
5470	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
5471	!! and export the difference with the flux
5472	!!
5473	!! RECENT CHANGE(S) : 2016 by A. Ducharne
5474	!!
5475	!! MAIN OUTPUT VARIABLE(S) :
5476	!!
5477	!! REFERENCE(S) :
5478	!!
5479	!! FLOWCHART : None
5480	!! \n
5481	!_ ================================================================================================================================
5482	!_ hydrol_soil_smooth_over_mcs2
5483
5484	SUBROUTINE hydrol_soil_smooth_over_mcs2(mcs, kjpindex, ins, njsc, is_over_mcs, rudr_corr, check)
5485
5486	!- arguments
5487
5488	!! 0. Variable and parameter declaration
5489
5490	!! 0.1 Input variables
5491	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5492	INTEGER(i_std), INTENT(in) :: ins !! Soiltile index (1-nstm, unitless)
5493	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in grid cell
5494	!! (1-nscm, unitless)
5495	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
5496
5497	!! 0.2 Output variables
5498
5499	LOGICAL, DIMENSION(kjpindex), INTENT(out) :: is_over_mcs !! Flag diagnosing over saturated soil moisture
5500	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT(out) :: check !! delta SM - flux
5501
5502	!! 0.3 Modified variables
5503	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout):: rudr_corr !! Surface runoff produced to correct excess (mm/dtstep)
5504
5505	!! 0.4 Local variables
5506
5507	INTEGER(i_std) :: ji,jsl
5508	REAL(r_std), DIMENSION(kjpindex,nslm) :: excess
5509	REAL(r_std), DIMENSION(kjpindex) :: tmci !! total SM at beginning of routine
5510	REAL(r_std), DIMENSION(kjpindex) :: tmcf !! total SM at end of routine
5511
5512	!_ ================================================================================================================================
5513	!-
5514
5515	!! 1. We calculate the total SM at the beginning of the routine
5516	IF (check_cwrr) THEN
5517	tmci(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5518	DO jsl = 2,nslm-1
5519	tmci(:) = tmci(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5520	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5521	ENDDO
5522	tmci(:) = tmci(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5523	ENDIF
5524
5525	!! 2. In case of over-saturation, we don't do any smoothing,
5526	!! but directly eliminate the excess as runoff (via rudr_corr)
5527	! we correct the calculation of the adjustement flux, which needs to account for nodes n-1 and n+1
5528	! for the calculation to remain simple and accurate, we directly drain all the oversaturated mc,
5529	! without transfering to lower layers
5530
5531	!! 2.1 thresholding from top to bottom, with excess defined along jsl
5532	DO jsl = 1, nslm
5533	DO ji=1, kjpindex
5534	excess(ji,jsl) = MAX(mc(ji,jsl,ins)-mcs(ji),zero) ! >=0
5535	mc(ji,jsl,ins) = mc(ji,jsl,ins) - excess(ji,jsl) ! here mc either does not change or decreases
5536	ENDDO
5537	ENDDO
5538
5539	!! 2.2 To ensure conservation, this needs to be balanced by additional drainage (in kg/m2/dt)
5540	DO ji = 1, kjpindex
5541	rudr_corr(ji,ins) = dz(2) * ( trois*excess(ji,1) + excess(ji,2) )/huit ! top layer = initialisation
5542	ENDDO
5543	DO jsl = 2,nslm-1 ! intermediate layers
5544	DO ji = 1, kjpindex
5545	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(jsl) &
5546	& * (trois*excess(ji,jsl)+excess(ji,jsl-1))/huit &
5547	& + dz(jsl+1) * (trois*excess(ji,jsl)+excess(ji,jsl+1))/huit
5548	ENDDO
5549	ENDDO
5550	DO ji = 1, kjpindex
5551	rudr_corr(ji,ins) = rudr_corr(ji,ins) + dz(nslm) & ! bottom layer
5552	& * (trois * excess(ji,nslm) + excess(ji,nslm-1))/huit
5553	is_over_mcs(ji) = .FALSE.
5554	END DO
5555
5556	!! 3. For water conservation checks, we calculate the total SM at the beginning of the routine,
5557	!! and export the difference with the flux
5558
5559	IF (check_cwrr) THEN
5560	tmcf(:) = dz(2) * ( trois*mc(:,1,ins) + mc(:,2,ins) )/huit
5561	DO jsl = 2,nslm-1
5562	tmcf(:) = tmcf(:) + dz(jsl) * (trois*mc(:,jsl,ins)+mc(:,jsl-1,ins))/huit &
5563	+ dz(jsl+1) * (trois*mc(:,jsl,ins)+mc(:,jsl+1,ins))/huit
5564	ENDDO
5565	tmcf(:) = tmcf(:) + dz(nslm) * (trois*mc(:,nslm,ins) + mc(:,nslm-1,ins))/huit
5566	! Normally, tcmf=tmci-rudr_corr
5567	check(:,ins) = tmcf(:)-(tmci(:)-rudr_corr(:,ins))
5568	ENDIF
5569
5570	END SUBROUTINE hydrol_soil_smooth_over_mcs2
5571
5572
5573	!! ================================================================================================================================
5574	!! SUBROUTINE : hydrol_diag_soil_flux
5575	!!
5576	!>\BRIEF : This subroutine diagnoses the vertical liquid water fluxes between the
5577	!! different soil layers, based on each layer water budget. It also checks the
5578	!! corresponding water conservation (during redistribution).
5579	!!
5580	!! DESCRIPTION :
5581	!! 1. Initialize qflux_ns from the bottom, with dr_ns
5582	!! 2. Between layer nslm and nslm-1, by means of water budget knowing mc changes and flux at the lowest interface
5583	!! 3. We go up, and deduct qflux_ns(1:nslm-2), still by means of water budget
5584	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface should equal -flux_top
5585	!!
5586	!! RECENT CHANGE(S) : 2016 by A. Ducharne to fit hydrol_soil
5587	!!
5588	!! MAIN OUTPUT VARIABLE(S) :
5589	!!
5590	!! REFERENCE(S) :
5591	!!
5592	!! FLOWCHART : None
5593	!! \n
5594	!_ ================================================================================================================================
5595
5596	SUBROUTINE hydrol_diag_soil_flux(kjpindex,ins,mclint,flux_top)
5597	!
5598	!! 0. Variable and parameter declaration
5599
5600	!! 0.1 Input variables
5601
5602	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5603	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
5604	REAL(r_std), DIMENSION (kjpindex,nslm), INTENT(in) :: mclint !! mc values at the beginning of the time step
5605	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: flux_top !! Exfiltration (bare soil evaporation minus infiltration)
5606
5607	!! 0.2 Output variables
5608
5609	!! 0.3 Modified variables
5610
5611	!! 0.4 Local variables
5612	REAL(r_std), DIMENSION (kjpindex) :: check_temp !! Diagnosed flux at soil surface, should equal -flux_top
5613	INTEGER(i_std) :: jsl,ji
5614
5615	!_ ================================================================================================================================
5616
5617	!- Compute the diffusion flux at every level from bottom to top (using mcl,mclint, and sink values)
5618	DO ji = 1, kjpindex
5619
5620	!! 1. Initialize qflux_ns from the bottom, with dr_ns
5621	jsl = nslm
5622	qflux_ns(ji,jsl,ins) = dr_ns(ji,ins)
5623	!! 2. Between layer nslm and nslm-1, by means of water budget
5624	!! knowing mc changes and flux at the lowest interface
5625	! qflux_ns is downward
5626	jsl = nslm-1
5627	qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) &
5628	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
5629	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
5630	& * (dz(jsl+1)/huit) &
5631	& + rootsink(ji,jsl+1,ins)
5632	ENDDO
5633
5634	!! 3. We go up, and deduct qflux_ns(1:nslm-2), still by means of water budget
5635	! Here, qflux_ns(ji,1,ins) is the downward flux between the top soil layer and the 2nd one
5636	DO jsl = nslm-2,1,-1
5637	DO ji = 1, kjpindex
5638	qflux_ns(ji,jsl,ins) = qflux_ns(ji,jsl+1,ins) &
5639	& + (mcl(ji,jsl,ins)-mclint(ji,jsl) &
5640	& + troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1)) &
5641	& * (dz(jsl+1)/huit) &
5642	& + rootsink(ji,jsl+1,ins) &
5643	& + (dz(jsl+2)/huit) &
5644	& * (troismcl(ji,jsl+1,ins) - troismclint(ji,jsl+1) &
5645	& + mcl(ji,jsl+2,ins)-mclint(ji,jsl+2))
5646	END DO
5647	ENDDO
5648
5649	!! 4. Water balance verification: pursuing upward water budget, the flux at the surface (check_temp)
5650	!! should equal -flux_top
5651	DO ji = 1, kjpindex
5652
5653	check_temp(ji) = qflux_ns(ji,1,ins) + (dz(2)/huit) &
5654	& * (trois* (mcl(ji,1,ins)-mclint(ji,1)) + (mcl(ji,2,ins)-mclint(ji,2))) &
5655	& + rootsink(ji,1,ins)
5656	! flux_top is positive when upward, while check_temp is positive when downward
5657	check_top_ns(ji,ins) = flux_top(ji)+check_temp(ji)
5658
5659	IF (ABS(check_top_ns(ji,ins))/dt_sechiba .GT. min_sechiba) THEN
5660	! Diagnosed (check_temp) and imposed (flux_top) differ by more than 1.e-8 mm/s
5661	WRITE(numout,*) 'Problem in the water balance, qflux_ns computation, surface fluxes', flux_top(ji),check_temp(ji)
5662	WRITE(numout,*) 'Diagnosed and imposed fluxes differ by more than 1.e-8 mm/s: ', check_top_ns(ji,ins)
5663	WRITE(numout,*) 'ji', ji, 'jsl',jsl,'ins',ins
5664	WRITE(numout,*) 'mclint', mclint(ji,:)
5665	WRITE(numout,*) 'mcl', mcl(ji,:,ins)
5666	WRITE (numout,*) 'rootsink', rootsink(ji,1,ins)
5667	CALL ipslerr_p(1, 'hydrol_diag_soil_flux', 'NOTE:',&
5668	& 'Problem in the water balance, qflux_ns computation','')
5669	ENDIF
5670	ENDDO
5671
5672	END SUBROUTINE hydrol_diag_soil_flux
5673
5674
5675	!! ================================================================================================================================
5676	!! SUBROUTINE : hydrol_soil_tridiag
5677	!!
5678	!>\BRIEF This subroutine solves a set of linear equations which has a tridiagonal coefficient matrix.
5679	!!
5680	!! DESCRIPTION : It is only applied in the grid-cells where resolv(ji)=TRUE
5681	!!
5682	!! RECENT CHANGE(S) : None
5683	!!
5684	!! MAIN OUTPUT VARIABLE(S) : mcl (global module variable)
5685	!!
5686	!! REFERENCE(S) :
5687	!!
5688	!! FLOWCHART : None
5689	!! \n
5690	!_ ================================================================================================================================
5691	!_ hydrol_soil_tridiag
5692
5693	SUBROUTINE hydrol_soil_tridiag(kjpindex,ins)
5694
5695	!- arguments
5696
5697	!! 0. Variable and parameter declaration
5698
5699	!! 0.1 Input variables
5700
5701	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5702	INTEGER(i_std), INTENT(in) :: ins !! number of soil type
5703
5704	!! 0.2 Output variables
5705
5706	!! 0.3 Modified variables
5707
5708	!! 0.4 Local variables
5709
5710	INTEGER(i_std) :: ji,jsl
5711	REAL(r_std), DIMENSION(kjpindex) :: bet
5712	REAL(r_std), DIMENSION(kjpindex,nslm) :: gam
5713
5714	!_ ================================================================================================================================
5715	DO ji = 1, kjpindex
5716
5717	IF (resolv(ji)) THEN
5718	bet(ji) = tmat(ji,1,2)
5719	mcl(ji,1,ins) = rhs(ji,1)/bet(ji)
5720	ENDIF
5721	ENDDO
5722
5723	DO jsl = 2,nslm
5724	DO ji = 1, kjpindex
5725
5726	IF (resolv(ji)) THEN
5727
5728	gam(ji,jsl) = tmat(ji,jsl-1,3)/bet(ji)
5729	bet(ji) = tmat(ji,jsl,2) - tmat(ji,jsl,1)*gam(ji,jsl)
5730	mcl(ji,jsl,ins) = (rhs(ji,jsl)-tmat(ji,jsl,1)*mcl(ji,jsl-1,ins))/bet(ji)
5731	ENDIF
5732
5733	ENDDO
5734	ENDDO
5735
5736	DO ji = 1, kjpindex
5737	IF (resolv(ji)) THEN
5738	DO jsl = nslm-1,1,-1
5739	mcl(ji,jsl,ins) = mcl(ji,jsl,ins) - gam(ji,jsl+1)*mcl(ji,jsl+1,ins)
5740	ENDDO
5741	ENDIF
5742	ENDDO
5743
5744	END SUBROUTINE hydrol_soil_tridiag
5745
5746
5747	!! ================================================================================================================================
5748	!! SUBROUTINE : hydrol_soil_coef
5749	!!
5750	!>\BRIEF Computes coef for the linearised hydraulic conductivity
5751	!! k_lin=a_lin mc_lin+b_lin and the linearised diffusivity d_lin.
5752	!!
5753	!! DESCRIPTION :
5754	!! First, we identify the interval i in which the current value of mc is located.
5755	!! Then, we give the values of the linearized parameters to compute
5756	!! conductivity and diffusivity as K=a*mc+b and d.
5757	!!
5758	!! RECENT CHANGE(S) : Addition of the dependence to profil_froz_hydro_ns
5759	!!
5760	!! MAIN OUTPUT VARIABLE(S) :
5761	!!
5762	!! REFERENCE(S) :
5763	!!
5764	!! FLOWCHART : None
5765	!! \n
5766	!_ ================================================================================================================================
5767	!_ hydrol_soil_coef
5768
5769	SUBROUTINE hydrol_soil_coef(mcr, mcs, kjpindex,ins,njsc)
5770
5771	IMPLICIT NONE
5772	!
5773	!! 0. Variable and parameter declaration
5774
5775	!! 0.1 Input variables
5776	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5777	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
5778	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
5779	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
5780	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
5781
5782	!! 0.2 Output variables
5783
5784	!! 0.3 Modified variables
5785
5786	!! 0.4 Local variables
5787
5788	INTEGER(i_std) :: jsl,ji,i
5789	REAL(r_std) :: mc_ratio
5790	REAL(r_std) :: mc_used !! Used liquid water content
5791	REAL(r_std) :: x,m
5792
5793	!_ ================================================================================================================================
5794
5795	IF (ok_freeze_cwrr) THEN
5796
5797	! Calculation of liquid and frozen saturation degrees with respect to residual
5798	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
5799	! 1-x=frozen saturation degree/residual=(mcfc-mcr)/(mcs-mcr) (=profil_froz_hydro)
5800
5801	DO jsl=1,nslm
5802	DO ji=1,kjpindex
5803
5804	x = 1._r_std - profil_froz_hydro_ns(ji, jsl,ins)
5805
5806	! mc_used is used in the calculation of hydrological properties
5807	! It corresponds to a liquid mc, but the expression is different from mcl in hydrol_soil,
5808	! to ensure that we get the a, b, d of the first bin when mcl<mcr
5809	mc_used = mcr(ji)+x*MAX((mc(ji,jsl, ins)-mcr(ji)),zero)
5810	!
5811	! calcul de k based on mc_liq
5812	!
5813	i= MAX(imin, MIN(imax-1, INT(imin +(imax-imin)*(mc_used-mcr(ji))/(mcs(ji)-mcr(ji)))))
5814	a(ji,jsl) = a_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm/d
5815	b(ji,jsl) = b_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm/d
5816	d(ji,jsl) = d_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm^2/d
5817	k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,ji), &
5818	a_lin(i,jsl,ji) * mc_used + b_lin(i,jsl,ji)) ! in mm/d
5819	ENDDO ! loop on grid
5820	ENDDO
5821
5822	ELSE
5823	! .NOT. ok_freeze_cwrr
5824	DO jsl=1,nslm
5825	DO ji=1,kjpindex
5826
5827	! it is impossible to consider a mc<mcr for the binning
5828	mc_ratio = MAX(mc(ji,jsl,ins)-mcr(ji), zero)/(mcs(ji)-mcr(ji))
5829
5830	i= MAX(MIN(INT((imax-imin)*mc_ratio)+imin , imax-1), imin)
5831	a(ji,jsl) = a_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm/d
5832	b(ji,jsl) = b_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm/d
5833	d(ji,jsl) = d_lin(i,jsl,ji) * kfact_root(ji,jsl,ins) ! in mm^2/d
5834	k(ji,jsl) = kfact_root(ji,jsl,ins) * MAX(k_lin(imin+1,jsl,ji), &
5835	a_lin(i,jsl,ji) * mc(ji,jsl,ins) + b_lin(i,jsl,ji)) ! in mm/d
5836	END DO
5837	END DO
5838	ENDIF
5839
5840	END SUBROUTINE hydrol_soil_coef
5841
5842	!! ================================================================================================================================
5843	!! SUBROUTINE : hydrol_soil_froz
5844	!!
5845	!>\BRIEF Computes profil_froz_hydro_ns, the fraction of frozen water in the soil layers.
5846	!!
5847	!! DESCRIPTION :
5848	!!
5849	!! RECENT CHANGE(S) : Created by A. Ducharne in 2016.
5850	!!
5851	!! MAIN OUTPUT VARIABLE(S) : profil_froz_hydro_ns
5852	!!
5853	!! REFERENCE(S) :
5854	!!
5855	!! FLOWCHART : None
5856	!! \n
5857	!_ ================================================================================================================================
5858	!_ hydrol_soil_froz
5859
5860	SUBROUTINE hydrol_soil_froz(nvan, avan, mcr, mcs, kjpindex,ins,njsc,stempdiag)
5861
5862	IMPLICIT NONE
5863	!
5864	!! 0. Variable and parameter declaration
5865
5866	!! 0.1 Input variables
5867	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5868	INTEGER(i_std), INTENT(in) :: ins !! Index of soil type
5869	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
5870	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
5871	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
5872	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
5873	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
5874	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in):: stempdiag !! Diagnostic temp profile from thermosoil
5875
5876	!! 0.2 Output variables
5877
5878	!! 0.3 Modified variables
5879
5880	!! 0.4 Local variables
5881
5882	INTEGER(i_std) :: jsl,ji,i
5883	REAL(r_std) :: x,m
5884	REAL(r_std) :: denom
5885	REAL(r_std),DIMENSION (kjpindex) :: froz_frac_moy
5886	REAL(r_std),DIMENSION (kjpindex) :: smtot_moy
5887	REAL(r_std),DIMENSION (kjpindex,nslm) :: mc_ns
5888
5889	!_ ================================================================================================================================
5890
5891	! ONLY FOR THE (ok_freeze_cwrr) CASE
5892
5893	! Calculation of liquid and frozen saturation degrees above residual moisture
5894	! x=liquid saturation degree/residual=(mcl-mcr)/(mcs-mcr)
5895	! 1-x=frozen saturation degree/residual=(mcfc-mcr)/(mcs-mcr) (=profil_froz_hydro)
5896	! It's important for the good work of the water diffusion scheme (tridiag) that the total
5897	! liquid water also includes mcr, so mcl > 0 even when x=0
5898
5899	DO jsl=1,nslm
5900	DO ji=1,kjpindex
5901	! Van Genuchten parameter for thermodynamical calculation
5902	m = 1. -1./nvan(ji)
5903
5904	IF ((.NOT. ok_thermodynamical_freezing).OR.(mc(ji,jsl, ins).LT.(mcr(ji)+min_sechiba))) THEN
5905	! Linear soil freezing or soil moisture below residual
5906	IF (stempdiag(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
5907	x=1._r_std
5908	ELSE IF ( (stempdiag(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
5909	(stempdiag(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
5910	x=(stempdiag(ji, jsl)-(ZeroCelsius-fr_dT/2.))/fr_dT
5911	ELSE
5912	x=0._r_std
5913	ENDIF
5914	ELSE IF (ok_thermodynamical_freezing) THEN
5915	! Thermodynamical soil freezing
5916	IF (stempdiag(ji, jsl).GE.(ZeroCelsius+fr_dT/2.)) THEN
5917	x=1._r_std
5918	ELSE IF ( (stempdiag(ji,jsl) .GE. (ZeroCelsius-fr_dT/2.)) .AND. &
5919	(stempdiag(ji,jsl) .LT. (ZeroCelsius+fr_dT/2.)) ) THEN
5920	! Factor 2.2 from the PhD of Isabelle Gouttevin
5921	x=MIN(((mcs(ji)-mcr(ji)) &
5922	((2.21000.avan(ji)(ZeroCelsius+fr_dT/2.-stempdiag(ji, jsl)) &
5923	lhf/ZeroCelsius/10.)nvan(ji)+1.)*(-m)) / &
5924	(mc(ji,jsl, ins)-mcr(ji)),1._r_std)
5925	ELSE
5926	x=0._r_std
5927	ENDIF
5928	ENDIF
5929
5930	profil_froz_hydro_ns(ji,jsl,ins) = 1._r_std-x
5931
5932	mc_ns(ji,jsl)=mc(ji,jsl,ins)/mcs(ji)
5933
5934	ENDDO ! loop on grid
5935	ENDDO
5936
5937	! Applay correction on the frozen fraction
5938	! Depends on two external parameters: froz_frac_corr and smtot_corr
5939	froz_frac_moy(:)=zero
5940	denom=zero
5941	DO jsl=1,nslm
5942	froz_frac_moy(:)=froz_frac_moy(:)+dh(jsl)*profil_froz_hydro_ns(:,jsl,ins)
5943	denom=denom+dh(jsl)
5944	ENDDO
5945	froz_frac_moy(:)=froz_frac_moy(:)/denom
5946
5947	smtot_moy(:)=zero
5948	denom=zero
5949	DO jsl=1,nslm-1
5950	smtot_moy(:)=smtot_moy(:)+dh(jsl)*mc_ns(:,jsl)
5951	denom=denom+dh(jsl)
5952	ENDDO
5953	smtot_moy(:)=smtot_moy(:)/denom
5954
5955	DO jsl=1,nslm
5956	profil_froz_hydro_ns(:,jsl,ins)=MIN(profil_froz_hydro_ns(:,jsl,ins)* &
5957	(froz_frac_moy(:)*froz_frac_corr)(smtot_moy(:)**smtot_corr), max_froz_hydro)
5958	ENDDO
5959
5960	END SUBROUTINE hydrol_soil_froz
5961
5962
5963	!! ================================================================================================================================
5964	!! SUBROUTINE : hydrol_soil_setup
5965	!!
5966	!>\BRIEF This subroutine computes the matrix coef.
5967	!!
5968	!! DESCRIPTION : None
5969	!!
5970	!! RECENT CHANGE(S) : None
5971	!!
5972	!! MAIN OUTPUT VARIABLE(S) : matrix coef
5973	!!
5974	!! REFERENCE(S) :
5975	!!
5976	!! FLOWCHART : None
5977	!! \n
5978	!_ ================================================================================================================================
5979
5980	SUBROUTINE hydrol_soil_setup(kjpindex,ins)
5981
5982
5983	IMPLICIT NONE
5984	!
5985	!! 0. Variable and parameter declaration
5986
5987	!! 0.1 Input variables
5988	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
5989	INTEGER(i_std), INTENT(in) :: ins !! index of soil type
5990
5991	!! 0.2 Output variables
5992
5993	!! 0.3 Modified variables
5994
5995	!! 0.4 Local variables
5996
5997	INTEGER(i_std) :: jsl,ji
5998	REAL(r_std) :: temp3, temp4
5999
6000	!_ ================================================================================================================================
6001	!-we compute tridiag matrix coefficients (LEFT and RIGHT)
6002	! of the system to solve [LEFT]mc_{t+1}=[RIGHT]mc{t}+[add terms]:
6003	! e(nslm),f(nslm),g1(nslm) for the [left] vector
6004	! and ep(nslm),fp(nslm),gp(nslm) for the [right] vector
6005
6006	! w_time=1 (in constantes_soil) indicates implicit computation for diffusion
6007	temp3 = w_time*(dt_sechiba/one_day)/deux
6008	temp4 = (un-w_time)*(dt_sechiba/one_day)/deux
6009
6010	! Passage to arithmetic means for layer averages also in this subroutine : Aurelien 11/05/10
6011
6012	!- coefficient for first layer
6013	DO ji = 1, kjpindex
6014	e(ji,1) = zero
6015	f(ji,1) = trois * dz(2)/huit + temp3 &
6016	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
6017	g1(ji,1) = dz(2)/(huit) - temp3 &
6018	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
6019	ep(ji,1) = zero
6020	fp(ji,1) = trois * dz(2)/huit - temp4 &
6021	& * ((d(ji,1)+d(ji,2))/(dz(2))+a(ji,1))
6022	gp(ji,1) = dz(2)/(huit) + temp4 &
6023	& * ((d(ji,1)+d(ji,2))/(dz(2))-a(ji,2))
6024	ENDDO
6025
6026	!- coefficient for medium layers
6027
6028	DO jsl = 2, nslm-1
6029	DO ji = 1, kjpindex
6030	e(ji,jsl) = dz(jsl)/(huit) - temp3 &
6031	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
6032
6033	f(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit + temp3 &
6034	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
6035	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
6036
6037	g1(ji,jsl) = dz(jsl+1)/(huit) - temp3 &
6038	& * ((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
6039
6040	ep(ji,jsl) = dz(jsl)/(huit) + temp4 &
6041	& * ((d(ji,jsl)+d(ji,jsl-1))/(dz(jsl))+a(ji,jsl-1))
6042
6043	fp(ji,jsl) = trois * (dz(jsl)+dz(jsl+1))/huit - temp4 &
6044	& * ( (d(ji,jsl)+d(ji,jsl-1))/(dz(jsl)) + &
6045	& (d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1)) )
6046
6047	gp(ji,jsl) = dz(jsl+1)/(huit) + temp4 &
6048	& *((d(ji,jsl)+d(ji,jsl+1))/(dz(jsl+1))-a(ji,jsl+1))
6049	ENDDO
6050	ENDDO
6051
6052	!- coefficient for last layer
6053	DO ji = 1, kjpindex
6054	e(ji,nslm) = dz(nslm)/(huit) - temp3 &
6055	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
6056	f(ji,nslm) = trois * dz(nslm)/huit + temp3 &
6057	& * ((d(ji,nslm)+d(ji,nslm-1)) / (dz(nslm)) &
6058	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
6059	g1(ji,nslm) = zero
6060	ep(ji,nslm) = dz(nslm)/(huit) + temp4 &
6061	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm))+a(ji,nslm-1))
6062	fp(ji,nslm) = trois * dz(nslm)/huit - temp4 &
6063	& * ((d(ji,nslm)+d(ji,nslm-1)) /(dz(nslm)) &
6064	& -a(ji,nslm)(un-deuxfree_drain_coef(ji,ins)))
6065	gp(ji,nslm) = zero
6066	ENDDO
6067
6068	END SUBROUTINE hydrol_soil_setup
6069
6070
6071	!! ================================================================================================================================
6072	!! SUBROUTINE : hydrol_split_soil
6073	!!
6074	!>\BRIEF Splits 2d variables into 3d variables, per soiltile (_ns suffix), at the beginning of hydrol
6075	!! At this stage, the forcing fluxes to hydrol are transformed from grid-cell averages
6076	!! to mean fluxes over vegtot=sum(soiltile)
6077	!!
6078	!! DESCRIPTION :
6079	!! 1. Split 2d variables into 3d variables, per soiltile
6080	!! 1.1 Throughfall
6081	!! 1.2 Bare soil evaporation
6082	!! 1.2.2 ae_ns new
6083	!! 1.3 transpiration
6084	!! 1.4 root sink
6085	!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes
6086	!! 2.1 precisol
6087	!! 2.2 ae_ns and evapnu
6088	!! 2.3 transpiration
6089	!! 2.4 root sink
6090	!!
6091	!! RECENT CHANGE(S) : 2016 by A. Ducharne to match the simplification of hydrol_soil
6092	!!
6093	!! MAIN OUTPUT VARIABLE(S) :
6094	!!
6095	!! REFERENCE(S) :
6096	!!
6097	!! FLOWCHART : None
6098	!! \n
6099	!_ ================================================================================================================================
6100
6101
6102	SUBROUTINE hydrol_split_soil (kjpindex, veget_max, soiltile, vevapnu, transpir, humrel, &
6103	evap_bare_lim, evap_bare_lim_ns, tot_bare_soil, us, e_frac)
6104
6105	!
6106	! interface description
6107
6108	!! 0. Variable and parameter declaration
6109
6110	!! 0.1 Input variables
6111
6112	INTEGER(i_std), INTENT(in) :: kjpindex
6113	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(in) :: veget_max !! max Vegetation map
6114	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soiltile within vegtot (0-1, unitless)
6115	REAL(r_std), DIMENSION (kjpindex), INTENT (in) :: vevapnu !! Bare soil evaporation
6116	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! Transpiration
6117	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (in) :: humrel !! Relative humidity
6118	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evap_bare_lim !!
6119	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(in) :: evap_bare_lim_ns !!
6120	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_bare_soil !! Total evaporating bare soil fraction
6121	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(INout) :: us !! Water stress index for transpiration
6122	!! (by soil layer and PFT) (0-1, unitless)
6123	REAL(r_std), DIMENSION (kjpindex,nvm,nslm,nstm), OPTIONAL, INTENT(in) :: e_frac !! Relative humidity per layer
6124
6125	!! 0.4 Local variables
6126
6127	INTEGER(i_std) :: ji, jv, jsl, jst
6128	REAL(r_std), DIMENSION (kjpindex) :: tmp_check1
6129	REAL(r_std), DIMENSION (kjpindex) :: tmp_check2
6130	REAL(r_std), DIMENSION (kjpindex,nstm) :: tmp_check3
6131	LOGICAL :: error
6132	!_ ================================================================================================================================
6133
6134	!! 1. Split 2d variables into 3d variables, per soiltile
6135
6136	! Reminders:
6137	! corr_veg_soil(:,nvm,nstm) = PFT fraction per soiltile in each grid-cell
6138	! corr_veg_soil(ji,jv,jst)=veget_max(ji,jv)/soiltile(ji,jst)
6139	! soiltile(:,nstm) = fraction of vegtot covered by each soiltile (0-1, unitless)
6140	! vegtot(:) = total fraction of grid-cell covered by PFTs (fraction with bare soil + vegetation)
6141	! veget_max(:,nvm) = PFT fractions of vegtot+frac_nobio
6142	! veget(:,nvm) = fractions (of vegtot+frac_nobio) covered by vegetation in each PFT
6143	! BUT veget(:,1)=veget_max(:,1)
6144	! frac_bare(:,nvm) = fraction (of veget_max) with bare soil in each PFT
6145	! tot_bare_soil(:) = fraction of grid mesh covered by all bare soil (=SUM(frac_bare*veget_max))
6146	! frac_bare_ns(:,nstm) = evaporating bare soil fraction (of vegtot) per soiltile (defined in hydrol_vegupd)
6147
6148	!! 1.1 Throughfall
6149	! Transformation from precisol (flux from PFT jv in m2 of grid-mesh)
6150	! to precisol_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
6151	precisol_ns(:,:)=zero
6152	DO jv=1,nvm
6153	DO ji=1,kjpindex
6154	jst=pref_soil_veg(jv)
6155	IF((veget_max(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
6156	precisol_ns(ji,jst) = precisol_ns(ji,jst) + &
6157	precisol(ji,jv) / (soiltile(ji,jst)*vegtot(ji))
6158	ENDIF
6159	END DO
6160	END DO
6161
6162
6163	!! 1.2 Bare soil evaporation and ae_ns
6164	ae_ns(:,:)=zero
6165	DO jst=1,nstm
6166	DO ji=1,kjpindex
6167	IF(evap_bare_lim(ji).GT.min_sechiba) THEN
6168	ae_ns(ji,jst) = vevapnu(ji) * evap_bare_lim_ns(ji,jst)/evap_bare_lim(ji)
6169	ENDIF
6170	ENDDO
6171	ENDDO
6172
6173	!! 1.3 transpiration
6174	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
6175	! to tr_ns (flux from contributing PFTs with another unit, in m2 of soiltile)
6176	! To do next: simplify the use of humrelv(ji,jv,jst) /humrel(ji,jv), since both are equal
6177	tr_ns(:,:)=zero
6178	DO jv=1,nvm
6179	jst=pref_soil_veg(jv)
6180	DO ji=1,kjpindex
6181	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba))THEN
6182	tr_ns(ji,jst)= tr_ns(ji,jst) &
6183	+ transpir(ji,jv) * (humrelv(ji,jv,jst) / humrel(ji,jv)) &
6184	/ (soiltile(ji,jst)*vegtot(ji))
6185
6186	ENDIF
6187	END DO
6188	END DO
6189
6190	!! 1.4 root sink
6191	! Transformation from transpir (flux from PFT jv in m2 of grid-mesh)
6192	! to root_sink (flux from contributing PFTs and soil layer with another unit, in m2 of soiltile)
6193	rootsink(:,:,:)=zero
6194
6195	IF (ok_hydrol_arch)THEN
6196
6197	DO jv = 1,nvm
6198	jst=pref_soil_veg(jv) ! OBS jst = 1,nstm
6199	DO jsl=1,nslm
6200	DO ji=1,kjpindex
6201	IF (humrel(ji,jv).GT.min_sechiba .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT. min_sechiba)) THEN
6202	rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
6203	+ (transpir(ji,jv)*e_frac(ji,jv,jsl,jst)) &
6204	/ (soiltile(ji,jst)*vegtot(ji))
6205	END IF
6206	END DO
6207	END DO
6208	END DO
6209
6210	ELSE
6211
6212	DO jv=1,nvm
6213	jst=pref_soil_veg(jv)
6214	DO jsl=1,nslm
6215	DO ji=1,kjpindex
6216	IF ((humrel(ji,jv).GT.min_sechiba) .AND. ((soiltile(ji,jst)*vegtot(ji)) .GT.min_sechiba)) THEN
6217	rootsink(ji,jsl,jst) = rootsink(ji,jsl,jst) &
6218	+ transpir(ji,jv) * (us(ji,jv,jst,jsl) / humrel(ji,jv)) &
6219	/ (soiltile(ji,jst)*vegtot(ji))
6220	! rootsink(ji,1,jst)=0 as us(ji,jv,jst,1)=0
6221	END IF
6222	END DO
6223	END DO
6224	END DO
6225
6226	END IF ! ok_hydrol_arch
6227
6228	!! 2. Verification: Check if the deconvolution is correct and conserves the fluxes (grid-cell average)
6229
6230	IF (check_cwrr) THEN
6231
6232	error=.FALSE.
6233
6234	!! 2.1 precisol
6235
6236	tmp_check1(:)=zero
6237	DO jst=1,nstm
6238	DO ji=1,kjpindex
6239	tmp_check1(ji)=tmp_check1(ji) + precisol_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
6240	END DO
6241	END DO
6242
6243	tmp_check2(:)=zero
6244	DO jv=1,nvm
6245	DO ji=1,kjpindex
6246	tmp_check2(ji)=tmp_check2(ji) + precisol(ji,jv)
6247	END DO
6248	END DO
6249
6250	DO ji=1,kjpindex
6251	IF(ABS(tmp_check1(ji) - tmp_check2(ji)).GT.allowed_err) THEN
6252	WRITE(numout,*) 'PRECISOL SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
6253	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
6254	WRITE(numout,*) 'vegtot',vegtot(ji)
6255	DO jv=1,nvm
6256	WRITE(numout,'(a,i2.2,"\|",F13.4,"\|",F13.4,"\|",3(F9.6))') &
6257	'jv,veget_max, precisol, vegetmax_soil ', &
6258	jv,veget_max(ji,jv),precisol(ji,jv),vegetmax_soil(ji,jv,:)
6259	END DO
6260	DO jst=1,nstm
6261	WRITE(numout,*) 'jst,precisol_ns',jst,precisol_ns(ji,jst)
6262	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
6263	END DO
6264	error=.TRUE.
6265	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
6266	& 'check_CWRR','PRECISOL SPLIT FALSE')
6267	ENDIF
6268	END DO
6269
6270	!! 2.2 ae_ns and evapnu
6271
6272	tmp_check1(:)=zero
6273	DO jst=1,nstm
6274	DO ji=1,kjpindex
6275	tmp_check1(ji)=tmp_check1(ji) + ae_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
6276	END DO
6277	END DO
6278
6279	DO ji=1,kjpindex
6280
6281	IF(ABS(tmp_check1(ji) - vevapnu(ji)).GT.allowed_err) THEN
6282	WRITE(numout,*) 'VEVAPNU SPLIT FALSE:ji, Sum(ae_ns), vevapnu =',ji,tmp_check1(ji),vevapnu(ji)
6283	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- vevapnu(ji))
6284	WRITE(numout,*) 'ae_ns',ae_ns(ji,:)
6285	WRITE(numout,*) 'vegtot',vegtot(ji)
6286	WRITE(numout,*) 'evap_bare_lim, evap_bare_lim_ns',evap_bare_lim(ji), evap_bare_lim_ns(ji,:)
6287	DO jst=1,nstm
6288	WRITE(numout,*) 'jst,ae_ns',jst,ae_ns(ji,jst)
6289	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
6290	END DO
6291	error=.TRUE.
6292	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
6293	& 'check_CWRR','VEVAPNU SPLIT FALSE')
6294	ENDIF
6295	ENDDO
6296
6297	!! 2.3 transpiration
6298
6299	tmp_check1(:)=zero
6300	DO jst=1,nstm
6301	DO ji=1,kjpindex
6302	tmp_check1(ji)=tmp_check1(ji) + tr_ns(ji,jst)soiltile(ji,jst)vegtot(ji)
6303	END DO
6304	END DO
6305
6306	tmp_check2(:)=zero
6307	DO jv=1,nvm
6308	DO ji=1,kjpindex
6309	tmp_check2(ji)=tmp_check2(ji) + transpir(ji,jv)
6310	END DO
6311	END DO
6312
6313	DO ji=1,kjpindex
6314	IF(ABS(tmp_check1(ji)- tmp_check2(ji)).GT.allowed_err) THEN
6315	WRITE(numout,*) 'TRANSPIR SPLIT FALSE:ji=',ji,tmp_check1(ji),tmp_check2(ji)
6316	WRITE(numout,*) 'err',ABS(tmp_check1(ji)- tmp_check2(ji))
6317	WRITE(numout,*) 'vegtot',vegtot(ji)
6318	DO jv=1,nvm
6319	WRITE(numout,*) 'jv,veget_max, transpir',jv,veget_max(ji,jv),transpir(ji,jv)
6320	DO jst=1,nstm
6321	WRITE(numout,*) 'vegetmax_soil:ji,jv,jst',ji,jv,jst,vegetmax_soil(ji,jv,jst)
6322	END DO
6323	END DO
6324	DO jst=1,nstm
6325	WRITE(numout,*) 'jst,tr_ns',jst,tr_ns(ji,jst)
6326	WRITE(numout,*) 'soiltile', soiltile(ji,jst)
6327	END DO
6328	error=.TRUE.
6329	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
6330	& 'check_CWRR','TRANSPIR SPLIT FALSE')
6331	ENDIF
6332
6333	END DO
6334
6335	!! 2.4 root sink
6336
6337	tmp_check3(:,:)=zero
6338	DO jst=1,nstm
6339	DO jsl=1,nslm
6340	DO ji=1,kjpindex
6341	tmp_check3(ji,jst)=tmp_check3(ji,jst) + rootsink(ji,jsl,jst)
6342	END DO
6343	END DO
6344	ENDDO
6345
6346	DO jst=1,nstm
6347	DO ji=1,kjpindex
6348	IF(ABS(tmp_check3(ji,jst) - tr_ns(ji,jst)).GT.allowed_err) THEN
6349	WRITE(numout,*) 'ROOTSINK SPLIT FALSE:ji,jst=', ji,jst,&
6350	& tmp_check3(ji,jst),tr_ns(ji,jst)
6351	WRITE(numout,*) 'err',ABS(tmp_check3(ji,jst)- tr_ns(ji,jst))
6352	WRITE(numout,*) 'HUMREL(jv=1:13)',humrel(ji,:)
6353	WRITE(numout,*) 'TRANSPIR',transpir(ji,:)
6354	DO jv=1,nvm
6355	WRITE(numout,*) 'jv=',jv,'us=',us(ji,jv,jst,:)
6356	ENDDO
6357	error=.TRUE.
6358	CALL ipslerr_p(2, 'hydrol_split_soil', 'We will STOP in the end of this subroutine.',&
6359	& 'check_CWRR','ROOTSINK SPLIT FALSE')
6360	ENDIF
6361	END DO
6362	END DO
6363
6364
6365	!! Exit if error was found previously in this subroutine
6366	IF ( error ) THEN
6367	WRITE(numout,*) 'One or more errors have been detected in hydrol_split_soil. Model stops.'
6368	CALL ipslerr_p(3, 'hydrol_split_soil', 'We will STOP now.',&
6369	& 'One or several fatal errors were found previously.','')
6370	END IF
6371
6372	ENDIF ! end of check_cwrr
6373
6374
6375	END SUBROUTINE hydrol_split_soil
6376
6377
6378	!! ================================================================================================================================
6379	!! SUBROUTINE : hydrol_diag_soil
6380	!!
6381	!>\BRIEF Calculates diagnostic variables at the grid-cell scale
6382	!!
6383	!! DESCRIPTION :
6384	!! - 1. Apply mask_soiltile
6385	!! - 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
6386	!!
6387	!! RECENT CHANGE(S) : 2016 by A. Ducharne for the claculation of shumdiag_perma
6388	!!
6389	!! MAIN OUTPUT VARIABLE(S) :
6390	!!
6391	!! REFERENCE(S) :
6392	!!
6393	!! FLOWCHART : None
6394	!! \n
6395	!_ ================================================================================================================================
6396	!_ hydrol_diag_soil
6397
6398	SUBROUTINE hydrol_diag_soil (ks, nvan, avan, mcr, mcs, mcfc, mcw, kjpindex, veget_max, soiltile, njsc, runoff, drainage, &
6399	& evapot, vevapnu, returnflow, reinfiltration, irrigation, &
6400	& shumdiag,shumdiag_perma, k_litt, litterhumdiag, humrel, vegstress, drysoil_frac, tot_melt, us)
6401	!
6402	! interface description
6403
6404	!! 0. Variable and parameter declaration
6405
6406	!! 0.1 Input variables
6407	! input scalar
6408	INTEGER(i_std), INTENT(in) :: kjpindex
6409	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget_max !! Max. vegetation type
6410	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
6411	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
6412	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: evapot !!
6413	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: returnflow !! Water returning to the deep reservoir
6414	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: reinfiltration !! Water returning to the top of the soil
6415	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: irrigation !! Water from irrigation
6416	REAL(r_std), DIMENSION (kjpindex), INTENT(in) :: tot_melt !!
6417	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
6418	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: nvan !! Van Genuchten coeficients n (unitless)
6419	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: avan !! Van Genuchten coeficients a (mm-1})
6420	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
6421	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
6422	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
6423	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
6424
6425	!! 0.2 Output variables
6426
6427	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: drysoil_frac !! Function of litter wetness
6428	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: runoff !! complete runoff
6429	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: drainage !! Drainage
6430	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag !! relative soil moisture
6431	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (out) :: shumdiag_perma !! Percent of porosity filled with water (mc/mcs) used for the thermal computations
6432	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: k_litt !! litter cond.
6433	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: litterhumdiag !! litter humidity
6434	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: humrel !! Relative humidity
6435	REAL(r_std), DIMENSION (kjpindex, nvm), INTENT(out) :: vegstress !! Veg. moisture stress (only for vegetation growth)
6436
6437	!! 0.3 Modified variables
6438
6439	REAL(r_std), DIMENSION (kjpindex), INTENT(inout) :: vevapnu !!
6440	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(inout) :: us !! Water stress index for transpiration
6441	!! (by soil layer and PFT) (0-1, unitless)
6442
6443
6444	!! 0.4 Local variables
6445
6446	INTEGER(i_std) :: ji, jv, jsl, jst, i
6447	REAL(r_std), DIMENSION (kjpindex) :: mask_vegtot
6448	REAL(r_std) :: k_tmp, tmc_litter_ratio
6449
6450	!_ ================================================================================================================================
6451	!
6452	! Put the prognostics variables of soil to zero if soiltype is zero
6453
6454	!! 1. Apply mask_soiltile
6455
6456	DO jst=1,nstm
6457	DO ji=1,kjpindex
6458
6459	ae_ns(ji,jst) = ae_ns(ji,jst) * mask_soiltile(ji,jst)
6460	dr_ns(ji,jst) = dr_ns(ji,jst) * mask_soiltile(ji,jst)
6461	ru_ns(ji,jst) = ru_ns(ji,jst) * mask_soiltile(ji,jst)
6462	tmc(ji,jst) = tmc(ji,jst) * mask_soiltile(ji,jst)
6463
6464	DO jv=1,nvm
6465	humrelv(ji,jv,jst) = humrelv(ji,jv,jst) * mask_soiltile(ji,jst)
6466	DO jsl=1,nslm
6467	us(ji,jv,jst,jsl) = us(ji,jv,jst,jsl) * mask_soiltile(ji,jst)
6468	END DO
6469	END DO
6470
6471	DO jsl=1,nslm
6472	mc(ji,jsl,jst) = mc(ji,jsl,jst) * mask_soiltile(ji,jst)
6473	END DO
6474
6475	END DO
6476	END DO
6477
6478	runoff(:) = zero
6479	drainage(:) = zero
6480	humtot(:) = zero
6481	shumdiag(:,:)= zero
6482	shumdiag_perma(:,:)=zero
6483	k_litt(:) = zero
6484	litterhumdiag(:) = zero
6485	tmc_litt_dry_mea(:) = zero
6486	tmc_litt_wet_mea(:) = zero
6487	tmc_litt_mea(:) = zero
6488	humrel(:,:) = zero
6489	vegstress(:,:) = zero
6490	IF (ok_freeze_cwrr) THEN
6491	profil_froz_hydro(:,:)=zero ! initialisation for the mean of profil_froz_hydro_ns
6492	ENDIF
6493
6494	!! 2. Sum 3d variables in 2d variables with fraction of vegetation per soil type
6495
6496	DO ji = 1, kjpindex
6497	mask_vegtot(ji) = 0
6498	IF(vegtot(ji) .GT. min_sechiba) THEN
6499	mask_vegtot(ji) = 1
6500	ENDIF
6501	END DO
6502
6503	DO ji = 1, kjpindex
6504	! Here we weight ae_ns by the fraction of bare evaporating soil.
6505	! This is given by frac_bare_ns, taking into account bare soil under vegetation
6506	ae_ns(ji,:) = mask_vegtot(ji) * ae_ns(ji,:) * frac_bare_ns(ji,:)
6507	END DO
6508
6509	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
6510	DO jst = 1, nstm
6511	DO ji = 1, kjpindex
6512	drainage(ji) = mask_vegtot(ji) * (drainage(ji) + vegtot(ji)soiltile(ji,jst) dr_ns(ji,jst))
6513	runoff(ji) = mask_vegtot(ji) * (runoff(ji) + vegtot(ji)soiltile(ji,jst) ru_ns(ji,jst)) &
6514	& + (1 - mask_vegtot(ji)) * (tot_melt(ji) + irrigation(ji) + returnflow(ji) + reinfiltration(ji))
6515	humtot(ji) = mask_vegtot(ji) * (humtot(ji) + vegtot(ji)soiltile(ji,jst) tmc(ji,jst))
6516	IF (ok_freeze_cwrr) THEN
6517	! profil_froz_hydro_ns comes from hydrol_soil, to remain the same as in the prognotic loop
6518	profil_froz_hydro(ji,:)=mask_vegtot(ji) * &
6519	(profil_froz_hydro(ji,:) + vegtot(ji)soiltile(ji,jst) profil_froz_hydro_ns(ji,:, jst))
6520	ENDIF
6521	END DO
6522	END DO
6523
6524	! we add the excess of snow sublimation to vevapnu
6525	! - because vevapsno is modified in hydrol_snow if subsinksoil
6526	! - it is multiplied by vegtot because it is devided by 1-tot_frac_nobio at creation in hydrol_snow
6527
6528	DO ji = 1,kjpindex
6529	vevapnu(ji) = vevapnu (ji) + subsinksoil(ji)*vegtot(ji)
6530	END DO
6531
6532	DO jst=1,nstm
6533	DO jv=1,nvm
6534	DO ji=1,kjpindex
6535	IF(veget_max(ji,jv).GT.min_sechiba) THEN
6536	vegstress(ji,jv)=vegstress(ji,jv)+vegstressv(ji,jv,jst)
6537	vegstress(ji,jv)= MAX(vegstress(ji,jv),zero)
6538	ENDIF
6539	END DO
6540	END DO
6541	END DO
6542
6543	DO jst=1,nstm
6544	DO jv=1,nvm
6545	DO ji=1,kjpindex
6546	humrel(ji,jv)=humrel(ji,jv)+humrelv(ji,jv,jst)
6547	humrel(ji,jv)=MAX(humrel(ji,jv),zero)
6548	END DO
6549	END DO
6550	END DO
6551
6552	!! Litter... the goal is to calculate drysoil_frac, to calculate the albedo in condveg
6553	! In condveg, drysoil_frac serve to calculate the albedo of drysoil, excluding the nobio contribution which is further added
6554	! In conclusion, we calculate drysoil_frac based on moisture averages restricted to the soiltile (no multiplication by vegtot)
6555	! BUT THIS IS NOT USED ANYMORE WITH THE NEW BACKGROUNG ALBEDO
6556	!! k_litt is calculated here as a grid-cell average (for consistency with drainage)
6557	!! litterhumdiag, like shumdiag, is averaged over the soiltiles for transmission to stomate
6558	DO jst=1,nstm
6559	DO ji=1,kjpindex
6560	! We compute here a mean k for the 'litter' used for reinfiltration from floodplains of ponds
6561	IF ( tmc_litter(ji,jst) < tmc_litter_res(ji,jst)) THEN
6562	i = imin
6563	ELSE
6564	tmc_litter_ratio = (tmc_litter(ji,jst)-tmc_litter_res(ji,jst)) / &
6565	& (tmc_litter_sat(ji,jst)-tmc_litter_res(ji,jst))
6566	i= MAX(MIN(INT((imax-imin)*tmc_litter_ratio)+imin, imax-1), imin)
6567	ENDIF
6568	k_tmp = MAX(k_lin(i,1,ji)*ks(ji), zero)
6569	k_litt(ji) = k_litt(ji) + vegtot(ji)soiltile(ji,jst) SQRT(k_tmp) ! grid-cell average
6570	ENDDO
6571	DO ji=1,kjpindex
6572	litterhumdiag(ji) = litterhumdiag(ji) + &
6573	& soil_wet_litter(ji,jst) * soiltile(ji,jst)
6574
6575	tmc_litt_wet_mea(ji) = tmc_litt_wet_mea(ji) + &
6576	& tmc_litter_awet(ji,jst)* soiltile(ji,jst)
6577
6578	tmc_litt_dry_mea(ji) = tmc_litt_dry_mea(ji) + &
6579	& tmc_litter_adry(ji,jst) * soiltile(ji,jst)
6580
6581	tmc_litt_mea(ji) = tmc_litt_mea(ji) + &
6582	& tmc_litter(ji,jst) * soiltile(ji,jst)
6583	ENDDO
6584	ENDDO
6585
6586	DO ji=1,kjpindex
6587	IF ( tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji) > zero ) THEN
6588	drysoil_frac(ji) = un + MAX( MIN( (tmc_litt_dry_mea(ji) - tmc_litt_mea(ji)) / &
6589	& (tmc_litt_wet_mea(ji) - tmc_litt_dry_mea(ji)), zero), - un)
6590	ELSE
6591	drysoil_frac(ji) = zero
6592	ENDIF
6593	END DO
6594
6595	! Calculate soilmoist, as a function of total water content (mc)
6596	! We average the values of each soiltile and multiply by vegtot to transform to a grid-cell mean
6597	soilmoist(:,:) = zero
6598	DO jst=1,nstm
6599	DO ji=1,kjpindex
6600	soilmoist(ji,1) = soilmoist(ji,1) + soiltile(ji,jst) * &
6601	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
6602	DO jsl = 2,nslm-1
6603	soilmoist(ji,jsl) = soilmoist(ji,jsl) + soiltile(ji,jst) * &
6604	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
6605	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
6606	END DO
6607	soilmoist(ji,nslm) = soilmoist(ji,nslm) + soiltile(ji,jst) * &
6608	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
6609	END DO
6610	END DO
6611	DO ji=1,kjpindex
6612	soilmoist(ji,:) = soilmoist(ji,:) * vegtot(ji) ! conversion to grid-cell average
6613	ENDDO
6614
6615	soilmoist_s(:,:,:) = zero
6616	DO jst=1,nstm
6617	DO ji=1,kjpindex
6618	soilmoist_s(ji,1,nstm) = soilmoist_s(ji,1,nstm) + soiltile(ji,jst) * &
6619	dz(2) * ( trois*mc(ji,1,jst) + mc(ji,2,jst) )/huit
6620	DO jsl = 2,nslm-1
6621	soilmoist_s(ji,jsl,nstm) = soilmoist_s(ji,jsl,nstm) + soiltile(ji,jst) * &
6622	( dz(jsl) * (trois*mc(ji,jsl,jst)+mc(ji,jsl-1,jst))/huit &
6623	+ dz(jsl+1) * (trois*mc(ji,jsl,jst)+mc(ji,jsl+1,jst))/huit )
6624	END DO
6625	soilmoist_s(ji,nslm,nstm) = soilmoist_s(ji,nslm,nstm) + soiltile(ji,jst) * &
6626	dz(nslm) * (trois*mc(ji,nslm,jst) + mc(ji,nslm-1,jst))/huit
6627	END DO
6628	END DO
6629	DO ji=1,kjpindex
6630	soilmoist_s(ji,:,:) = soilmoist_s(ji,:,:) * vegtot(ji) ! conversion to grid-cell average
6631	ENDDO
6632
6633	soilmoist_liquid(:,:) = zero
6634	DO jst=1,nstm
6635	DO ji=1,kjpindex
6636	soilmoist_liquid(ji,1) = soilmoist_liquid(ji,1) + soiltile(ji,jst) * &
6637	dz(2) * ( trois*mcl(ji,1,jst) + mcl(ji,2,jst) )/huit
6638	DO jsl = 2,nslm-1
6639	soilmoist_liquid(ji,jsl) = soilmoist_liquid(ji,jsl) + soiltile(ji,jst) * &
6640	( dz(jsl) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl-1,jst))/huit &
6641	+ dz(jsl+1) * (trois*mcl(ji,jsl,jst)+mcl(ji,jsl+1,jst))/huit )
6642	END DO
6643	soilmoist_liquid(ji,nslm) = soilmoist_liquid(ji,nslm) + soiltile(ji,jst) * &
6644	dz(nslm) * (trois*mcl(ji,nslm,jst) + mcl(ji,nslm-1,jst))/huit
6645	ENDDO
6646	ENDDO
6647	DO ji=1,kjpindex
6648	soilmoist_liquid(ji,:) = soilmoist_liquid(ji,:) * vegtot_old(ji) ! grid cell average
6649	ENDDO
6650
6651
6652	! Shumdiag: we start from soil_wet_ns, change the range over which the relative moisture is calculated,
6653	! then do a spatial average, excluding the nobio fraction on which stomate doesn't act
6654	DO jst=1,nstm
6655	DO jsl=1,nslm
6656	DO ji=1,kjpindex
6657	shumdiag(ji,jsl) = shumdiag(ji,jsl) + soil_wet_ns(ji,jsl,jst) * soiltile(ji,jst) * &
6658	((mcs(ji)-mcw(ji))/(mcfc(ji)-mcw(ji)))
6659	shumdiag(ji,jsl) = MAX(MIN(shumdiag(ji,jsl), un), zero)
6660	ENDDO
6661	ENDDO
6662	ENDDO
6663
6664	! Shumdiag_perma is based on soilmoist / moisture at saturation in the layer
6665	! Her we start from grid averages by hydrol soil layer and transform it to the diag levels
6666	! We keep a grid-cell average, like for all variables transmitted to ok_freeze
6667	DO jsl=1,nslm
6668	DO ji=1,kjpindex
6669	shumdiag_perma(ji,jsl) = soilmoist(ji,jsl) / (dh(jsl)*mcs(ji))
6670	shumdiag_perma(ji,jsl) = MAX(MIN(shumdiag_perma(ji,jsl), un), zero)
6671	ENDDO
6672	ENDDO
6673
6674	END SUBROUTINE hydrol_diag_soil
6675
6676
6677	!! ================================================================================================================================
6678	!! SUBROUTINE : hydrol_alma
6679	!!
6680	!>\BRIEF This routine computes the changes in soil moisture and interception storage for the ALMA outputs.
6681	!!
6682	!! DESCRIPTION : None
6683	!!
6684	!! RECENT CHANGE(S) : None
6685	!!
6686	!! MAIN OUTPUT VARIABLE(S) :
6687	!!
6688	!! REFERENCE(S) :
6689	!!
6690	!! FLOWCHART : None
6691	!! \n
6692	!_ ================================================================================================================================
6693	!_ hydrol_alma
6694
6695	SUBROUTINE hydrol_alma (kjpindex, index, lstep_init, qsintveg, snow, snow_nobio, soilwet)
6696	!
6697	!! 0. Variable and parameter declaration
6698
6699	!! 0.1 Input variables
6700
6701	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size
6702	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: index !! Indeces of the points on the map
6703	LOGICAL, INTENT (in) :: lstep_init !! At which time is this routine called ?
6704	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: qsintveg !! Water on vegetation due to interception
6705	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: snow !! Snow water equivalent
6706	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (in) :: snow_nobio !! Water balance on ice, lakes, .. [Kg/m^2]
6707
6708	!! 0.2 Output variables
6709
6710	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: soilwet !! Soil wetness
6711
6712	!! 0.3 Modified variables
6713
6714	!! 0.4 Local variables
6715
6716	INTEGER(i_std) :: ji
6717	REAL(r_std) :: watveg
6718
6719	!_ ================================================================================================================================
6720	!
6721	!
6722	IF ( lstep_init ) THEN
6723	! Initialize variables if they were not found in the restart file
6724
6725	DO ji = 1, kjpindex
6726	watveg = SUM(qsintveg(ji,:))
6727	tot_watveg_beg(ji) = watveg
6728	tot_watsoil_beg(ji) = humtot(ji)
6729	snow_beg(ji) = snow(ji) + SUM(snow_nobio(ji,:))
6730
6731	ENDDO
6732
6733	RETURN
6734
6735	ENDIF
6736	!
6737	! Calculate the values for the end of the time step
6738	!
6739	DO ji = 1, kjpindex
6740	watveg = SUM(qsintveg(ji,:)) ! average within the mesh
6741	tot_watveg_end(ji) = watveg
6742	tot_watsoil_end(ji) = humtot(ji) ! average within the mesh
6743	snow_end(ji) = snow(ji)+ SUM(snow_nobio(ji,:)) ! average within the mesh
6744	delintercept(ji) = tot_watveg_end(ji) - tot_watveg_beg(ji) ! average within the mesh
6745	delsoilmoist(ji) = tot_watsoil_end(ji) - tot_watsoil_beg(ji)
6746	delswe(ji) = snow_end(ji) - snow_beg(ji) ! average within the mesh
6747
6748	ENDDO
6749	!
6750	!
6751	! Transfer the total water amount at the end of the current timestep top the begining of the next one.
6752	!
6753	tot_watveg_beg = tot_watveg_end
6754	tot_watsoil_beg = tot_watsoil_end
6755	snow_beg(:) = snow_end(:)
6756	!
6757	DO ji = 1,kjpindex
6758	IF ( mx_eau_var(ji) > 0 ) THEN
6759	soilwet(ji) = tot_watsoil_end(ji) / mx_eau_var(ji)
6760	ELSE
6761	soilwet(ji) = zero
6762	ENDIF
6763	ENDDO
6764	!
6765	END SUBROUTINE hydrol_alma
6766
6767
6768	!! ================================================================================================================================
6769	!! SUBROUTINE : hydrol_nudge_mc_read
6770	!!
6771	!>\BRIEF Read soil moisture from file and interpolate to the current time step
6772	!!
6773	!! 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.
6774	!! This subroutine reads and interpolates spatialy if necessary and temporary the soil moisture from file.
6775	!! The values for the soil moisture will be applaied later using hydrol_nudge_mc
6776	!!
6777	!! RECENT CHANGE(S) : None
6778	!!
6779	!! \n
6780	!_ ================================================================================================================================
6781
6782	SUBROUTINE hydrol_nudge_mc_read(kjit)
6783
6784	!! 0.1 Input variables
6785	INTEGER(i_std), INTENT(in) :: kjit !! Timestep number
6786
6787	!! 0.3 Locals variables
6788	REAL(r_std) :: tau !! Position between to values in nudge mc file
6789	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
6790	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
6791	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
6792	REAL(r_std), DIMENSION(nbp_glo,nslm,nstm) :: mc_read_glo1D !! mc_read_glo2D on land-only vector form, in global
6793	INTEGER(i_std), SAVE :: istart_mc !! start index to read from input file
6794	!$OMP THREADPRIVATE(istart_mc)
6795	INTEGER(i_std) :: iend !! end index to read from input file
6796	INTEGER(i_std) :: i, j, ji, jg, jst, jsl!! loop index
6797	INTEGER(i_std) :: iim_file, jjm_file, llm_file !! Dimensions in input file
6798	INTEGER(i_std), SAVE :: ttm_mc !! Time dimensions in input file
6799	!$OMP THREADPRIVATE(ttm_mc)
6800	INTEGER(i_std), SAVE :: mc_id !! index for netcdf files
6801	!$OMP THREADPRIVATE(mc_id)
6802	LOGICAL, SAVE :: firsttime_mc=.TRUE.
6803	!$OMP THREADPRIVATE(firsttime_mc)
6804
6805
6806	!! 1. Nudging of soil moisture
6807
6808	!! 1.2 Read mc from file, once a day only
6809	!! The forcing file must contain daily frequency variable for the full year of the simulation
6810	IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN
6811	! Save mc read from file from previous day
6812	mc_read_prev = mc_read_next
6813
6814	IF (nudge_interpol_with_xios) THEN
6815	! Read mc from input file. XIOS interpolates it to the model grid before it is received here.
6816	CALL xios_orchidee_recv_field("moistc_interp", mc_read_next)
6817
6818	! Read and interpolation the mask for variable mc from input file.
6819	! This is only done to be able to output the mask it later for validation purpose.
6820	! The mask corresponds to the fraction of the input source file which was underlaying the model grid cell.
6821	! 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.
6822	CALL xios_orchidee_recv_field("mask_moistc_interp", mask_mc_interp)
6823
6824	ELSE
6825
6826	! Only read fields from the file. We here suppose that no interpolation is needed.
6827	IF (is_root_prc) THEN
6828	IF (firsttime_mc) THEN
6829	! Open and read dimenions in file
6830	CALL flininfo('nudge_moistc.nc', iim_file, jjm_file, llm_file, ttm_mc, mc_id)
6831
6832	! Coherence test between dimension in the file and in the model run
6833	IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
6834	WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_mc=', &
6835	iim_file, jjm_file, llm_file, ttm_mc
6836	WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
6837	CALL ipslerr_p(3,'hydrol_nudge','Problem in coherence between dimensions in nudge_moistc.nc file and model',&
6838	'No interpolation is done on this file','This input file must be on the same horizontal resolution as the model.')
6839	END IF
6840
6841	firsttime_mc=.FALSE.
6842	istart_mc=julian_diff-1 ! initialize time counter to read
6843	IF (printlev>=2) WRITE(numout,*) "Start read nudge_moistc.nc file at time step: ", istart_mc+1
6844	END IF
6845
6846	istart_mc=istart_mc+1 ! read next time step in the file
6847	iend=istart_mc ! only read 1 time step
6848
6849	! Read mc from file, one variable per soiltile
6850	IF (printlev>=3) WRITE(numout,*) &
6851	"Read variables moistc_1, moistc_2 and moistc_3 from nudge_moistc.nc at time step: ", istart_mc
6852	CALL flinget (mc_id, 'moistc_1', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_1)
6853	CALL flinget (mc_id, 'moistc_2', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_2)
6854	CALL flinget (mc_id, 'moistc_3', iim_g, jjm_g, nslm, ttm_mc, istart_mc, iend, mc_read_glo2D_3)
6855
6856	! Transform from global 2D(iim_g, jjm_g) into into land-only global 1D(nbp_glo)
6857	! Put the variables on the 3 soiltiles in the same file
6858	DO ji = 1, nbp_glo
6859	j = ((index_g(ji)-1)/iim_g) + 1
6860	i = (index_g(ji) - (j-1)*iim_g)
6861	mc_read_glo1D(ji,:,1) = mc_read_glo2D_1(i,j,:,1)
6862	mc_read_glo1D(ji,:,2) = mc_read_glo2D_2(i,j,:,1)
6863	mc_read_glo1D(ji,:,3) = mc_read_glo2D_3(i,j,:,1)
6864	END DO
6865	END IF
6866
6867	! Distribute the fields on all processors
6868	CALL scatter(mc_read_glo1D, mc_read_next)
6869
6870	! No interpolation is done, set the mask to 1
6871	mask_mc_interp(:,:,:) = 1
6872
6873	END IF ! nudge_interpol_with_xios
6874	END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
6875
6876
6877	!! 1.3 Linear time interpolation between daily fields to the current time step
6878	tau = (kjit-1)dt_sechiba/one_day - AINT((kjit-1)dt_sechiba/one_day)
6879	mc_read_current(:,:,:) = (1.-tau)mc_read_prev(:,:,:) + taumc_read_next(:,:,:)
6880
6881	!! 1.4 Output daily fields and time interpolated fields only for debugging and validation purpose
6882	CALL xios_orchidee_send_field("mc_read_next", mc_read_next)
6883	CALL xios_orchidee_send_field("mc_read_current", mc_read_current)
6884	CALL xios_orchidee_send_field("mc_read_prev", mc_read_prev)
6885	CALL xios_orchidee_send_field("mask_mc_interp_out", mask_mc_interp)
6886
6887
6888	END SUBROUTINE hydrol_nudge_mc_read
6889
6890	!! ================================================================================================================================
6891	!! SUBROUTINE : hydrol_nudge_mc
6892	!!
6893	!>\BRIEF Applay nuding for soil moisture
6894	!!
6895	!! DESCRIPTION : Applay nudging for soil moisture. The nuding values were previously read and interpolated using
6896	!! the subroutine hydrol_nudge_mc_read
6897	!! This subroutine is called from a loop over all soil tiles.
6898	!!
6899	!! RECENT CHANGE(S) : None
6900	!!
6901	!! \n
6902	!_ ================================================================================================================================
6903	SUBROUTINE hydrol_nudge_mc(kjpindex, jst, mc_loc)
6904
6905	!! 0.1 Input variables
6906	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6907	INTEGER(i_std), INTENT(in) :: jst !! Index for current soil tile
6908
6909	!! 0.2 Modified variables
6910	REAL(r_std), DIMENSION(kjpindex,nslm,nstm), INTENT(inout) :: mc_loc !! Soil moisture
6911
6912	!! 0.2 Locals variables
6913	REAL(r_std), DIMENSION(kjpindex,nslm,nstm) :: mc_aux !! Temorary variable for calculation of nudgincsm
6914	INTEGER(i_std) :: ji, jsl !! loop index
6915
6916
6917	!! 1.5 Applay nudging of soil moisture using alpha_nudge_mc at each model sechiba time step.
6918	!! alpha_mc_nudge calculated using the parameter for relaxation time NUDGE_TAU_MC set in module constantes.
6919	!! alpha_nudge_mc is between 0-1
6920	!! If alpha_nudge_mc=1, the new mc will be replaced by the one read from file
6921	mc_loc(:,:,jst) = (1-alpha_nudge_mc)mc_loc(:,:,jst) + alpha_nudge_mc mc_read_current(:,:,jst)
6922
6923
6924	!! 1.6 Calculate diagnostic for nudging increment of water in soil moisture
6925	!! Here calculate tmc_aux for the current soil tile. Later in hydrol_nudge_mc_diag, this will be used to calculate nudgincsm
6926	mc_aux(:,:,jst) = alpha_nudge_mc * ( mc_read_current(:,:,jst) - mc_loc(:,:,jst))
6927	DO ji=1,kjpindex
6928	tmc_aux(ji,jst) = dz(2) * ( trois*mc_aux(ji,1,jst) + mc_aux(ji,2,jst) )/huit
6929	DO jsl = 2,nslm-1
6930	tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(jsl) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl-1,jst))/huit &
6931	+ dz(jsl+1) * (trois*mc_aux(ji,jsl,jst)+mc_aux(ji,jsl+1,jst))/huit
6932	ENDDO
6933	tmc_aux(ji,jst) = tmc_aux(ji,jst) + dz(nslm) * (trois*mc_aux(ji,nslm,jst) + mc_aux(ji,nslm-1,jst))/huit
6934	ENDDO
6935
6936
6937	END SUBROUTINE hydrol_nudge_mc
6938
6939
6940	SUBROUTINE hydrol_nudge_mc_diag(kjpindex, soiltile)
6941	!! 0.1 Input variables
6942	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6943	REAL(r_std), DIMENSION(kjpindex,nstm), INTENT (in) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
6944
6945	!! 0.2 Locals variables
6946	REAL(r_std), DIMENSION(kjpindex) :: nudgincsm !! Nudging increment of water in soil moisture
6947	INTEGER(i_std) :: ji, jst !! loop index
6948
6949
6950	! Average over grid-cell
6951	nudgincsm(:) = zero
6952	DO jst=1,nstm
6953	DO ji=1,kjpindex
6954	nudgincsm(ji) = nudgincsm(ji) + vegtot(ji) * soiltile(ji,jst) * tmc_aux(ji,jst)
6955	ENDDO
6956	ENDDO
6957
6958	CALL xios_orchidee_send_field("nudgincsm", nudgincsm)
6959
6960	END SUBROUTINE hydrol_nudge_mc_diag
6961
6962
6963	!! ================================================================================================================================
6964	!! SUBROUTINE : hydrol_nudge_snow
6965	!!
6966	!>\BRIEF Read, interpolate and applay nudging snow variables
6967	!!
6968	!! DESCRIPTION : Nudging of snow variables is done if OK_NUDGE_SNOW=y is set in run.def
6969	!!
6970	!! RECENT CHANGE(S) : None
6971	!!
6972	!! MAIN IN-OUTPUT VARIABLE(S) : snowdz, snowrho, snowtemp
6973	!!
6974	!! REFERENCE(S) :
6975	!!
6976	!! \n
6977	!_ ================================================================================================================================
6978
6979
6980	SUBROUTINE hydrol_nudge_snow(kjit, kjpindex, snowdz, snowrho, snowtemp )
6981
6982	!! 0.1 Input variables
6983	INTEGER(i_std), INTENT(in) :: kjit !! Timestep number
6984	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
6985
6986	!! 0.2 Modified variables
6987	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowdz !! Snow layer thickness [m]
6988	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowrho !! Snow density (Kg/m^3)
6989	REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(inout) :: snowtemp !! Snow temperature (K)
6990
6991
6992
6993	!! 0.3 Locals variables
6994	REAL(r_std) :: tau !! Position between to values in nudge mc file
6995	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowdz_read_current !! snowdz from file interpolated to current timestep [m]
6996	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowrho_read_current !! snowrho from file interpolated to current timestep (Kg/m^3)
6997	REAL(r_std), DIMENSION(kjpindex,nsnow) :: snowtemp_read_current !! snowtemp from file interpolated to current timestep (K)
6998	REAL(r_std), DIMENSION(kjpindex) :: nudgincswe !! Nudging increment of water in snow
6999	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowdz_read_glo2D !! snowdz from file at global 2D(lat,lon) grid [m]
7000	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowrho_read_glo2D !! snowrho from file at global 2D(lat,lon) grid (Kg/m^3)
7001	REAL(r_std), DIMENSION(iim_g,jjm_g,nsnow,1):: snowtemp_read_glo2D !! snowrho from file at global 2D(lat,lon) grid (K)
7002	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowdz_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global (m)
7003	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowrho_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global (Kg/m^3)
7004	REAL(r_std), DIMENSION(nbp_glo,nsnow) :: snowtemp_read_glo1D !! snowdz_read_glo2D on land-only vector form, in global (K)
7005	INTEGER(i_std), SAVE :: istart_snow!! start index to read from input file
7006	!$OMP THREADPRIVATE(istart_snow)
7007	INTEGER(i_std) :: iend !! end index to read from input file
7008	INTEGER(i_std) :: i, j, ji, jg, jst, jsl!! loop index
7009	INTEGER(i_std) :: iim_file, jjm_file, llm_file !! Dimensions in input file
7010	INTEGER(i_std), SAVE :: ttm_snow !! Time dimensions in input file
7011	!$OMP THREADPRIVATE(ttm_snow)
7012	INTEGER(i_std), SAVE :: snow_id !! index for netcdf files
7013	!$OMP THREADPRIVATE(snow_id)
7014	LOGICAL, SAVE :: firsttime_snow=.TRUE.
7015	!$OMP THREADPRIVATE(firsttime_snow)
7016
7017
7018	!! 2. Nudging of snow variables
7019	IF (ok_nudge_snow) THEN
7020
7021	!! 2.1 Read snow variables from file, once a day only
7022	!! The forcing file must contain daily frequency values for the full year of the simulation
7023	IF (MOD(kjit,INT(one_day/dt_sechiba)) == 1) THEN
7024	! Save variables from previous day
7025	snowdz_read_prev = snowdz_read_next
7026	snowrho_read_prev = snowrho_read_next
7027	snowtemp_read_prev = snowtemp_read_next
7028
7029	IF (nudge_interpol_with_xios) THEN
7030	! Read and interpolation snow variables and the mask from input file
7031	CALL xios_orchidee_recv_field("snowdz_interp", snowdz_read_next)
7032	CALL xios_orchidee_recv_field("snowrho_interp", snowrho_read_next)
7033	CALL xios_orchidee_recv_field("snowtemp_interp", snowtemp_read_next)
7034	CALL xios_orchidee_recv_field("mask_snow_interp", mask_snow_interp)
7035
7036	ELSE
7037	! Only read fields from the file. We here suppose that no interpolation is needed.
7038	IF (is_root_prc) THEN
7039	IF (firsttime_snow) THEN
7040	! Open and read dimenions in file
7041	CALL flininfo('nudge_snow.nc', iim_file, jjm_file, llm_file, ttm_snow, snow_id)
7042
7043	! Coherence test between dimension in the file and in the model run
7044	IF ((iim_file /= iim_g) .OR. (jjm_file /= jjm_g)) THEN
7045	WRITE(numout,*) 'hydrol_nudge: iim_file, jjm_file, llm_file, ttm_snow=', &
7046	iim_file, jjm_file, llm_file, ttm_snow
7047	WRITE(numout,*) 'hydrol_nudge: iim_g, jjm_g=', iim_g, jjm_g
7048	CALL ipslerr_p(3,'hydrol_nudge','Problem in coherence between dimensions in nudge_snow.nc file and model',&
7049	'iim_file should be equal to iim_g','jjm_file should be equal to jjm_g')
7050	END IF
7051
7052	firsttime_snow=.FALSE.
7053	istart_snow=julian_diff-1 ! initialize time counter to read
7054	IF (printlev>=2) WRITE(numout,*) "Start read nudge_snow.nc file at time step: ", istart_snow+1
7055	END IF
7056
7057	istart_snow=istart_snow+1 ! read next time step in the file
7058	iend=istart_snow ! only read 1 time step
7059
7060	! Read snowdz, snowrho and snowtemp from file
7061	IF (printlev>=2) WRITE(numout,*) &
7062	"Read variables snowdz, snowrho and snowtemp from nudge_snow.nc at time step: ", istart_snow,ttm_snow
7063	CALL flinget (snow_id, 'snowdz', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowdz_read_glo2D)
7064	CALL flinget (snow_id, 'snowrho', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowrho_read_glo2D)
7065	CALL flinget (snow_id, 'snowtemp', iim_g, jjm_g, nsnow, ttm_snow, istart_snow, iend, snowtemp_read_glo2D)
7066
7067
7068	! Transform from global 2D(iim_g, jjm_g) variables into into land-only global 1D variables (nbp_glo)
7069	DO ji = 1, nbp_glo
7070	j = ((index_g(ji)-1)/iim_g) + 1
7071	i = (index_g(ji) - (j-1)*iim_g)
7072	snowdz_read_glo1D(ji,:) = snowdz_read_glo2D(i,j,:,1)
7073	snowrho_read_glo1D(ji,:) = snowrho_read_glo2D(i,j,:,1)
7074	snowtemp_read_glo1D(ji,:) = snowtemp_read_glo2D(i,j,:,1)
7075	END DO
7076	END IF
7077
7078	! Distribute the fields on all processors
7079	CALL scatter(snowdz_read_glo1D, snowdz_read_next)
7080	CALL scatter(snowrho_read_glo1D, snowrho_read_next)
7081	CALL scatter(snowtemp_read_glo1D, snowtemp_read_next)
7082
7083	! No interpolation is done, set the mask to 1
7084	mask_snow_interp=1
7085
7086	END IF ! nudge_interpol_with_xios
7087
7088
7089	! Test if the values for depth of snow is in a valid range when read from the file,
7090	! else set as no snow cover
7091	DO ji=1,kjpindex
7092	IF ((SUM(snowdz_read_next(ji,:)) .LE. 0.0) .OR. (SUM(snowdz_read_next(ji,:)) .GT. 100)) THEN
7093	! Snowdz has no valide values in the file, set here as no snow
7094	snowdz_read_next(ji,:) = 0
7095	snowrho_read_next(ji,:) = 50.0
7096	snowtemp_read_next(ji,:) = tp_00
7097	END IF
7098	END DO
7099
7100	END IF ! MOD(kjit,INT(one_day/dt_sechiba)) == 1
7101
7102
7103	!! 2.2 Linear time interpolation between daily fields for current time step
7104	tau = (kjit-1)dt_sechiba/one_day - AINT((kjit-1)dt_sechiba/one_day)
7105	snowdz_read_current(:,:) = (1.-tau)snowdz_read_prev(:,:) + tausnowdz_read_next(:,:)
7106	snowrho_read_current(:,:) = (1.-tau)snowrho_read_prev(:,:) + tausnowrho_read_next(:,:)
7107	snowtemp_read_current(:,:) = (1.-tau)snowtemp_read_prev(:,:) + tausnowtemp_read_next(:,:)
7108
7109	!! 2.3 Output daily fields and time interpolated fields only for debugging and validation purpose
7110	CALL xios_orchidee_send_field("snowdz_read_next", snowdz_read_next)
7111	CALL xios_orchidee_send_field("snowdz_read_current", snowdz_read_current)
7112	CALL xios_orchidee_send_field("snowdz_read_prev", snowdz_read_prev)
7113	CALL xios_orchidee_send_field("snowrho_read_next", snowrho_read_next)
7114	CALL xios_orchidee_send_field("snowrho_read_current", snowrho_read_current)
7115	CALL xios_orchidee_send_field("snowrho_read_prev", snowrho_read_prev)
7116	CALL xios_orchidee_send_field("snowtemp_read_next", snowtemp_read_next)
7117	CALL xios_orchidee_send_field("snowtemp_read_current", snowtemp_read_current)
7118	CALL xios_orchidee_send_field("snowtemp_read_prev", snowtemp_read_prev)
7119	CALL xios_orchidee_send_field("mask_snow_interp_out", mask_snow_interp)
7120
7121	!! 2.4 Applay nudging of snow variables using alpha_nudge_snow at each model sechiba time step.
7122	!! alpha_snow_nudge calculated using the parameter for relaxation time NUDGE_TAU_SNOW set in module constantes.
7123	!! alpha_nudge_snow is between 0-1
7124	!! If alpha_nudge_snow=1, the new snow variables will be replaced by the ones read from file.
7125	snowdz(:,:) = (1-alpha_nudge_snow)snowdz(:,:) + alpha_nudge_snow snowdz_read_current(:,:)
7126	snowrho(:,:) = (1-alpha_nudge_snow)snowrho(:,:) + alpha_nudge_snow snowrho_read_current(:,:)
7127	snowtemp(:,:) = (1-alpha_nudge_snow)snowtemp(:,:) + alpha_nudge_snow snowtemp_read_current(:,:)
7128
7129	!! 2.5 Calculate diagnostic for the nudging increment of water in snow
7130	nudgincswe=0.
7131	DO jg = 1, nsnow
7132	nudgincswe(:) = nudgincswe(:) + &
7133	alpha_nudge_snow(snowdz_read_current(:,jg)snowrho_read_current(:,jg)-snowdz(:,jg)*snowrho(:,jg))
7134	END DO
7135	CALL xios_orchidee_send_field("nudgincswe", nudgincswe)
7136
7137	END IF
7138
7139	END SUBROUTINE hydrol_nudge_snow
7140
7141
7142	!! ================================================================================================================================
7143	!! SUBROUTINE : hydrol_root_profile
7144	!!
7145	!>\BRIEF Calculates the share of the root biomass in each soil layer based on
7146	!! structural and functional approach.Calculate the root profile
7147	!!
7148	!! DESCRIPTION : Root structure is probably how most
7149	!! of us think about roots (i.e. digging a whole and observing where the roots
7150	!! are). When thinking at root structure, the profile should be relatively
7151	!! constant over time. A logic time integrator to determine this constancy is
7152	!! longevity_root as the profile cannot grow faster then the roots grow and die.
7153	!! Currently the structural root profile is simply fixed it over time. This could
7154	!! be changed by, for example, making humcste a function of the tree diameter.
7155
7156	!! In ORCHIDEE root structure is used in the calculation of kfact_root which is water
7157	!! infiltration along roots (accounted for in hydrol.f90) and the input of soil
7158	!! carbon and nitrogen at depth due to the turnover of roots which is accounted
7159	!! for stomate_soil_carbon_discretization.f90. Furthermore, it is used to calculate
7160	!! the root temperature in stomate_resp.f90. When thinking about root function it
7161	!! is not so important where the roots are located but it is more important at
7162	!! which depth the roots will be active. The function approach could be used to
7163	!! calculate from which soil layers the plants take most the soil water for their
7164	!! transpiration. This way of looking at the roots is similar to how we look at
7165	!! the canopy where we have a lot of leaves at places in the canopy where little
7166	!! light can penetrate and where a large part of the photosynthesis is taken care
7167	!! of by the leaves in the top layers of the canopy.
7168	!!
7169	!! NOTE: for the moment root structure and root function are only coupled through
7170	!! the depth of the soil. In the absence of roots, the root functions cannot be
7171	!! fullfilled. This is the most minimalistic coupling. It basically implies that
7172	!! a very small fraction of the roots, e.g., < 1% could take up all the water
7173	!! required for transpiration. A thighter coupling between structure and function
7174	!! is to be expected but this needs to be checked in the literature.
7175	!!
7176	!! RECENT CHANGE(S) : None
7177	!!
7178	!! MAIN OUTPUT VARIABLE(S) : root_profile
7179	!!
7180	!! REFERENCE(S) :
7181	!!
7182	!! \n
7183	!_ ================================================================================================================================
7184
7185	SUBROUTINE hydrol_root_profile(kjpindex, altmax, sm, smw, root_profile, root_depth)
7186
7187	!! 0.1 Input variables
7188	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size
7189	REAL(r_std), DIMENSION(:,:), INTENT(in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means not frozen.
7190	!! Not related with the active soil carbon pool.
7191	REAL(r_std), DIMENSION (:,:), INTENT(in) :: sm !! Soil moisture of each layer (liquid phase)
7192	!! @tex $(kg m^{-2})$ @endtex
7193	REAL(r_std), DIMENSION (:,:), INTENT(in) :: smw !! Soil moisture of each layer at wilting point
7194	!! @tex $(kg m^{-2})$ @endtex
7195
7196	!! 0.2 Output variables
7197	REAL(r_std), DIMENSION(:,:,:,:), INTENT(out) :: root_profile !! Normalized root mass/length fraction in each soil layer
7198	!! (0-1, unitless)
7199	!! DIM = kjpindex * nvm * nslm
7200	REAL(r_std), DIMENSION (:,:,:), INTENT(out) :: root_depth !! Node and interface numbers at which the deepest roots
7201	!! occur (1 to nslm, unitless)
7202
7203
7204	!! 0.3 Modified variables
7205
7206	!! 0.4 Local variables
7207	INTEGER(i_std) :: ji,jv,jsl !! Indices
7208	REAL(r_std) :: rpc !! Integration constant for vertical decomposer
7209	REAL(r_std) :: z_top, z_bottom !! top and bottom node in between which to integrate the root profile
7210	REAL(r_std), DIMENSION(kjpindex) :: count !! Count the number of errors
7211	REAL(r_std), DIMENSION(nslm) :: root_profile_tmp !! Temporary variable
7212	REAL(r_std) :: root_depth_tmp !! Temporary variable
7213
7214	!_ ================================================================================================================================
7215
7216	!! 1.Rooting depth
7217
7218	! Calculate the maximum depth roots occur at. Two constraints are already accouned
7219	! for: (1) crop can root to 0.8 m, grasslands are assumed to root no deeper than 1 m.
7220	! Trees can root down to 2 m. (2) Roots do not extend into frozen soils.
7221	! ORCHIDEE assumes that plant roots go down to the depth of the soil water profile
7222	! right from day 1. In other words, even a very young tree sapling, crop or grasslands
7223	! has roots that extend down to their :: max_root_depth.
7224	! Hence, plant age/height does NOT constraint rooting depth for now. A future
7225	! development could make rooting depth a function of plant height. This approach
7226	! would correctly increase the water stress of young vegetation but may wrongly
7227	! increase the water stress of young plants growing in semi-arid regions. In such
7228	! regions vegetative reproduction is likley to be common as it allows the offspring
7229	! to use water from the parent plant as long as the offsprong is too small to reach
7230	! the deeper water layers.
7231	root_depth(:,:,:) = zero
7232	DO ji = 1,kjpindex
7233	DO jv = 1,nvm
7234
7235	! Plants can root up to 2 m (zdr(jsl), the prescribed max_root_depth
7236	! or the first permafrost layer
7237	root_depth_tmp = MIN(MIN(altmax(ji,jv),maxaltmax), &
7238	MIN(zdr(nslm),max_root_depth(jv)))
7239
7240	! Find the index of the node which is the closest to the actual
7241	! root_depth. This layer is used to truncate the root profile.
7242	root_depth(ji,jv,inode) = MINLOC(ABS(root_depth_tmp-znh(:)),DIM=1)
7243
7244	! zdr is defined as a 0:nslm matrix. MINLOC does not know that
7245	! and gives the indices ad 1:nslm+1. Convert the indices back to
7246	! 0:nslm by subtracting 1.
7247	root_depth(ji,jv,iinterface) = MINLOC(ABS(root_depth_tmp-zdr(:)),DIM=1)-1
7248
7249	END DO ! jv
7250	END DO ! ji
7251
7252	! Prescribe a solution for very shallow root systems
7253	WHERE (root_depth(:,:,inode).LE.2)
7254	root_depth(:,:,inode) = 2
7255	ENDWHERE
7256
7257	WHERE (root_depth(:,:,iinterface).LE.2)
7258	root_depth(:,:,iinterface) = 2
7259	ENDWHERE
7260
7261
7262	!! 2.Structural root profile
7263
7264	! The structural root profile is calculated as an exponentially decreasing
7265	! root mass with depth which. ORCHIDEE uses the structural root profile to
7266	! calculate rain infiltration along the roots, som inputs at depth and the
7267	! root temperature for autotrophic respiration.
7268
7269	! NOTE: the shape of the profile is determined by its depth and the parameter
7270	! humcste. For the moment humcste is PFT-dependent but constant over time. The
7271	! depth is PFT-dependent (see above) and is a function of the active layer
7272	! thickness when the soil discretization is used. The depth of the root profile
7273	! could/should be made a function of tree diameter or plant biomass.
7274	root_profile(:,:,:,istruc) = zero
7275	DO jv = 1,nvm
7276	DO ji = 1,kjpindex
7277
7278	! Note that the integration will start at the top of the second layer (the
7279	! top of the first layer is zdr(0) hence the zdr(1) is the top of the
7280	! second layer) and will continue until the bottom of the profile. The
7281	! bottom is the profile is calculated above but never extends deeper than
7282	! the depth used in hydrol.f90 (in thermosoil.f90 the profile extends much
7283	! deeper. The first layer is excluded because the profile will be used to
7284	! extract water from the soil. The first layer is very thin and by extracting
7285	! water it could dry to quickly. Also in reality not too many roots are found
7286	! in the top mm of the soil. zdr describes the nodes and interfaces of the soil
7287	! layers as proposed by de Rosnay 1999 (PhD thesis).
7288	z_top = zdr(1)
7289	z_bottom = zdr(root_depth(ji,jv,iinterface))
7290
7291	! Calculate the total surface area under an exponential curve between
7292	! zdr(1) and the zdr(nslm)
7293	rpc = un / ( EXP(-z_top * humcste(jv)) - EXP(-z_bottom*humcste(jv)) )
7294
7295	DO jsl = 2, root_depth(ji,jv,iinterface)
7296
7297	! Calculate the share of the total roots for layers which are "centered"
7298	! at the nodes of the hydrology scheme. Centered was written in quotes
7299	! because the layer is not symmetric. Using the nodes as the center of the
7300	! layers follows De Rosnay (PhD, figure C.2 page 156). The root profile
7301	! starts at the top of the second layer, ends at the bottom of the 11th
7302	! layer and is calculated for the nodes in between.
7303	! The following equation are derived (but rewritten) from the integrals
7304	! of equations C9 to C11 of De Rosnay's (1999) PhD thesis (page 158).
7305	root_profile(ji,jv,jsl,istruc) = rpc * &
7306	( EXP(-zdr(jsl-1)humcste(jv)) - EXP(-zdr(jsl)humcste(jv)) )
7307
7308	END DO ! root_depth
7309
7310	! Top layer does not contain structural roots (see z_top)
7311	! This line is not needed but was added as a reminder.
7312	root_profile(ji,jv,1,istruc) = zero
7313
7314	! Error checking. Each root profile should add up to 1.
7315	IF (err_act.GT.1) THEN
7316	IF (ABS(SUM(root_profile(ji,jv,:,istruc))-un).GT.100*EPSILON(un)) THEN
7317	WRITE(numout,*) 'pixel, PFT, sum of structural root_profile, ', ji, jv, &
7318	SUM(root_profile(ji,jv,:,istruc))
7319	WRITE(numout,*) 'hydrol_root_profile, structural root_profile, ', &
7320	root_profile(ji,jv,:,istruc)
7321	CALL ipslerr_p(plev,'hydrol.f90', &
7322	'structural root profile does not add up to 1', &
7323	'Check its calculation', '')
7324	ENDIF
7325	END IF
7326
7327	END DO ! kjpindex
7328	ENDDO ! nvm
7329
7330
7331	!! 3. Functional root profile
7332
7333	! Calculates the share of the root biomass in each soil layer based on
7334	! the soil water content in each layer. The roots now follow the water.
7335	! this results in a very dynamic root profile that may change every half
7336	! hour (i.e. the time step for hydrol). ORCHIDEE uses the root function
7337	! to calculate plant water stress (hydraulic_arch.f90) and the soil layers
7338	! from which the transpiration is taken (hydrol.f90).
7339
7340	! NOTE: yet anonther root function is nutrient uptake. A separate root
7341	! profile could be calculated to be used in the calculation of N uptake
7342	! is stomate_soilcarbon.f90 (nitrogen_dynamics).
7343	root_profile(:,:,:,ifunc) = zero
7344	DO jv = 2, nvm
7345	DO ji = 1, kjpindex
7346
7347	! Plant available soil water per layer.
7348	! The calculations could make use of sm and smw. These variables has
7349	! been labelled soil moisture in kg/m2 and soil moisture at each layer
7350	! at wilting point also in kg/m2. As an alternative swc and mcr could
7351	! be used. swc is calculated in hydrol.f90 based on mc (m3/m3). mc is
7352	! used to calculate smt (total soil water thus liquid + ice) and mcl is
7353	! used to calculate sm (liquid only). sm denotes only liquid water, swc
7354	! denotes liquid and frozen water. Given the focus on root function, a
7355	! variable describing the liquid water seems the better choice.
7356
7357	!+++CHECK+++
7358	! The most important seems to be the difference in the dimensions of the
7359	! variables: the dimensions of sm variables are kjpindex,nslm the
7360	! dimension of the swc variable is kjpindex,nslm,nst. For the application
7361	! we have in mind a different root profile for each soil tile (nst) seems
7362	! desirable. Note that the difference in dimensions reflect the spatial
7363	! scale of the model but it is not clear at which scale one approach
7364	! (tile vs pixel) would be really prefered above another. Should we use
7365	! the commented code further below?
7366	root_profile_tmp(:) = zero
7367	DO jsl = 2, root_depth(ji,jv,iinterface)
7368	root_profile_tmp(jsl) = MAX(zero,sm(ji,jsl)-smw(ji,jsl) )
7369	ENDDO
7370	!+++++++++++
7371
7372	! Normalize to obtain a root profile (fraction between 0 and 1)
7373	IF (SUM(root_profile_tmp(:)) .GT. min_sechiba ) THEN
7374	root_profile(ji,jv,:,ifunc) = root_profile_tmp(:) / &
7375	SUM(root_profile_tmp(:))
7376	ELSE
7377	root_profile(ji,jv,:,ifunc) = zero
7378	END IF
7379
7380	! Top layer is not used for water uptake
7381	! This line is not needed but was added as a reminder.
7382	root_profile(ji,jv,1,ifunc) = zero
7383
7384	! The functional profile should also equal to one if there is soil moisture.
7385	IF (err_act.GT.1) THEN
7386	IF (ABS(SUM(root_profile(ji,jv,:,ifunc))-un).GT.100*EPSILON(un) .AND. &
7387	SUM(root_profile_tmp(:)) .GT. min_sechiba) THEN
7388	WRITE(numout,*) 'pixel, PFT, sum of functional root_profile, ', ji, jv, &
7389	SUM(root_profile(ji,jv,:,ifunc))
7390	WRITE(numout,*) 'hydrol_root_profile, functional root_profile, ', &
7391	root_profile(ji,jv,:,ifunc)
7392	CALL ipslerr_p(plev,'hydrol.f90', &
7393	'functional root profile does not add up to 1', &
7394	'Check its calculation', '')
7395	ENDIF
7396	ENDIF
7397
7398	END DO ! kjpindex
7399	ENDDO ! ivm
7400
7401
7402	!+++CHECK+++
7403	! The code above gives one root profile per pixel. The approach below would
7404	! enable calculating one root profile per soil tile (bare, short and
7405	! tall vegetation). NOTE that the variable name needs to be changed
7406	! from root_dens to root_profile and that the dimensions need to re-
7407	! ordered.
7408	!!$ DO ivm = 1, nvm
7409	!!$
7410	!!$ ! Link the pft to the soil tile
7411	!!$ istm = pref_soil_veg(ivm)
7412	!!$ IF ( is_tree(ivm) ) THEN
7413	!!$
7414	!!$ nroot_tmp(:) = zero
7415	!!$ ! Plant available soil water per layer. mcr is the residual soil
7416	!!$ ! water and depends on the soil type which is stored in njsc(ipts)
7417	!!$ DO ibdl = 2, nslm
7418	!!$ nroot_tmp(ibdl) = MAX(zero,swc(ipts,ibdl,istm)-mcr(njsc(ipts)))
7419	!!$ ENDDO
7420	!!$
7421	!!$ ELSE
7422	!!$
7423	!!$ ! Specific case for grasses where we only consider the first 1m of soil.
7424	!!$ ! Plant available soil water per layer. mcr is the residual soil
7425	!!$ ! water and depends on the soil type which is stored in njsc(ipts)
7426	!!$ nroot_tmp(:) = zero
7427	!!$ DO ibdl = 2, nslm
7428	!!$ IF (znt(ibdl) .LT. un) THEN
7429	!!$ nroot_tmp(ibdl) = MAX(zero,swc(ipts,ibdl,istm)-mcr(njsc(ipts)))
7430	!!$ ELSE
7431	!!$ nroot_tmp(ibdl) = zero
7432	!!$ END IF
7433	!!$ ENDDO
7434	!!$
7435	!!$ END IF
7436	!!$
7437	!!$ ! Normalize to obtain a root profile (fraction between 0 and 1)
7438	!!$ IF (SUM(nroot_tmp(:)) .GT. min_sechiba ) THEN
7439	!!$ root_dens(ipts,:,ivm) = nroot_tmp(:)/SUM(nroot_tmp(:))
7440	!!$ ELSE
7441	!!$ root_dens(ipts,:,ivm) = zero
7442	!!$ END IF
7443	!!$ root_dens(ipts,1,ivm) = zero
7444	!!$
7445	!!$ ENDDO
7446	!+++++++++++
7447
7448
7449	END SUBROUTINE hydrol_root_profile
7450
7451	END MODULE hydrol

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

Download in other formats: