Context Navigation

source: tags/ORCHIDEE_4_1/ORCHIDEE/src_sechiba/slowproc.f90 @ 7852

Last change on this file since 7852 was 7659, checked in by sebastiaan.luyssaert, 2 years ago
Added consistency checks to facilitate working on ticket #814. Solved a first problem with how veget_max_hist is used in the calculation of nbp. Changes have been successfuly tested over Europe for 110 years with and without land cover change for 15 PFTs
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 307.9 KB

Line
1	! =================================================================================================================================
2	! MODULE : slowproc
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 Groups the subroutines that: (1) initialize all variables used in
10	!! slowproc_main, (2) prepare the restart file for the next simulation, (3) Update the
11	!! vegetation cover if needed, and (4) handle all slow processes if the carbon
12	!! cycle is activated (call STOMATE) or update the vegetation properties (LAI and
13	!! fractional cover) in the case of a run with only SECHIBA.
14	!!
15	!!\n DESCRIPTION: None
16	!!
17	!! RECENT CHANGE(S): Allowed reading of USDA map, Nov 2014, ADucharne
18	!! November 2020: It is possible to define soil hydraulic parameters from maps,
19	!! as needed for the SP-MIP project (Tafasca Salma and Ducharne Agnes).
20	!! Changes in slowproc_xios_initialize, slowproc_soilt and slowproc_finalize
21	!!
22	!! REFERENCE(S) :
23	!!- Tafasca S. (2020). Evaluation de lâimpact des propriÃ©tÃ©s du sol sur lâhydrologie simulee dans le
24	!! modÃšle ORCHIDEE, PhD thesis, Sorbonne Universite. \n
25	!! SVN :
26	!! $HeadURL$
27	!! $Date$
28	!! $Revision$
29	!! \n
30	!_ ================================================================================================================================
31
32	MODULE slowproc
33
34	USE defprec
35	USE constantes
36	USE constantes_soil
37	USE pft_parameters
38	USE structures
39	USE ioipsl
40	USE xios_orchidee
41	USE ioipsl_para
42	USE sechiba_io_p
43	USE interpol_help
44	USE stomate
45	USE stomate_data
46	USE sapiens_lcchange, ONLY: check_loss_gain, check_veget, &
47	adjust_delta_veget_max, check_read_vegetmax
48	USE grid
49	USE solar, ONLY: solarang_noon
50	USE time, ONLY : dt_sechiba, dt_stomate, one_day, FirstTsYear, LastTsDay
51	USE time, ONLY : year_start, month_start, day_start, sec_start
52	USE time, ONLY : month_end, day_end
53	USE mod_orchidee_para
54	USE stomate_laieff, ONLY: effective_lai,find_lai_per_level, &
55	calculate_z_level_photo, fitting_laieff, &
56	stomate_laieff_initialize
57	USE function_library, ONLY: wood_to_qmheight, cc_to_lai, &
58	check_pixel_area, check_area_change, &
59	wood_to_height
60	IMPLICIT NONE
61
62	! Private & public routines
63
64	PRIVATE
65	PUBLIC slowproc_main, slowproc_clear, slowproc_initialize, slowproc_finalize, &
66	slowproc_xios_initialize, slowproc_veget
67
68	!
69	! variables used inside slowproc module : declaration and initialisation
70	!
71	REAL(r_std), SAVE :: slope_default = 0.1
72	!$OMP THREADPRIVATE(slope_default)
73	INTEGER(i_std) , SAVE :: Ninput_update !! update frequency in years for N inputs (nb of years)
74	!$OMP THREADPRIVATE(Ninput_update)
75	INTEGER, SAVE :: printlev_loc !! Local printlev in slowproc module
76	!$OMP THREADPRIVATE(printlev_loc)
77	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: clayfraction !! Clayfraction (0-1, unitless)
78	!$OMP THREADPRIVATE(clayfraction)
79	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: sandfraction !! Sandfraction (0-1, unitless)
80	!$OMP THREADPRIVATE(sandfraction)
81	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: siltfraction !! Siltfraction (0-1, unitless)
82	!$OMP THREADPRIVATE(siltfraction)
83	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: bulk !! Bulk density (kg/m**3)
84	!$OMP THREADPRIVATE(bulk)
85	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:) :: soil_ph !! Soil pH (-)
86	!$OMP THREADPRIVATE(soil_ph)
87	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: n_input !! nitrogen inputs (gN/m2/day) per points, per PFT and per type of N (Nox,NHx,Fert,Manure,BNF) - Monthly values (array of 12 elements)
88	!$OMP THREADPRIVATE(n_input)
89	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:,:,:) :: cc_biomass_m !! Monthly cc_biomass to prescribe the canopy structure if not calculated by STOMATE
90	!$OMP THREADPRIVATE(cc_biomass_m)
91	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:,:,:):: cc_n_m !! Monthly cc_n to prescribe the canopy structure if not calculated by STOMATE
92	!$OMP THREADPRIVATE(cc_n_m)
93	INTEGER(i_std) , SAVE :: ninput_year !! year for N inputs data
94	!$OMP THREADPRIVATE(ninput_year)
95	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cn_leaf_min_2D !! Minimal leaf CN ratio
96	!$OMP THREADPRIVATE(cn_leaf_min_2D)
97	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cn_leaf_max_2D !! Maximal leaf CN ratio
98	!$OMP THREADPRIVATE(cn_leaf_max_2D)
99	REAL(r_std), ALLOCATABLE, SAVE, DIMENSION (:,:) :: cn_leaf_init_2D !! Initial leaf CN ratio
100	!$OMP THREADPRIVATE(cn_leaf_init_2D)
101
102	CONTAINS
103
104
105	!! =============================================================================================================================
106	!! SUBROUTINE: slowproc_xios_initialize
107	!!
108	!>\BRIEF Initialize xios dependant defintion before closing context defintion
109	!!
110	!! DESCRIPTION: Initialize xios dependant defintion before closing context defintion
111	!!
112	!! RECENT CHANGE(S): Initialization of XIOS to read soil hydraulic parameters from maps,
113	!! as needed for the SP-MIP project (Tafasca Salma and Ducharne Agnes).
114	!! \n
115	!_ ==============================================================================================================================
116
117	SUBROUTINE slowproc_xios_initialize
118
119	CHARACTER(LEN=255) :: filename, name
120	LOGICAL :: lerr
121	REAL(r_std) :: slope_noreinf
122	LOGICAL :: get_slope
123	LOGICAL :: flag
124
125	IF (printlev>=3) WRITE(numout,*) 'In slowproc_xios_initialize'
126
127
128	!!
129	!! 1. Prepare for reading of soils_param file
130	!!
131
132	! Get the file name from run.def file and set file attributes accordingly
133	filename = 'soils_param.nc'
134	CALL getin_p('SOILCLASS_FILE',filename)
135	name = filename(1:LEN_TRIM(FILENAME)-3)
136	CALL xios_orchidee_set_file_attr("soils_param_file",name=name)
137
138	! Determine if soils_param_file will be read. If not, deactivate the file.
139	IF (xios_interpolation .AND. restname_in=='NONE' .AND. .NOT. impsoilt) THEN
140	! Reading will be done with XIOS later
141	IF (printlev>=2) WRITE(numout,*) 'Reading of soils_param file will be done later using XIOS. The filename is ', filename
142	ELSE
143	! No reading, deactivate soils_param_file
144	IF (printlev>=2) WRITE(numout,*) 'Reading of soils_param file will not be done with XIOS.'
145	CALL xios_orchidee_set_file_attr("soils_param_file",enabled=.FALSE.)
146	CALL xios_orchidee_set_fieldgroup_attr("soil_text",enabled=.FALSE.)
147	END IF
148
149
150	!!
151	!! 2. Prepare for reading of bulk variable
152	!!
153
154	! Get the file name from run.def file and set file attributes accordingly
155	filename = 'soil_bulk_and_ph.nc'
156	CALL getin_p('SOIL_BULK_FILE',filename)
157
158	name = filename(1:LEN_TRIM(FILENAME)-3)
159	CALL xios_orchidee_set_file_attr("soilbulk_file",name=name)
160
161	! Set variables that can be used in the xml files
162	lerr=xios_orchidee_setvar('bulk_default',bulk_default)
163
164	! Determine if the file will be read by XIOS. If not, deactivate reading of the file.
165	IF (xios_interpolation .AND. restname_in=='NONE' .AND. .NOT. impsoilt) THEN
166	! Reading will be done with XIOS later
167	IF (printlev>=2) WRITE(numout,*) 'Reading of soilbulk file will be done later using XIOS. The filename is ', filename
168	ELSE
169	! No reading by XIOS, deactivate soilbulk file and related variables declared in context_input_orchidee.xml.
170	! If this is not done, the model will crash if the file is not available in the run directory.
171	IF (printlev>=2) WRITE(numout,*) 'Reading of soil_bulk file will not be done with XIOS.'
172	CALL xios_orchidee_set_file_attr("soilbulk_file",enabled=.FALSE.)
173	CALL xios_orchidee_set_field_attr("soilbulk",enabled=.FALSE.)
174	CALL xios_orchidee_set_field_attr("soilbulk_mask",enabled=.FALSE.)
175	END IF
176
177	!!
178	!! 3. Prepare for reading of soil ph variable
179	!!
180
181	! Get the file name from run.def file and set file attributes accordingly
182	! soilbulk and soilph are by default in the same file but they can also be read from different files.
183	filename = 'soil_bulk_and_ph.nc'
184	CALL getin_p('SOIL_PH_FILE',filename)
185
186	name = filename(1:LEN_TRIM(FILENAME)-3)
187	CALL xios_orchidee_set_file_attr("soilph_file",name=name)
188
189	! Set variables that can be used in the xml files
190	lerr=xios_orchidee_setvar('ph_default',ph_default)
191
192	! Determine if the file will be read by XIOS. If not, deactivate the file.
193	IF (xios_interpolation .AND. restname_in=='NONE' .AND. .NOT. impsoilt) THEN
194	! Reading will be done with XIOS later
195	IF (printlev>=2) WRITE(numout,*) 'Reading of soilph file will be done later using XIOS. The filename is ', filename
196	ELSE
197	! No reading by XIOS, deactivate soilph file and related variables declared in context_input_orchidee.xml.
198	! If this is not done, the model will crash if the file is not available in the run directory.
199	IF (printlev>=2) WRITE(numout,*) 'Reading of soilph file will not be done with XIOS.'
200	CALL xios_orchidee_set_file_attr("soilph_file",enabled=.FALSE.)
201	CALL xios_orchidee_set_field_attr("soilph",enabled=.FALSE.)
202	CALL xios_orchidee_set_field_attr("soilph_mask",enabled=.FALSE.)
203	END IF
204
205
206	!!
207	!! 4. Prepare for reading of PFTmap file
208	!!
209
210	filename = 'PFTmap.nc'
211	CALL getin_p('VEGETATION_FILE',filename)
212	name = filename(1:LEN_TRIM(FILENAME)-3)
213	CALL xios_orchidee_set_file_attr("PFTmap_file",name=name)
214
215	! Check if PFTmap file will be read by XIOS in this execution
216	IF ( xios_interpolation .AND. .NOT. impveg .AND. &
217	(veget_update>0 .OR. restname_in=='NONE')) THEN
218	! PFTmap will not be read if impveg=TRUE
219	! PFTmap file will be read each year if veget_update>0
220	! PFTmap is read if the restart file do not exist and if impveg=F
221
222	! Reading will be done
223	IF (printlev>=2) WRITE(numout,*) 'Reading of PFTmap file will be done later using XIOS. The filename is ', filename
224	ELSE
225	! No reading, deactivate PFTmap file
226	IF (printlev>=2) WRITE(numout,*) 'Reading of PFTmap file will not be done with XIOS.'
227
228	CALL xios_orchidee_set_file_attr("PFTmap_file",enabled=.FALSE.)
229	CALL xios_orchidee_set_field_attr("frac_veget",enabled=.FALSE.)
230	CALL xios_orchidee_set_field_attr("frac_veget_frac",enabled=.FALSE.)
231	ENDIF
232
233
234	!!
235	!! 5. Prepare for reading of topography file
236	!!
237
238	filename = 'cartepente2d_15min.nc'
239	CALL getin_p('TOPOGRAPHY_FILE',filename)
240	name = filename(1:LEN_TRIM(FILENAME)-3)
241	CALL xios_orchidee_set_file_attr("topography_file",name=name)
242
243	! Set default values used by XIOS for the interpolation
244	slope_noreinf = 0.5 ! slope in percent
245	CALL getin_p('SLOPE_NOREINF',slope_noreinf)
246	lerr=xios_orchidee_setvar('slope_noreinf',slope_noreinf)
247	lerr=xios_orchidee_setvar('slope_default',slope_default)
248
249	get_slope = .FALSE.
250	CALL getin_p('GET_SLOPE',get_slope)
251	IF (xios_interpolation .AND. (restname_in=='NONE' .OR. get_slope)) THEN
252	! The slope file will be read using XIOS
253	IF (printlev>=2) WRITE(numout,*) 'Reading of albedo file will be done later using XIOS. The filename is ', filename
254	ELSE
255	! Deactivate slope reading
256	IF (printlev>=2) WRITE(numout,*) 'The slope file will not be read by XIOS'
257	CALL xios_orchidee_set_file_attr("topography_file",enabled=.FALSE.)
258	CALL xios_orchidee_set_field_attr("frac_slope_interp",enabled=.FALSE.)
259	CALL xios_orchidee_set_field_attr("reinf_slope_interp",enabled=.FALSE.)
260	END IF
261
262
263	!!
264	!! 6. Prepare for reading of lai file
265	!!
266
267	filename = 'lai2D.nc'
268	CALL getin_p('LAI_FILE',filename)
269	name = filename(1:LEN_TRIM(FILENAME)-3)
270	CALL xios_orchidee_set_file_attr("lai_file",name=name)
271	! Determine if lai file will be read by XIOS. If not, deactivate the file.
272	IF (xios_interpolation .AND. restname_in=='NONE' .AND. read_lai) THEN
273	! Reading will be done
274	IF (printlev>=2) WRITE(numout,*) 'Reading of lai file will be done later using XIOS. The filename is ', filename
275	ELSE
276	! No reading, deactivate lai file
277	IF (printlev>=2) WRITE(numout,*) 'Reading of lai file will not be done with XIOS.'
278	CALL xios_orchidee_set_file_attr("lai_file",enabled=.FALSE.)
279	CALL xios_orchidee_set_field_attr("frac_lai_interp",enabled=.FALSE.)
280	CALL xios_orchidee_set_field_attr("lai_interp",enabled=.FALSE.)
281	END IF
282
283
284	!!
285	!! 7. Prepare for reading of woodharvest file
286	!!
287
288	filename = 'woodharvest.nc'
289	CALL getin_p('WOODHARVEST_FILE',filename)
290	name = filename(1:LEN_TRIM(FILENAME)-3)
291	CALL xios_orchidee_set_file_attr("woodharvest_file",name=name)
292
293	IF (xios_interpolation .AND. do_wood_harvest .AND. &
294	(veget_update>0 .OR. restname_in=='NONE' )) THEN
295	! Woodharvest file will be read each year if veget_update>0 or if no restart file exists
296
297	! Reading will be done
298	IF (printlev>=2) WRITE(numout,*) 'Reading of woodharvest file will be done later using XIOS. The filename is ', filename
299	ELSE
300	! No reading, deactivate woodharvest file
301	IF (printlev>=2) WRITE(numout,*) 'Reading of woodharvest file will not be done with XIOS.'
302	CALL xios_orchidee_set_file_attr("woodharvest_file",enabled=.FALSE.)
303	CALL xios_orchidee_set_field_attr("woodharvest_interp",enabled=.FALSE.)
304	ENDIF
305
306
307	!!
308	!! 8. Prepare for reading of nitrogen maps
309	!!
310	flag=(ok_ncycle .AND. (.NOT. impose_CN .AND. .NOT. impose_ninput_dep))
311	CALL slowproc_xios_initialize_ninput('Nammonium',flag)
312	CALL slowproc_xios_initialize_ninput('Nnitrate',flag)
313
314	flag=(ok_ncycle .AND. (.NOT. impose_CN .AND. .NOT. impose_ninput_fert))
315	CALL slowproc_xios_initialize_ninput('Nfert',flag)
316	CALL slowproc_xios_initialize_ninput('Nfert_cropland',flag)
317	CALL slowproc_xios_initialize_ninput('Nfert_pasture',flag)
318
319	flag=(ok_ncycle .AND. (.NOT. impose_CN .AND. .NOT. impose_ninput_manure))
320	CALL slowproc_xios_initialize_ninput('Nmanure_cropland',flag)
321	CALL slowproc_xios_initialize_ninput('Nmanure_pasture',flag)
322
323	flag=(ok_ncycle .AND. (.NOT. impose_CN .AND. .NOT. impose_ninput_bnf))
324	CALL slowproc_xios_initialize_ninput('Nbnf',flag)
325
326	!! 9. Prepare for reading of soil parameter files
327
328	!! See commented part below for the reading of params_sp_mip.nc if spmipexp='maps'
329	!! (with a bug, but helpful)
330	!! This part was introduced to prepare the reading of params_sp_mip.nc if spmipexp='maps'
331	!! but there are mistakes in the IF ELSE ENDIF and we go through ELSE
332	!! each time xios_interpolation = T, even if we don't need to read this file
333	!! and it is not provided by sechiba.card
334	!! The corresponding part in context_input_orchidee.xml is also commented
335
336	! Get the file name from run.def file and set file attributes accordingly
337
338	!!$ filename = 'params_sp_mip.nc'
339	!!$ CALL getin_p('PARAM_FILE',filename)
340	!!$ name = filename(1:LEN_TRIM(FILENAME)-3)
341	!!$ IF (TRIM(filename)=='NONE') THEN
342	!!$ IF (printlev>=2) WRITE(numout,*) 'We won t readsoil hydraulic parameters from a file.'
343	!!$ ELSE
344	!!$ CALL xios_orchidee_set_file_attr("soilparam_file",name=name)
345	!!$ ! Determine if the file will be read by XIOS. If not, deactivate reading of the file.
346	!!$ IF (xios_interpolation .AND. restname_in=='NONE' .AND. .NOT. impsoilt) THEN
347	!!$ ! Reading will be done with XIOS later
348	!!$ IF (printlev>=2) WRITE(numout,*) 'Reading of soil hydraulic parameters file will be done later using XIOS. The filename is ', filename
349	!!$ ELSE
350	!!$ ! No reading by XIOS, deactivate soilparam_file and related variables declared in context_input_orchidee.xml.
351	!!$ ! If this is not done, the model will crash if the file is not available in the run directory.
352	!!$ IF (printlev>=2) WRITE(numout,*) 'Reading of soil parameter file will not be done with XIOS.'
353	!!$ CALL xios_orchidee_set_file_attr("soilparam_file",enabled=.FALSE.)
354	!!$ CALL xios_orchidee_set_field_attr("soilks",enabled=.FALSE.)
355	!!$ CALL xios_orchidee_set_field_attr("soilnvan",enabled=.FALSE.)
356	!!$ CALL xios_orchidee_set_field_attr("soilavan",enabled=.FALSE.)
357	!!$ CALL xios_orchidee_set_field_attr("soilmcr",enabled=.FALSE.)
358	!!$ CALL xios_orchidee_set_field_attr("soilmcs",enabled=.FALSE.)
359	!!$ CALL xios_orchidee_set_field_attr("soilmcfc",enabled=.FALSE.)
360	!!$ CALL xios_orchidee_set_field_attr("soilmcw",enabled=.FALSE.)
361	!!$ ENDIF
362	!!$ ENDIF
363
364	IF (printlev_loc>=3) WRITE(numout,*) 'End slowproc_xios_intialize'
365
366	END SUBROUTINE slowproc_xios_initialize
367
368
369	!! ================================================================================================================================
370	!! SUBROUTINE : slowproc_initialize
371	!!
372	!>\BRIEF Initialize slowproc module and call initialization of stomate module
373	!!
374	!! DESCRIPTION : Allocate module variables, read from restart file or initialize with default values
375	!! Call initialization of stomate module.
376	!!
377	!! MAIN OUTPUT VARIABLE(S) :
378	!!
379	!! REFERENCE(S) :
380	!!
381	!! FLOWCHART : None
382	!! \n
383	!_ ================================================================================================================================
384
385	SUBROUTINE slowproc_initialize (kjit, kjpij, kjpindex, &
386	rest_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
387	IndexLand, indexveg, lalo, neighbours, &
388	resolution, contfrac, temp_air, coszang_noon, &
389	soiltile, reinf_slope, deadleaf_cover, assim_param, &
390	ks, nvan, avan, mcr, &
391	mcs, mcfc, mcw, &
392	frac_age, height, lai, veget, &
393	frac_nobio, njsc, veget_max, fraclut, &
394	nwdfraclut, tot_bare_soil,totfrac_nobio, qsintmax, &
395	temp_growth, circ_class_biomass, &
396	circ_class_n, lai_per_level,laieff_fit, &
397	z_array_out, max_height_store, &
398	som_total, heat_Zimov, altmax, depth_organic_soil,&
399	loss_gain, veget_max_new, frac_nobio_new, height_dom, &
400	Pgap_cumul)
401
402
403	!! 0.1 Input variables
404	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
405	INTEGER(i_std), INTENT(in) :: kjpij !! Total size of the un-compressed grid
406	INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only
407	INTEGER(i_std),INTENT (in) :: rest_id !! Restart file identifier
408	INTEGER(i_std),INTENT (in) :: rest_id_stom !! STOMATE's _Restart_ file identifier
409	INTEGER(i_std),INTENT (in) :: hist_id_stom !! STOMATE's _history_ file identifier
410	INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier
411	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: IndexLand !! Indices of the points on the land map
412	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in) :: indexveg !! Indices of the points on the vegetation (3D map ???)
413	REAL(r_std),DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geogr. coordinates (latitude,longitude) (degrees)
414	INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours !! neighbouring grid points if land.
415	REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x an y of the grid (m)
416	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid (0-1, unitless)
417	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: temp_air !! Air temperature at first atmospheric model layer (K)
418	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: coszang_noon !! Solar zenith angle at noon
419
420	!! 0.2 Output variables
421	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_growth !! Growth temperature (ÃÂ°C) - Is equal to t2m_month
422	INTEGER(i_std), DIMENSION(kjpindex), INTENT(out) :: njsc !! Index of the dominant soil textural class in the grid
423	!! cell (1-nscm, unitless)
424	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out) :: height !! height of vegetation (m)
425	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out) :: height_dom !! dominant height of vegetation (m)
426	REAL(r_std),DIMENSION(kjpindex,nvm), INTENT(out) :: lai !! PFT leaf area index (m^{2} m^{-2})
427	REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(out):: frac_age !! Age efficacity from STOMATE for isoprene
428	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: veget !! Fraction of vegetation type in the mesh (unitless)
429	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (out) :: frac_nobio !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
430	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: veget_max !! Maximum fraction of vegetation type in the mesh (unitless)
431	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: tot_bare_soil !! Total evaporating bare soil fraction in the mesh (unitless)
432	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: totfrac_nobio !! Total fraction of ice+lakes+cities etc. in the mesh (unitless)
433	REAL(r_std),DIMENSION (kjpindex,nstm), INTENT(out) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
434	REAL(r_std),DIMENSION (kjpindex,nlut), INTENT(out) :: fraclut !! Fraction of each landuse tile (0-1, unitless)
435	REAL(r_std),DIMENSION (kjpindex,nlut), INTENT(out) :: nwdFraclut !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
436	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: reinf_slope !! slope coef for reinfiltration
437	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: ks !! Hydraulic conductivity at saturation (mm {-1})
438	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: nvan !! Van Genuchten coeficients n (unitless)
439	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: avan !! Van Genuchten coeficients a (mm-1})
440	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
441	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
442	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
443	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
444	REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (out):: assim_param !! min+max+opt temperatures & vmax for photosynthesis
445	!! (K, \mumol m^{-2} s^{-1})
446	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
447	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintmax !! Maximum water storage on vegetation from interception (mm)
448	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm),INTENT (out):: heat_Zimov !! heating associated with decomposition [W/m**3 soil]
449	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
450	!! Not related with the active soil carbon pool.
451	REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: depth_organic_soil !! Depth at which there is still organic matter (m)
452	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(out) :: circ_class_biomass !! Biomass components of the model tree
453	!! within a circumference class
454	!! class @tex $(g C ind^{-1})$ @endtex
455	REAL(r_std), DIMENSION(:,:,:), INTENT(out) :: circ_class_n !! Number of trees within each circumference
456	!! class @tex $(m^{-2})$ @endtex
457	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: loss_gain !! Changes in veget_max distributed over all
458	!! age classes and thus taking the age-classes into
459	!! account (unitless, 0-1)
460	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out) :: frac_nobio_new !! Fraction of ice,lakes,cities, ... (unitless)
461	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out) :: veget_max_new !! Maximum fraction of vegetation type including none
462
463	!! 0.3 Modified variables
464	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm,nelements), INTENT (inout) :: som_total !! total soil carbon for use in thermal (g/m**3)
465	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: lai_per_level !! This is the LAI per vertical level
466	!! @tex $(m^{2} m^{-2})$
467	TYPE(laieff_type),DIMENSION (:,:,:), INTENT(inout) :: laieff_fit !! Fitted parameters for the effective LAI
468	REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout) :: z_array_out !! An output of h_array, to use in sechiba
469	REAL(r_std),DIMENSION(:,:), INTENT(inout) :: max_height_store!! ???
470	REAL(r_std),DIMENSION(:,:,:), INTENT(inout) :: Pgap_cumul !! The probability of finding a gap in the in canopy from the top
471	!! of the canopy to a given level (unitless, between 0-1)
472
473
474	!! 0.4 Local variables
475	INTEGER(i_std) :: jsl, jv, ji
476	REAL(r_std),DIMENSION (kjpindex,nslm) :: land_frac !! To ouput the clay/sand/silt fractions with a vertical dim
477	REAL(r_std), DIMENSION(ncirc) :: circ_height !! temporary variable for vegetation height
478
479	!_ ================================================================================================================================
480
481	!! Initialize local printlev
482	printlev_loc=get_printlev('slowproc')
483
484
485	IF(printlev_loc>=5) WRITE(numout,*) 'Entering slowproc_initialize'
486
487	!! 1. Perform the allocation of all variables, define some files and some flags.
488	! Restart file read for Sechiba.
489	CALL slowproc_init (kjit, kjpindex, IndexLand, lalo, neighbours, resolution, &
490	contfrac, rest_id, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, &
491	fraclut, nwdfraclut, reinf_slope, &
492	ks, nvan, avan, mcr, mcs, mcfc, mcw, &
493	veget_max, tot_bare_soil, njsc, &
494	ninput_update, ninput_year, &
495	circ_class_biomass, circ_class_n, assim_param, loss_gain, veget_max_new, &
496	frac_nobio_new)
497
498	!! 2. Define time step in days for stomate
499	dt_days = dt_stomate / one_day
500
501	!! 3. check time step coherence between slow processes and fast processes
502	IF ( dt_stomate .LT. dt_sechiba ) THEN
503	WRITE(numout,*) 'slow_processes: time step smaller than forcing time step, dt_sechiba=',dt_sechiba,' dt_stomate=',dt_stomate
504	CALL ipslerr_p(3,'slowproc_initialize',&
505	'Coherence problem between dt_stomate and dt_sechiba',&
506	'Time step smaller than forcing time step','')
507	ENDIF
508
509	!! 4. Call stomate to initialize all variables managed in stomate.
510	IF ( ok_stomate ) THEN
511
512
513	IF(printlev>=5) WRITE(numout,*) 'Entering stomate_initialize in slowproc'
514
515	! Note that some of the variables are stored in both sechiba and
516	! stomate. The values of these variables should be identical in
517	! the stomate and sechiba restart. Anyway, the values found in
518	! sechiba will be overwritten by those found in stomate.
519	CALL stomate_initialize (kjit, kjpij, kjpindex, &
520	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
521	indexLand, lalo, neighbours, resolution, &
522	contfrac, clayfraction, siltfraction, &
523	bulk, temp_air, veget, veget_max, &
524	deadleaf_cover, assim_param, &
525	circ_class_biomass, circ_class_n, lai_per_level, laieff_fit, &
526	temp_growth, &
527	som_total, heat_Zimov, altmax, depth_organic_soil,&
528	cn_leaf_init_2D)
529
530	ELSE
531
532	! The model is not using stomate but it needs to calculate a
533	! vegetation structure anyway to calculate photosynthesis,
534	! albedo, and the energy budget
535	CALL stomate_laieff_initialize()
536
537	! Set a fixed value for altmax corresponding to the total soil depth for the hydrology
538	altmax(:,:) = zdr(nslm)
539
540	ENDIF
541
542	!! 5. Vegetation structure can be read from sechiba and stomate
543	! All key variable should be initialized, read from a restart or imposed
544	! by the time this part of the code is reached. These variables now have
545	! to be used to calculate some derived variables that are required by
546	! sechiba. For example, circ_class_biomass and circ_class_n are used to
547	! calculate lai_effit which is required to calculate the albedo but is not
548	! stored in the sechiba restart file. veget_max may come from a map which
549	! implies that there might be small imprecisions. This routine also calculates
550	! veget. Update veget, since the biomass has possibly been read in from a
551	! restart file, taken from a map or prescribed by an imposed value.
552	CALL slowproc_canopy (kjpindex, circ_class_biomass, circ_class_n, &
553	veget_max, lai_per_level, z_array_out, &
554	max_height_store, laieff_fit, frac_age)
555
556	CALL slowproc_veget (kjpindex, lai_per_level, z_array_out, &
557	coszang_noon, circ_class_biomass, circ_class_n, frac_nobio, totfrac_nobio, &
558	veget_max, veget, soiltile, tot_bare_soil, fraclut, nwdFraclut, Pgap_cumul)
559
560	!! 6. Calculate height and lai from biomass
561	height(:,ibare_sechiba) = zero
562	height_dom(:,ibare_sechiba) = zero
563	lai(:,ibare_sechiba) = zero
564	DO jv = 2,nvm
565	DO ji = 1,kjpindex
566	! Skip if veget_max = 0, else calculate height and lai
567	IF (veget_max(ji,jv) .EQ. zero) THEN
568	height(ji,jv) = 0
569	height_dom(ji,jv) = 0
570	lai(ji,jv) = 0
571	ELSE
572	height(ji,jv) = wood_to_qmheight(circ_class_biomass(ji,jv,:,:,icarbon), &
573	circ_class_n(ji,jv,:), jv)
574	IF(is_tree(jv))THEN
575	circ_height(:) = wood_to_height(circ_class_biomass(ji,jv,:,:,icarbon),jv)
576	height_dom(ji,jv)=circ_height(ncirc)
577	ELSE
578	height_dom(ji,jv)=height(ji,jv)
579	ENDIF
580	lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon), &
581	circ_class_n(ji,jv,:),jv)
582	ENDIF
583	ENDDO
584	ENDDO
585	!-
586
587	!! 3. Initialize the maximum water on vegetation for interception
588	qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
589	qsintmax(:,1) = zero
590
591	!! 5. Specific run without the carbon cycle (STOMATE not called):
592	!! Need to initialize some variables that will be used in SECHIBA
593	IF (.NOT. ok_stomate ) THEN
594
595	! Initialize some missing variables
596	deadleaf_cover(:) = zero
597	temp_growth(:)=25.
598
599	ENDIF
600
601
602	!! 6. Output with XIOS for variables done only once per run
603	DO jsl=1,nslm
604	land_frac(:,jsl) = clayfraction(:)
605	ENDDO
606	! mean fraction of clay in grid-cell
607	CALL xios_orchidee_send_field("clayfraction",land_frac)
608	DO jsl=1,nslm
609	land_frac(:,jsl) = sandfraction(:)
610	ENDDO
611	! mean fraction of sand in grid-cell
612	CALL xios_orchidee_send_field("sandfraction",land_frac)
613	DO jsl=1,nslm
614	land_frac(:,jsl) = siltfraction(:)
615	ENDDO
616	! mean fraction of silt in grid-cell
617	CALL xios_orchidee_send_field("siltfraction",land_frac)
618
619	IF(printlev>=5) WRITE(numout,*) 'Leaving slowproc_initialize'
620
621	END SUBROUTINE slowproc_initialize
622
623
624	!! ================================================================================================================================
625	!! SUBROUTINE : slowproc_main
626	!!
627	!>\BRIEF Main routine that manage variable initialisation (slowproc_init),
628	!! prepare the restart file with the slowproc variables, update the time variables
629	!! for slow processes, and possibly update the vegetation cover, before calling
630	!! STOMATE in the case of the carbon cycle activated or just update the canopy (and possibly
631	!! the vegetation cover) for simulation with only SECHIBA
632	!!
633	!!
634	!! DESCRIPTION : (definitions, functional, design, flags): The subroutine manages
635	!! diverses tasks:
636	!! (1) Initializing all variables of slowproc (first call)
637	!! (2) Preparation of the restart file for the next simulation with all prognostic variables
638	!! (3) Compute and update time variable for slow processes
639	!! (4) Update the vegetation cover if there is some land use change (only every years)
640	!! (5) Call STOMATE for the runs with the carbone cycle activated (ok_stomate) and compute the respiration
641	!! and the net primary production
642	!! (6) Compute the LAI and possibly update the vegetation cover for run without STOMATE
643	!!
644	!! RECENT CHANGE(S): None
645	!!
646	!! MAIN OUTPUT VARIABLE(S): ::co2_flux, ::fco2_lu,::fco2_wh, ::fco2_ha, ::lai, ::height, ::veget, ::frac_nobio,
647	!! ::veget_max, ::woodharvest, ::totfrac_nobio, ::soiltype, ::assim_param, ::deadleaf_cover, ::qsintmax,
648	!! and resp_maint, resp_hetero, resp_growth, npp that are calculated and stored
649	!! in stomate is activated.
650	!!
651	!! REFERENCE(S) : None
652	!!
653	!! FLOWCHART :
654	! \latexonly
655	! \includegraphics(scale=0.5){SlowprocMainFlow.eps} !PP to be finalize!!)
656	! \endlatexonly
657	!! \n
658	!_ ================================================================================================================================
659
660	SUBROUTINE slowproc_main (kjit, kjpij, kjpindex, njsc, &
661	IndexLand, indexveg, lalo, neighbours, resolution, contfrac, soiltile, fraclut, nwdFraclut, &
662	temp_air, temp_sol, stempdiag, &
663	vegstress, humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, pb, gpp, &
664	tmc_pft, drainage_pft, runoff_pft, swc_pft, deadleaf_cover, &
665	assim_param, qsintveg, &
666	frac_age, height, lai, veget, frac_nobio, veget_max, totfrac_nobio, qsintmax, &
667	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
668	co2_flux, fco2_lu, fco2_wh, fco2_ha, temp_growth, tot_bare_soil, &
669	tdeep, hsdeep_long, snow, heat_Zimov, &
670	sfluxCH4_deep, sfluxCO2_deep, &
671	som_total,snowdz,snowrho, altmax, depth_organic_soil, &
672	circ_class_biomass, circ_class_n, &
673	lai_per_level, max_height_store, laieff_fit, laieff_isotrop, &
674	z_array_out, transpir, transpir_mod, &
675	transpir_supply, vir_transpir_supply, coszang, coszang_noon, &
676	stressed, unstressed, Light_Tran_Tot, &
677	u, v, loss_gain, veget_max_new, frac_nobio_new, failed_vegfrac, &
678	mcs_hydrol, mcfc_hydrol, &
679	vessel_loss, height_dom, root_profile, root_depth, us, &
680	Pgap_cumul)
681
682
683	!! INTERFACE DESCRIPTION
684
685	!! 0.1 Input variables
686
687	INTEGER(i_std), INTENT(in) :: kjit !! Time step number
688	INTEGER(i_std), INTENT(in) :: kjpij !! Total size of the un-compressed grid
689	INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only
690	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
691	INTEGER(i_std),INTENT (in) :: rest_id,hist_id !! _Restart_ file and _history_ file identifier
692	INTEGER(i_std),INTENT (in) :: hist2_id !! _history_ file 2 identifier
693	INTEGER(i_std),INTENT (in) :: rest_id_stom !! STOMATE's _Restart_ file identifier
694	INTEGER(i_std),INTENT (in) :: hist_id_stom !! STOMATE's _history_ file identifier
695	INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC !! STOMATE's IPCC _history_ file identifier
696	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: IndexLand !! Indices of the points on the land map
697	INTEGER(i_std),DIMENSION (kjpindex*nvm), INTENT (in):: indexveg !! Indices of the points on the vegetation (3D map ???)
698	REAL(r_std),DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geogr. coordinates (latitude,longitude) (degrees)
699	INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in) :: neighbours !! neighbouring grid points if land
700	REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x an y of the grid (m)
701	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid (0-1, unitless)
702	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: temp_air !! Temperature of first model layer (K)
703	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: temp_sol !! Surface temperature (K)
704	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: stempdiag !! Soil temperature (K)
705	REAL(r_std),DIMENSION (kjpindex,nslm), INTENT (in) :: shumdiag !! Relative soil moisture (0-1, unitless)
706	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: litterhumdiag !! Litter humidity (0-1, unitless)
707	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_rain !! Rain precipitation (mm dt_stomate^{-1})
708	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: precip_snow !! Snow precipitation (mm dt_stomate^{-1})
709	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: pb !! Lowest level pressure (Pa)
710	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: gpp !! GPP of total ground area (gC m^{-2} time step^{-1}).
711	!! Calculated in sechiba, account for vegetation cover and
712	!! effective time step to obtain gpp_d
713	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: tmc_pft !! Total soil water per PFT (mm/m2)
714	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: drainage_pft !! Drainage per PFT (mm/m2)
715	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: runoff_pft !! Drainage per PFT (mm/m2)
716	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(in) :: swc_pft !! Relative Soil water content [tmcr:tmcs] per pft (-)
717	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: transpir !! transpiration @tex $(kg m^{-2} days^{-1})$ @endtex
718	REAL(r_std), DIMENSION(kjpindex,nvm) :: transpir_mod !! transpir converted from mm/day to mm dt^(-1)
719	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT (in) :: transpir_supply !! Supply of water for transpiration @tex $(mm dt^{-1})$ @endtex
720	REAL(r_std), DIMENSION(kjpindex,nvm),INTENT (in) :: vir_transpir_supply !! Virtual supply of water for transpiration to deal
721	!! with water stress when PFT1 becomes vegetated in LCC
722	!! @tex $(mm dt^{-1})$ @endtex
723
724	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: u !! Lowest level wind speed in direction u (m/s)
725	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: v !! Lowest level wind speed in direction v (m/s)
726
727
728	REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: coszang !! the cosine of the solar zenith angle (unitless)
729	REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: coszang_noon !! the cosine of the solar zenith angle (unitless)
730	REAL(r_std),DIMENSION(:,:,:),INTENT(in) :: Light_Tran_Tot !! Transmitted radiation per level (unitless)
731
732	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm), INTENT (in) :: tdeep !! deep temperature profile (K)
733	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm), INTENT (in) :: hsdeep_long!! deep long term soil humidity profile
734	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: snow !! Snow mass [Kg/m^2]
735	REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(in) :: snowdz !! snow depth for each layer [m]
736	REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(in) :: snowrho !! snow density for each layer (Kg/m^3)
737	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: mcs_hydrol !! Saturated volumetric water content output to be used in stomate_soilcarbon
738	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: mcfc_hydrol!! Volumetric water content at field capacity output to be used in stomate_soilcarbon
739	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: vessel_loss!! Proportion of conductivity lost due to cavitation in the xylem (no unit).
740	REAL(r_std), DIMENSION(:,:,:,:), INTENT(in) :: root_profile!! Normalized root mass/length fraction in each soil layer
741	!! (0-1, unitless)
742	REAL(r_std), DIMENSION(:,:,:), INTENT(in) :: root_depth !! Node and interface numbers at which the deepest roots
743	!! occur (1 to nslm, unitless)
744	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: Pgap_cumul !! The probability of finding a gap in the in canopy from the top
745	!! of the canopy to a given level (unitless, between 0-1)
746
747	!! 0.2 Output variables
748
749	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: co2_flux !! CO2 flux per average ground area (gC m^{-2} dt_stomate^{-1})
750	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: fco2_lu !! CO2 flux from land-use (without forest management) (gC m^{-2} dt_stomate^{-1})
751	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: fco2_wh !! CO2 Flux to Atmosphere from Wood Harvesting (gC m^{-2} dt_stomate^{-1})
752	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: fco2_ha !! CO2 Flux to Atmosphere from Crop Harvesting (gC m^{-2} dt_stomate^{-1})
753	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_growth !! Growth temperature (ÃÂ°C) - Is equal to t2m_month
754	REAL(r_std), DIMENSION (kjpindex), INTENT(out) :: tot_bare_soil !! Total evaporating bare soil fraction in the mesh
755	REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(out) :: max_height_store !! ???
756
757	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm),INTENT (out) :: heat_Zimov !! heating associated with decomposition [W/m**3 soil]
758	REAL(r_std), DIMENSION(kjpindex), INTENT (out) :: sfluxCH4_deep !! surface flux of CH4 to atmosphere from permafrost
759	REAL(r_std), DIMENSION(kjpindex), INTENT (out) :: sfluxCO2_deep !! surface flux of CO2 to atmosphere from permafrost
760	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: height !! height of vegetation (m)
761	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: height_dom !! dominant height of vegetation (m)
762	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: lai !! Leaf area index (m^2 m^{-2})
763
764
765	!! 0.3 Modified variables
766
767	REAL(r_std),DIMENSION (kjpindex,nvm,nleafages), INTENT(inout):: frac_age !! Age efficacity from STOMATE for isoprene
768	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: veget !! Fraction of vegetation type including none biological fractionin the mesh (unitless)
769	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT (inout) :: frac_nobio !! Fraction of ice, lakes, cities etc. in the mesh
770	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: veget_max !! Maximum fraction of vegetation type in the mesh (unitless)
771	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: totfrac_nobio !! Total fraction of ice+lakes+cities etc. in the mesh
772	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(inout) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
773	REAL(r_std),DIMENSION (kjpindex,nvm,npco2),INTENT (inout):: assim_param !! vcmax, nue and leaf N for photosynthesis
774	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(inout) :: qsintveg !! Water on vegetation due to interception @tex $(kg m^{-2})$ @endtex
775	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(inout) :: fraclut !! Fraction of each landuse tile (0-1, unitless)
776	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(inout) :: nwdFraclut !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
777	REAL(r_std),DIMENSION (kjpindex), INTENT (inout) :: deadleaf_cover !! Fraction of soil covered by dead leaves (unitless)
778	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: qsintmax !! Maximum water storage on vegetation from interception (mm)
779	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm,nelements), INTENT (inout) :: som_total !! Total soil carbon for use in thermal (g/m**3)
780	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
781	!! Not related with the active soil carbon pool.
782	REAL(r_std), DIMENSION(kjpindex), INTENT (inout) :: depth_organic_soil !! how deep is the organic soil?
783
784	REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nparts,nelements), &
785	INTENT(inout) :: circ_class_biomass !! Biomass components of the model tree
786	!! within a circumference class
787	!! class @tex $(g C ind^{-1})$ @endtex
788	REAL(r_std),DIMENSION(kjpindex,nvm,ncirc), INTENT(inout) :: circ_class_n !! Number of trees within each circumference
789	!! class @tex $(m^{-2})$ @endtex
790	REAL(r_std),DIMENSION(kjpindex,nvm), INTENT(inout) :: loss_gain !! Changes in veget_max distributed over all
791	!! age classes and thus taking the age-classes into
792	!! account (unitless, 0-1)
793	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(inout) :: frac_nobio_new !! Fraction of ice,lakes,cities, ... (unitless)
794	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(inout) :: veget_max_new !! Maximum fraction of vegetation type including none
795	REAL(r_std),DIMENSION(:,:,:), INTENT(inout) :: lai_per_level !! This is the LAI per vertical level
796	!! @tex $(m^{2} m^{-2})$
797	TYPE(laieff_type),DIMENSION (:,:,:), INTENT(inout) :: laieff_fit!! Fitted parameters for the effective LAI
798	REAL(r_std), DIMENSION(:,:,:), INTENT(inout) :: laieff_isotrop!! Effective LAI
799	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout) :: stressed !! adjusted ecosystem functioning. Takes the unit of the variable
800	!! used as a proxy for waterstress (assigned in sechiba)
801	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout) :: unstressed!! initial ecosystem functioning after the first calculation and
802	!! before any recalculations. Takes the unit of the variable used
803	!! as a proxy for unstressed.
804
805	REAL(r_std),DIMENSION(:,:,:,:), INTENT(inout) :: z_array_out !! An output of h_array, to use in sechiba
806	LOGICAL, DIMENSION(kjpindex,nvm), INTENT(inout) :: failed_vegfrac !! Failed to find a PFT were some residual fraction could be added (true/false)
807	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (inout) :: vegstress !! Relative soil moisture used in stomate to calculate plant water stress (0-1, unitless)
808	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (inout) :: humrel !! Relative humidity - not used in stomate (needed in age_class_distr)
809	REAL(r_std),DIMENSION (kjpindex,nvm,nstm,nslm), INTENT(inout) :: us !! Water stress index for transpiration
810	!! (by soil layer and PFT) (0-1, unitless)
811
812
813	!! 0.4 Local variables
814	INTEGER(i_std) :: j, jv, ji,jj !! indices (unitless)
815	INTEGER(i_std) :: ipts,ivm,jvm !! indices (unitless)
816	INTEGER(i_std) :: igroup !! Indices (unitless)
817	REAL(r_std), DIMENSION(kjpindex,nvm) :: resp_maint !! Maitanance component of autotrophic respiration in (gC m^{-2} dt_stomate^{-1})
818	REAL(r_std), DIMENSION(kjpindex,nvm) :: resp_hetero !! heterotrophic resp. (gC/(m**2 of total ground)/time step)
819	REAL(r_std), DIMENSION(kjpindex,nvm) :: resp_growth !! Growth component of autotrophic respiration in gC m^{-2} dt_stomate^{-1})
820	REAL(r_std), DIMENSION(kjpindex,nvm) :: npp !! Net Ecosystem Exchange (gC/(m**2 of total ground)/time step)
821	REAL(r_std),DIMENSION (kjpindex) :: totfrac_nobio_new !! Total fraction for the next year
822	REAL(r_std),DIMENSION (kjpindex) :: histvar !! Temporary variable for output
823	REAL(r_std), DIMENSION(kjpindex,nvm,12) :: N_input_temp
824	CHARACTER(LEN=80) :: fieldname !! name of the field read in the N input map
825	REAL(r_std), DIMENSION(kjpindex,nvm) :: veget_max_temp
826	REAL(r_std), DIMENSION(kjpindex,nvm) :: veget_ny_map
827	INTEGER(i_std) :: nfound !! The number of PFTs for this pixel which have veget_max
828	LOGICAL(r_std),DIMENSION (nvm) :: lfound_veget !! Do we have a given threshold of veget_max on for this pixel?
829	REAL(r_std) :: excess_veg !! The veget_max which we have to redistribute t0 other pixels.
830	REAL(r_std) :: nobio_frac_sum_old !! Total vegetated land for the current year.
831	REAL(r_std) :: nobio_frac_sum_new !! Total vegetated land for next year.
832	REAL(r_std) :: nobio_diff !! How much the nonvegetative land coverage changes between the current and next year.i
833	REAL(r_std) :: nobio_scale !! This scaling factor is trying to redistribute the nobio_diff to new one
834	CHARACTER(30) :: losses !! Loss distribution across age classes
835	REAL(r_std), DIMENSION(ncirc) :: circ_height !! temporary variable for vegetation height
836
837	!_ ================================================================================================================================
838
839	!! 1. Compute and update all variables linked to the date and time
840	IF (printlev_loc>=4) WRITE(numout,*) 'Entering slowproc_main, year_start, month_start, day_start, sec_start=',&
841	year_start, month_start,day_start,sec_start
842
843	!! 2. Activate slow processes if it is the end of the day
844	IF ( LastTsDay ) THEN
845
846	! 3.2.2 Activate slow processes in the end of the day
847	do_slow = .TRUE.
848
849	! 3.2.3 Count the number of days
850	days_since_beg = days_since_beg + 1
851	IF (printlev_loc>=4) WRITE(numout,*) "New days_since_beg : ",days_since_beg
852
853	ELSE
854
855	do_slow = .FALSE.
856
857	ENDIF
858
859	!! 3. Update the vegetation if it is time to do so.
860	! This is done at the first sechiba time step on a new year if
861	! veget_update > 0. veget_update can only be 0 or 1.
862	! Nothing is done if veget_update=0.
863	! Update will never be done if impveg=true because veget_update=0.
864	IF ( FirstTsYear ) THEN
865
866	IF (veget_update > 0) THEN
867
868	IF (printlev_loc>=1) WRITE(numout,*) 'We are updating the vegetation map'
869
870	veget_max_new(:,:) = zero
871	frac_nobio_new(:,:) = zero
872	loss_gain(:,:) = zero
873	failed_vegfrac(:,:) = .FALSE.
874
875	IF (hack_veget_max_new) THEN
876	! Read veget_max_new from run.def. This is intended to be used in
877	! combination with a restart file. It only works once per simulation.
878	! It can be used to debug simplified LCC test cases. Tested use:
879	! (1) run the model for 1 year with LCC = true and making use of the
880	! pft-map. For this run hack_lcc = FALSE. (2) restart the model with
881	! hack_lcc = TRUE and specify the frac_nobio_new and veget_max_new
882	! in the run.def. The model will apply the prescribed LCC the first
883	! day of year 2. Note that it will read veget_max_new from the run.def
884	! in all subsequent years as well. Hence there will be no land cover
885	! changes except in the year 2.
886	CALL getin_p('FRAC_NOBIO_NEW',frac_nobio_new)
887	CALL getin_p('VEGET_MAX_NEW', veget_max_new)
888	WRITE(numout,*) 'WARNING: Hacked land cover change'
889	WRITE(numout,*) 'frac_nobio_new, ', frac_nobio_new
890	DO jv=1,nvm
891	WRITE(numout,*) 'PFT, veget_max_new, ', jv, veget_max_new(test_grid,jv)
892	END DO
893	ELSE
894	! Read the new the vegetation from file. Output is veget_max_new and
895	! frac_nobio_new
896	CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
897	veget_max, veget_max_new, frac_nobio_new, .FALSE.)
898	ENDIF
899
900	! Check the map that was just read for errors. After this check the
901	! fraction (inc. frac_nobio) should add up to one. frac_nobio_new
902	! is kept as "read" from the map.
903	CALL check_read_vegetmax(kjpindex, veget_max_new, frac_nobio_new)
904
905	! Compare the new vegetation map with the current map and resolve
906	! possible conflicts to make sure all will go smooth in land cover change.
907	losses = 'proportional'
908	CALL adjust_delta_veget_max(kjpindex, veget_max, frac_nobio, &
909	veget_max_new, frac_nobio_new, loss_gain, losses, failed_vegfrac)
910
911	! Verification and correction of veget_max_new, calculation
912	! of veget and soiltile. totfrac_nobio, veget, soiltile and
913	! tot_bare_soil are output variables.
914	CALL slowproc_veget (kjpindex, lai_per_level, z_array_out, &
915	coszang_noon,circ_class_biomass, circ_class_n, frac_nobio_new, totfrac_nobio_new, &
916	veget_max_new, veget, soiltile, tot_bare_soil, &
917	fraclut, nwdFraclut, Pgap_cumul)
918
919	! Set the flag do_now_stomate_lcchange to activate stomate_lcchange.
920	! This flag will be kept to true until stomate_lcchange has been done.
921	! The variable totfrac_nobio_new will only be used in stomate when this
922	! flag is activated
923	do_now_stomate_lcchange=.TRUE.
924	IF ( .NOT. ok_stomate ) THEN
925	! Special case if stomate is not activated : set the variable
926	! done_stomate_lcchange=true so that the subroutine slowproc_change_frac
927	! will be called in the end of sechiba_main.
928	done_stomate_lcchange=.TRUE.
929	END IF
930
931	ENDIF ! Veget_update>0
932
933	! Set a flag to calculate the wood product pool even if there land cover
934	! change is not (or no longer) used. This flag should be true every first
935	! day of the year.
936	do_now_stomate_product_use=.TRUE.
937
938	END IF ! FirstTsYear
939
940	!! Read the Nitrogen inputs
941	IF(ok_ncycle .AND. (.NOT. impose_CN)) THEN
942
943	IF ( (Ninput_update > 0) .AND. FirstTsYear ) THEN
944	! Update of the vegetation cover with Land Use only if
945	! the current year match the requested condition (a multiple of "veget_update")
946	Ninput_year = Ninput_year + 1
947	IF ( MOD(Ninput_year - Ninput_year_orig, Ninput_update) == 0 ) THEN
948	IF (printlev_loc>=1) WRITE(numout,*) 'We are updating the Ninputs map for year =' , Ninput_year
949
950	IF(.NOT. impose_ninput_dep) THEN
951	! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
952	fieldname='Nammonium'
953	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
954	N_input(:,:,:,iammonium), Ninput_year)
955	fieldname='Nnitrate'
956	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
957	N_input(:,:,:,initrate), Ninput_year)
958	! Conversion from mgN/m2/yr to gN/m2/day
959	N_input(:,:,:,iammonium)=N_input(:,:,:,iammonium)/1000./one_year
960	N_input(:,:,:,initrate)=N_input(:,:,:,initrate)/1000./one_year
961	ENDIF
962
963	IF(.NOT. impose_ninput_fert) THEN
964	fieldname='Nfert'
965	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
966	N_input_temp, Ninput_year)
967	! Conversion from gN/m2(cropland)/yr to gN/m2/day
968	N_input(:,:,:,ifert) = N_input_temp(:,:,:)/one_year
969
970	fieldname='Nfert_cropland'
971	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
972	N_input_temp, Ninput_year)
973	! Conversion from gN/m2(cropland)/yr to gN/m2/day
974	N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/one_year
975
976	fieldname='Nfert_pasture'
977	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
978	N_input_temp, Ninput_year)
979	! Conversion from gN/m2(pasture)/yr to gN/m2/day
980	N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/one_year
981
982	ENDIF
983
984	IF(.NOT. impose_ninput_manure) THEN
985	N_input(:,:,:,imanure) = zero
986	fieldname='Nmanure_cropland'
987	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
988	N_input_temp, Ninput_year)
989	! Conversion from gN/m2(cropland)/yr to gN/m2/day
990	N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/one_year
991
992	fieldname='Nmanure_pasture'
993	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
994	N_input_temp, Ninput_year)
995	! Conversion from gN/m2(cropland)/yr to gN/m2/day
996	N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/one_year
997	ENDIF
998
999	IF(.NOT. impose_ninput_bnf) THEN
1000	fieldname='Nbnf'
1001	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
1002	N_input(:,:,:,ibnf), Ninput_year)
1003	! Conversion from mgN/m2/year to gN/m2/day
1004	N_input(:,:,:,ibnf) = N_input(:,:,:,ibnf)/1000./one_year
1005	ENDIF
1006
1007	ENDIF
1008
1009	ENDIF
1010	ENDIF
1011
1012
1013	!! 4. Main call to STOMATE
1014	IF ( ok_stomate ) THEN
1015
1016	!! 4.1 Call stomate main routine that will call all c-cycle routines !
1017	CALL stomate_main (kjit, kjpij, kjpindex, njsc,&
1018	IndexLand, lalo, neighbours, resolution, contfrac, frac_nobio, clayfraction, &
1019	siltfraction, bulk, temp_air, temp_sol, stempdiag, &
1020	vegstress, humrel, shumdiag, litterhumdiag, precip_rain, precip_snow, &
1021	tmc_pft, drainage_pft, runoff_pft, swc_pft, gpp, &
1022	deadleaf_cover, &
1023	assim_param, qsintveg, &
1024	frac_age, veget, veget_max, &
1025	veget_max_new, loss_gain, frac_nobio_new, fraclut, &
1026	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
1027	co2_flux, fco2_lu, fco2_wh, fco2_ha, &
1028	resp_maint,resp_hetero,resp_growth,temp_growth, soil_pH, &
1029	pb, n_input, month_end, &
1030	tdeep, hsdeep_long, snow, heat_Zimov, sfluxCH4_deep, sfluxCO2_deep, &
1031	som_total, snowdz, snowrho, altmax, depth_organic_soil, &
1032	cn_leaf_min_2D,cn_leaf_max_2D,cn_leaf_init_2D, &
1033	circ_class_biomass, &
1034	circ_class_n, lai_per_level, &
1035	laieff_fit, laieff_isotrop, z_array_out, max_height_store, &
1036	transpir, transpir_mod, transpir_supply, vir_transpir_supply, &
1037	coszang, stressed, unstressed, &
1038	u, v, mcs_hydrol, mcfc_hydrol, vessel_loss, &
1039	root_profile, root_depth, us, Pgap_cumul)
1040
1041	!+++CHECK+++
1042	! Why is this written here? As a rule of thumb output should be written
1043	! where it is calculated. The same variables have just been written in
1044	! stomate_lpj. The calculation of npp is wrong because it does not account
1045	! for atm_to_bm. Correct or even better delete this block.
1046
1047	!! 4.2 Output the respiration terms and the net primary
1048	!! production (NPP) that are calculated in STOMATE
1049
1050	! 4.2.1 Output the three respiration terms
1051	! These variables could be output from stomate.
1052	! Variables per pft. Note that growth and maintanance respiration
1053	! are calculated only once per day but hetero_resp is calculated
1054	! every half hour. Because we use hetero_resp which is daily and
1055	! has passed through stomate_lpj the output has also become daily
1056	! and is therefore written in the do_slow loop.
1057	CALL xios_orchidee_send_field("maint_resp",resp_maint/dt_sechiba)
1058	CALL xios_orchidee_send_field("hetero_resp",resp_hetero/dt_sechiba)
1059	CALL xios_orchidee_send_field("growth_resp",resp_growth/dt_sechiba)
1060
1061	! Variables on grid-cell
1062	CALL xios_orchidee_send_field("rh_ipcc2",SUM(resp_hetero,dim=2)/dt_sechiba)
1063	histvar(:)=zero
1064	DO jv = 2, nvm
1065	IF ( .NOT. is_tree(jv) .AND. natural(jv) ) THEN
1066	histvar(:) = histvar(:) + resp_hetero(:,jv)
1067	ENDIF
1068	ENDDO
1069	CALL xios_orchidee_send_field("rhGrass",histvar/dt_sechiba)
1070
1071	histvar(:)=zero
1072	DO jv = 2, nvm
1073	IF ( (.NOT. is_tree(jv)) .AND. (.NOT. natural(jv)) ) THEN
1074	histvar(:) = histvar(:) + resp_hetero(:,jv)
1075	ENDIF
1076	ENDDO
1077	CALL xios_orchidee_send_field("rhCrop",histvar/dt_sechiba)
1078
1079	histvar(:)=zero
1080	DO jv = 2, nvm
1081	IF ( is_tree(jv) ) THEN
1082	histvar(:) = histvar(:) + resp_hetero(:,jv)
1083	ENDIF
1084	ENDDO
1085	CALL xios_orchidee_send_field("rhTree",histvar/dt_sechiba)
1086
1087	! 4.2.2 Compute the net primary production as the diff from
1088	! Gross primary productin and the growth and maintenance respirations
1089	npp(:,1)=zero
1090	DO j = 2,nvm
1091	npp(:,j) = gpp(:,j) - resp_growth(:,j) - resp_maint(:,j)
1092	ENDDO
1093
1094
1095	! 4.2.2 Output npp & respiration terms
1096	CALL xios_orchidee_send_field("npp",npp/dt_sechiba)
1097
1098	! Output with IOIPSL
1099	CALL histwrite_p(hist_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
1100	CALL histwrite_p(hist_id, 'maint_resp', kjit, resp_maint, &
1101	kjpindex*nvm, indexveg)
1102	CALL histwrite_p(hist_id, 'hetero_resp', kjit, resp_hetero, &
1103	kjpindex*nvm, indexveg)
1104	CALL histwrite_p(hist_id, 'growth_resp', kjit, resp_growth, &
1105	kjpindex*nvm, indexveg)
1106
1107	! Write the same information to a different history file file
1108	IF ( hist2_id > 0 ) THEN
1109	CALL histwrite_p(hist2_id, 'maint_resp', kjit, resp_maint, &
1110	kjpindex*nvm, indexveg)
1111	CALL histwrite_p(hist2_id, 'hetero_resp', kjit, resp_hetero, &
1112	kjpindex*nvm, indexveg)
1113	CALL histwrite_p(hist2_id, 'growth_resp', kjit, resp_growth, &
1114	kjpindex*nvm, indexveg)
1115	CALL histwrite_p(hist2_id, 'npp', kjit, npp, kjpindex*nvm, indexveg)
1116	ENDIF
1117
1118	ELSE
1119
1120	! ok_stomate is not activated
1121	! Define the CO2 flux from the grid point to zero (no carbone cycle)
1122	co2_flux(:,:) = zero
1123	fco2_lu(:) = zero
1124	fco2_wh(:) = zero
1125	fco2_ha(:) = zero
1126
1127	ENDIF ! ok_stomate
1128	!+++++++++++++
1129
1130
1131	!! Calculate height and lai from biomass
1132	height(:,ibare_sechiba) = zero
1133	height_dom(:,ibare_sechiba) = zero
1134	lai(:,ibare_sechiba) = zero
1135	DO jv = 2,nvm
1136	DO ji = 1,kjpindex
1137	IF (veget_max(ji,jv) .EQ. zero) THEN
1138	height(ji,jv) = zero
1139	height_dom(ji,jv) = zero
1140	lai(ji,jv) = zero
1141	ELSE
1142	height(ji,jv) = wood_to_qmheight(circ_class_biomass(ji,jv,:,:,icarbon), &
1143	circ_class_n(ji,jv,:), jv)
1144	IF(is_tree(jv))THEN
1145	circ_height(:) = wood_to_height(circ_class_biomass(ji,jv,:,:,icarbon),jv)
1146	height_dom(ji,jv)=circ_height(ncirc)
1147	ELSE
1148	height_dom(ji,jv)=height(ji,jv)
1149	ENDIF
1150	lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon), &
1151	circ_class_n(ji,jv,:),jv)
1152	ENDIF
1153	ENDDO
1154	ENDDO
1155
1156	!! 5. Do daily processes if necessary
1157	IF ( do_slow ) THEN
1158
1159	!! 5.1 Calculate canopy structure when STOMATE is not activated
1160	IF ( .NOT. ok_stomate ) THEN
1161
1162	! Slowproc_canopy calculates the canopy structure including
1163	! laieff_fit. It should therefore only be calculated once
1164	! per day
1165	CALL slowproc_canopy (kjpindex, circ_class_biomass, circ_class_n, &
1166	veget_max, lai_per_level, z_array_out, &
1167	max_height_store, laieff_fit, frac_age)
1168
1169	ENDIF
1170
1171	CALL slowproc_veget (kjpindex, lai_per_level, z_array_out, &
1172	coszang_noon, circ_class_biomass, circ_class_n, frac_nobio, &
1173	totfrac_nobio, veget_max, veget, soiltile, tot_bare_soil, &
1174	fraclut, nwdFraclut, Pgap_cumul)
1175
1176	!! 5.3 updates qsintmax and other derived variables
1177	IF ( .NOT. ok_stomate ) THEN
1178
1179	! Initialize missing variables
1180	deadleaf_cover(:) = zero
1181	temp_growth(:) = 25.
1182
1183	ENDIF
1184	qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
1185	qsintmax(:,1) = zero
1186
1187	! Do some basic tests on the surface fractions updated above, only if
1188	! slowproc_veget has been done (do_slow). No change of the variables.
1189	CALL check_veget(kjpindex, frac_nobio, veget_max, veget, &
1190	tot_bare_soil, soiltile, failed_vegfrac)
1191
1192	END IF
1193
1194	!! 8. Write output fields
1195	CALL xios_orchidee_send_field("tot_bare_soil",tot_bare_soil)
1196	CALL xios_orchidee_send_field("HEIGHT_DOM",height_dom)
1197
1198	IF ( .NOT. almaoutput) THEN
1199	CALL histwrite_p(hist_id, 'tot_bare_soil', kjit, tot_bare_soil, &
1200	kjpindex, IndexLand)
1201	END IF
1202
1203	! Error checking
1204	IF(err_act.GT.1)THEN
1205
1206	! All initial checks should be done in slowproc right after the map
1207	! is being read. If vegetation fractions or frac_nobio is adjusted
1208	! afterwards, mass balance problems are unavoidable. Check whether
1209	! veget_max and frac_nobio are still consistent.
1210	CALL check_pixel_area("End of slowproc_main", kjpindex, veget_max, frac_nobio)
1211
1212	END IF ! err_act.GT.1
1213
1214	IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_main done '
1215
1216	END SUBROUTINE slowproc_main
1217
1218
1219	!! ================================================================================================================================
1220	!! SUBROUTINE : slowproc_finalize
1221	!!
1222	!>\BRIEF Write to restart file variables for slowproc module and call finalization of stomate module
1223	!!
1224	!! DESCRIPTION :
1225	!!
1226	!! RECENT CHANGE(S): Add arrays of soil hydraulic parameters to the restart file.
1227	!! Linked to SP-MIP project (Tafasca Salma and Ducharne Agnes).
1228	!!
1229	!! MAIN OUTPUT VARIABLE(S) :
1230	!!
1231	!! REFERENCE(S) :
1232	!!
1233	!! FLOWCHART : None
1234	!! \n
1235	!_ ================================================================================================================================
1236
1237	SUBROUTINE slowproc_finalize (kjit, kjpindex, rest_id, IndexLand, &
1238	njsc, veget, &
1239	frac_nobio, veget_max, reinf_slope, &
1240	ks, nvan, avan, mcr, mcs, mcfc, mcw, &
1241	assim_param, frac_age, heat_Zimov, altmax, depth_organic_soil, &
1242	circ_class_biomass, circ_class_n, &
1243	lai_per_level, laieff_fit, loss_gain, &
1244	veget_max_new, frac_nobio_new)
1245
1246
1247	!! 0.1 Input variables
1248	INTEGER(i_std),INTENT(in) :: kjit !! Time step number
1249	INTEGER(i_std),INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only
1250	INTEGER(i_std),INTENT(in) :: rest_id !! Restart file identifier
1251	INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: IndexLand !! Indices of the points on the land map
1252	INTEGER(i_std),DIMENSION(kjpindex),INTENT(in) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
1253	REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget !! Fraction of vegetation type in the mesh (unitless)
1254	REAL(r_std),DIMENSION(kjpindex,nnobio),INTENT(in) :: frac_nobio !! Fraction of ice, lakes, cities etc. in the mesh (unitless)
1255	REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in) :: veget_max !! Maximum fraction of vegetation type in the mesh (unitless)
1256	REAL(r_std),DIMENSION(kjpindex),INTENT(in) :: reinf_slope !! slope coef for reinfiltration
1257	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ks !! Hydraulic conductivity at saturation (mm {-1})
1258	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: nvan !! Van Genuchten coeficients n (unitless)
1259	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: avan !! Van Genuchten coeficients a (mm-1})
1260	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
1261	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
1262	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
1263	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
1264	REAL(r_std),DIMENSION(kjpindex,nvm,npco2),INTENT(in) :: assim_param !! assimilation parameters vcmax, nue, and leaf nitrogen
1265	REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(in) :: frac_age !! Age efficacity from STOMATE for isoprene
1266	REAL(r_std),DIMENSION(:,:,:,:,:),INTENT(in) :: circ_class_biomass !! Biomass components of the model tree
1267	!! within a circumference class
1268	!! class @tex $(g C ind^{-1})$ @endtex
1269	REAL(r_std),DIMENSION(:,:,:),INTENT(in) :: circ_class_n !! Number of trees within each circumference
1270	!! class @tex $(m^{-2})$ @endtex
1271	REAL(r_std),DIMENSION(:,:,:),INTENT(in) :: lai_per_level !! This is the LAI per vertical level
1272	!! @tex $(m^{2} m^{-2})$
1273	TYPE(laieff_type),DIMENSION(:,:,:),INTENT(in) &
1274	:: laieff_fit !! Fitted parameters for the effective LAI
1275	REAL(r_std), DIMENSION(:,:), INTENT(in) :: loss_gain !! Changes in veget_max distributed over all
1276	!! age classes and thus taking the age-classes into
1277	!! account (unitless, 0-1)
1278	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(in) :: frac_nobio_new !! Fraction of ice,lakes,cities, ... (unitless)
1279	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(in) :: veget_max_new !! Maximum fraction of vegetation type including none
1280
1281	!! 0.3 Modified variables
1282	REAL(r_std), DIMENSION(kjpindex,ngrnd,nvm), INTENT(in):: heat_Zimov !! heating associated with decomposition [W/m**3 soil]
1283	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: altmax !! Maximul active layer thickness (m). Be careful, here active means non frozen.
1284	!! Not related with the active soil carbon pool.
1285	REAL(r_std), DIMENSION(kjpindex), INTENT (in) :: depth_organic_soil !! how deep is the organic soil?
1286
1287
1288	!! 0.4 Local variables
1289	REAL(r_std),DIMENSION(kjpindex,nmonth) :: Ninput_ammo !! Daily ammonium inputs (gN m-2 day-1)
1290	REAL(r_std),DIMENSION(kjpindex,nmonth) :: Ninput_nitr !! Daily nitrate inputs (gN m-2 day-1)
1291	REAL(r_std),DIMENSION(kjpindex,nmonth) :: Ninput_fert !! Daily N fertilization (gN m-2 day-1)
1292	REAL(r_std),DIMENSION(kjpindex,nmonth) :: Ninput_bnf !! Daily biological N fixation (gN m-2 day-1)
1293	REAL(r_std) :: tmp_day(1) !! temporary variable for I/O
1294	INTEGER :: ji, jv, imonth !! Indices
1295	INTEGER :: iele,im,jf,ivm !! Indices
1296	CHARACTER(LEN=4) :: laistring !! Temporary character string
1297	CHARACTER(LEN=80) :: var_name !! To store variables names for I/O
1298	CHARACTER(LEN=2), DIMENSION(nelements) :: element_str !! Element string used to make nice variables names
1299	!! in restart files
1300	CHARACTER(LEN=10) :: part_str !! string suffix indicating an index
1301	CHARACTER(LEN=2) :: month_str !! string used in variable name in restart files
1302
1303	!_ ================================================================================================================================
1304
1305	IF (printlev_loc>=3) WRITE (numout,*) 'Write restart file with SLOWPROC variables '
1306
1307	!! 1. Define element string
1308	DO iele = 1,nelements
1309	IF (iele == icarbon) THEN
1310	element_str(iele) = 'c'
1311	ELSEIF (iele == initrogen) THEN
1312	element_str(iele) = 'n'
1313	ELSE
1314	STOP 'Define element_str'
1315	ENDIF
1316	ENDDO
1317
1318	! 2.1 Write a series of variables controled by slowproc to the restart file
1319	CALL restput_p (rest_id, 'veget', nbp_glo, nvm, 1, kjit, &
1320	veget, 'scatter', nbp_glo, index_g)
1321	!-
1322	CALL restput_p (rest_id, 'veget_max', nbp_glo, nvm, 1, kjit, &
1323	veget_max, 'scatter', nbp_glo, index_g)
1324	!-
1325	CALL restput_p (rest_id, 'circ_class_n', nbp_glo, nvm, ncirc, kjit, &
1326	circ_class_n, 'scatter', nbp_glo, index_g)
1327	!-
1328	DO iele = 1,nelements
1329	var_name = 'cc_biomass_'//TRIM(element_str(iele))
1330	CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, &
1331	circ_class_biomass(:,:,:,:,iele), 'scatter', nbp_glo, index_g)
1332	!-
1333	ENDDO
1334	CALL restput_p (rest_id, 'assim_param',nbp_glo, nvm, npco2, kjit, &
1335	assim_param, 'scatter', nbp_glo, index_g)
1336	!-
1337	CALL restput_p (rest_id, 'frac_nobio', nbp_glo, nnobio, 1, kjit, frac_nobio, 'scatter', nbp_glo, index_g)
1338	!-
1339	CALL restput_p (rest_id, 'loss_gain', nbp_glo, nvm, 1, kjit, &
1340	loss_gain, 'scatter', nbp_glo, index_g)
1341	!-
1342	CALL restput_p (rest_id, 'veget_max_new', nbp_glo, nvm, 1, kjit, &
1343	veget_max_new, 'scatter', nbp_glo, index_g)
1344	!-
1345	CALL restput_p (rest_id, 'frac_nobio_new', nbp_glo, nnobio, 1, kjit, frac_nobio_new, 'scatter', nbp_glo, index_g)
1346
1347	!+++CHECK+++
1348	!!$ ! Are the values of frac_age what we expect for ok_bvoc? Seems that not
1349	!!$ ! much is happening with frac_age for the moment
1350	!!$ CALL restput_p (rest_id, 'frac_age', nbp_glo, nvm, nleafages, kjit, &
1351	!!$ frac_age, 'scatter', nbp_glo, index_g)
1352	!+++++++++++
1353
1354	! Add the soil_classif as suffix for the variable name of njsc when it is stored in the restart file.
1355	IF (soil_classif == 'zobler') THEN
1356	var_name= 'njsc_zobler'
1357	ELSE IF (soil_classif == 'usda') THEN
1358	var_name= 'njsc_usda'
1359	END IF
1360
1361	CALL restput_p (rest_id, var_name, nbp_glo, 1, 1, kjit, REAL(njsc, r_std), 'scatter', nbp_glo, index_g)
1362	!-
1363	CALL restput_p (rest_id, 'reinf_slope', nbp_glo, 1, 1, kjit, reinf_slope, 'scatter', nbp_glo, index_g)
1364	!-
1365	CALL restput_p (rest_id, 'clay_frac', nbp_glo, 1, 1, kjit, clayfraction, 'scatter', nbp_glo, index_g)
1366	!-
1367	CALL restput_p (rest_id, 'sand_frac', nbp_glo, 1, 1, kjit, sandfraction, 'scatter', nbp_glo, index_g)
1368	!-
1369	CALL restput_p (rest_id, 'silt_frac', nbp_glo, 1, 1, kjit, siltfraction, 'scatter', nbp_glo, index_g)
1370	!-
1371	CALL restput_p (rest_id, 'bulk', nbp_glo, 1, 1, kjit, bulk, 'scatter', nbp_glo, index_g)
1372	!-
1373	CALL restput_p (rest_id, 'soil_ph', nbp_glo, 1, 1, kjit, soil_ph, 'scatter', nbp_glo, index_g)
1374	!-
1375	CALL restput_p (rest_id, 'mcs', nbp_glo, 1, 1, kjit, mcs, 'scatter', nbp_glo, index_g)
1376	!-
1377	CALL restput_p (rest_id, 'mcr', nbp_glo, 1, 1, kjit, mcr, 'scatter', nbp_glo, index_g)
1378	!-
1379	CALL restput_p (rest_id, 'mcfc', nbp_glo, 1, 1, kjit, mcfc, 'scatter', nbp_glo, index_g)
1380	!-
1381	CALL restput_p (rest_id, 'mcw', nbp_glo, 1, 1, kjit, mcw, 'scatter', nbp_glo, index_g)
1382	!-
1383	CALL restput_p (rest_id, 'avan', nbp_glo, 1, 1, kjit, avan, 'scatter', nbp_glo, index_g)
1384	!-
1385	CALL restput_p (rest_id, 'nvan', nbp_glo, 1, 1, kjit, nvan, 'scatter', nbp_glo, index_g)
1386	!-
1387	CALL restput_p (rest_id, 'ks', nbp_glo, 1, 1, kjit, ks, 'scatter', nbp_glo, index_g)
1388	!-
1389	! Specific case where the LAI is read and not calculated by STOMATE: need to be saved
1390	IF (read_lai) THEN
1391	DO iele = 1,nelements
1392	DO imonth = 1,nmonth
1393	10 FORMAT(I2)
1394	WRITE (month_str,10) imonth
1395	var_name = 'cc_biomass_m_'//TRIM(month_str)//'_'//TRIM(element_str(iele))
1396	CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, &
1397	cc_biomass_m(:,:,:,:,imonth,iele), 'scatter', nbp_glo, index_g)
1398	ENDDO
1399	ENDDO
1400	var_name = 'cc_n_m'
1401	CALL restput_p (rest_id, var_name, nbp_glo, nvm, ncirc, 12, kjit, &
1402	cc_n_m(:,:,:,:), 'scatter', nbp_glo, index_g)
1403	ENDIF
1404
1405
1406	IF (ok_ncycle .AND. (.NOT. impose_CN)) THEN
1407	CALL restput_p (rest_id, 'Nammonium', nbp_glo, nvm , 12, kjit, N_input(:,:,:,iammonium), 'scatter', nbp_glo, index_g)
1408	!-
1409	CALL restput_p (rest_id, 'Nnitrate', nbp_glo, nvm, 12, kjit, N_input(:,:,:,initrate), 'scatter', nbp_glo, index_g)
1410	!-
1411	CALL restput_p (rest_id, 'Nfert', nbp_glo, nvm, 12, kjit, N_input(:,:,:,ifert), 'scatter', nbp_glo, index_g)
1412	!-
1413	CALL restput_p (rest_id, 'Nmanure', nbp_glo, nvm, 12, kjit, N_input(:,:,:,imanure), 'scatter', nbp_glo, index_g)
1414	!-
1415	CALL restput_p (rest_id, 'Nbnf', nbp_glo, nvm, 12, kjit, N_input(:,:,:,ibnf), 'scatter', nbp_glo, index_g)
1416	!-
1417	END IF
1418
1419	!
1420	! If there is some N inputs change, write the year
1421	CALL restput_p (rest_id, 'Ninput_year', kjit, ninput_year)
1422	!-
1423
1424	! 2.2 Write restart variables managed by STOMATE
1425	! The restart files of stomate and sechiba both contain circ_class_biomass, and circ_class_n.
1426	! This allows to run a first simulation with stomate and then use its restarts
1427	! for a simulation with only sechiba.
1428	IF ( ok_stomate ) THEN
1429	CALL stomate_finalize (kjit, kjpindex, indexLand, clayfraction, siltfraction, &
1430	bulk, assim_param, &
1431	heat_Zimov, altmax, depth_organic_soil, circ_class_biomass, circ_class_n, &
1432	lai_per_level, laieff_fit)
1433	ENDIF
1434
1435	END SUBROUTINE slowproc_finalize
1436
1437
1438	!! ================================================================================================================================
1439	!! SUBROUTINE : slowproc_init
1440	!!
1441	!>\BRIEF Initialisation of all variables linked to SLOWPROC
1442	!!
1443	!! DESCRIPTION : (definitions, functional, design, flags): The subroutine manages
1444	!! diverses tasks:
1445	!!
1446	!! RECENT CHANGE(S): None
1447	!!
1448	!! MAIN OUTPUT VARIABLE(S): ::
1449	!! ::veget, ::frac_nobio, ::totfrac_nobio, ::veget_max, ::height, ::soiltype
1450	!! ::Ninput_update
1451	!!
1452	!! REFERENCE(S) : None
1453	!!
1454	!! FLOWCHART : None
1455	!! \n
1456	!_ ================================================================================================================================
1457
1458	SUBROUTINE slowproc_init (kjit, kjpindex, IndexLand, lalo, neighbours, resolution, contfrac, &
1459	rest_id, frac_age, veget, frac_nobio, totfrac_nobio, soiltile, fraclut, nwdfraclut, reinf_slope, &
1460	ks, nvan, avan, mcr, mcs, mcfc, mcw, &
1461	veget_max, tot_bare_soil, njsc, &
1462	Ninput_update, Ninput_year, &
1463	circ_class_biomass, circ_class_n, assim_param, loss_gain, veget_max_new, &
1464	frac_nobio_new)
1465
1466	!! INTERFACE DESCRIPTION
1467
1468	!! 0.1 Input variables
1469	INTEGER(i_std), INTENT (in) :: kjit !! Time step number
1470	INTEGER(i_std), INTENT (in) :: kjpindex !! Domain size - Terrestrial pixels only
1471	INTEGER(i_std), INTENT (in) :: rest_id !! Restart file identifier
1472	INTEGER(i_std), DIMENSION (kjpindex), INTENT (in) :: IndexLand !! Indices of the land points on the map
1473	REAL(r_std), DIMENSION (kjpindex,2), INTENT (in) :: lalo !! Geogr. coordinates (latitude,longitude) (degrees)
1474	INTEGER(i_std), DIMENSION (kjpindex,NbNeighb), INTENT(in):: neighbours !! Vector of neighbours for each grid point
1475	!! (1=North and then clockwise)
1476	REAL(r_std), DIMENSION (kjpindex,2), INTENT(in) :: resolution !! size in x and y of the grid (m)
1477	REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: contfrac !! Fraction of continent in the grid (unitless)
1478
1479	!! 0.2 Output variables
1480	INTEGER(i_std), INTENT(out) :: Ninput_update !! update frequency in timesteps (years) for N inputs
1481	INTEGER(i_std), INTENT(out) :: Ninput_year !! Year for the nitrogen inputs
1482	INTEGER(i_std), DIMENSION(kjpindex), INTENT(out) :: njsc !! Index of the dominant soil textural class in the grid
1483	!! cell (1-nscm, unitless)
1484	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (out) :: veget !! Fraction of vegetation type in the mesh (unitless)
1485	REAL(r_std), DIMENSION (kjpindex,nnobio), INTENT (out):: frac_nobio !! Fraction of ice,lakes,cities, in the mesh (unitless)
1486	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: totfrac_nobio !! Total fraction of ice+lakes+cities+ in the mesh (unitless)
1487	REAL(r_std), DIMENSION (kjpindex), INTENT (out) :: tot_bare_soil !! Total evaporating bare soil fraction in the mesh (unitless)
1488	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT (out) :: veget_max !! Max fraction of vegetation type in the mesh (unitless)
1489	REAL(r_std), DIMENSION (kjpindex,nvm,nleafages), INTENT (out):: frac_age !! Age efficacity from STOMATE for isoprene
1490	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out) :: soiltile !! Fraction of each soil tile within vegtot
1491	!! (0-1, unitless)
1492	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: reinf_slope !! slope coef for reinfiltration
1493	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: ks !! Hydraulic conductivity at saturation (mm {-1})
1494	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: nvan !! Van Genuchten coeficients n (unitless)
1495	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: avan !! Van Genuchten coeficients a (mm-1})
1496	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
1497	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
1498	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
1499	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
1500	REAL(r_std),DIMENSION (:,:,:,:,:), INTENT(out) :: circ_class_biomass !! Biomass components of the model tree
1501	!! within a circumference class
1502	!! class @tex $(g C ind^{-1})$ @endtex
1503	REAL(r_std), DIMENSION (:,:,:), INTENT(out) :: circ_class_n !! Number of trees within each circumference
1504	!! class @tex $(m^{-2})$ @endtex
1505	REAL(r_std),DIMENSION (:,:,:), INTENT(out) :: assim_param !! assimilation parameters, vcmax, nue and leaf nitrogen
1506	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out) :: fraclut !! Fraction of each landuse tile
1507	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out) :: nwdfraclut !! Fraction of non woody vegetation in each landuse tile
1508	REAL(r_std), DIMENSION (kjpindex,nvm), INTENT(out) :: loss_gain !! Fractional losses and gains following a land cover change (unitless, 0-1)
1509	REAL(r_std),DIMENSION (kjpindex,nnobio), INTENT(out) :: frac_nobio_new !! Fraction of ice,lakes,cities, ... (unitless)
1510	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out) :: veget_max_new !! Maximum fraction of vegetation type including none
1511
1512
1513	!! 0.3 Modified variables
1514
1515	!! 0.4 Local variables
1516	REAL(r_std) :: zcanop !! ???? soil depth taken for canopy
1517	INTEGER(i_std) :: vtmp(1) !! temporary variable
1518	REAL(r_std), DIMENSION(nslm) :: zsoil !! soil depths at diagnostic levels
1519	INTEGER(i_std) :: njsc_imp !! njsc to impose nvan, ks etc. if impsoil
1520	CHARACTER(LEN=4) :: laistring !! Temporary character string
1521	INTEGER(i_std) :: l, jf, im !! Indices
1522	CHARACTER(LEN=80) :: var_name !! To store variables names for I/O
1523	INTEGER(i_std) :: ji, jv, ier,jst !! Indices
1524	LOGICAL :: get_slope
1525	REAL(r_std) :: frac_nobio1 !! temporary variable for frac_nobio(see above)
1526	REAL(r_std), DIMENSION(kjpindex) :: tmp_real
1527	REAL(r_std), DIMENSION(kjpindex,nslm) :: stempdiag2_bid !! matrix to store stempdiag_bid
1528	REAL(r_std), DIMENSION (kjpindex,nscm) :: soilclass !! Fractions of each soil textural class in the grid cell (0-1, unitless)
1529	CHARACTER(LEN=30), SAVE :: ninput_str !! update frequency for N inputs
1530	!$OMP THREADPRIVATE(ninput_str)
1531	CHARACTER(LEN=10) :: part_str !! string suffix indicating an index
1532	REAL(r_std), DIMENSION(kjpindex) :: frac_crop_tot !! Total fraction occupied by crops (0-1, unitless)
1533	REAL(r_std), DIMENSION(kjpindex) :: mvan, psi_fc, psi_w !! To calculate default wilting point and
1534	!! field capacity if impsoilt
1535	REAL(r_std), DIMENSION(kjpindex) :: mcfc_default !! Default field capacity if impsoilt
1536	REAL(r_std), DIMENSION(kjpindex) :: mcw_default !! Default wilting point if impsoilt
1537	REAL(r_std) :: nvan_default !! Default if impsoilt
1538	REAL(r_std) :: avan_default !! Default if impsoilt
1539	REAL(r_std) :: mcr_default !! Default if impsoilt
1540	REAL(r_std) :: mcs_default !! Default if impsoilt
1541	REAL(r_std) :: ks_default !! Default if impsoilt
1542	REAL(r_std) :: clayfraction_default !! Default if impsoilt
1543	REAL(r_std) :: sandfraction_default !! Default if impsoilt
1544	LOGICAL :: found_restart !! found_restart=true if all 3 variables veget_max,
1545	!! veget and frac_nobio are read from restart file
1546	LOGICAL :: call_slowproc_soilt !! This variables will be true if subroutine slowproc_soilt needs to be called
1547	CHARACTER(LEN=80) :: fieldname !! name of the field read in the N input map
1548	REAL(r_std) :: nammonium, nnitrate !! Precribed amounts of deposition
1549	REAL(r_std) :: nfert, nbnf,nmanure !! Prescribed amounts of N input from fertilizer,
1550	!! biological fixation and manure
1551	REAL(r_std), DIMENSION(kjpindex,nvm,12) :: N_input_temp
1552	INTEGER :: iele, imonth, ipts !! Indices
1553	INTEGER :: ivmax, ivm !! Indices
1554	CHARACTER(LEN=2), DIMENSION(nelements) :: element_str !! Element string used to make nice variables names
1555	!! in restart files
1556	CHARACTER(LEN=2) :: month_str !! string used in variable name in restart files
1557	REAL(r_std), DIMENSION(kjpindex) :: fracsum !! Sum of both fracnobio and veget_max
1558	REAL(r_std), DIMENSION(kjpindex) :: count !! pixels with an error
1559	REAL(r_std) :: residual !! precision error that should be corrected for
1560	REAL(r_std), DIMENSION(nvm) :: sechiba_vegmax !! temporary variable to use impose_veg
1561	!_ ================================================================================================================================
1562
1563
1564	IF (printlev_loc>=3) WRITE (numout,*) "In slowproc_init"
1565
1566	!! 1. Allocate memory
1567	ALLOCATE (clayfraction(kjpindex),stat=ier)
1568	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
1569	'Problem in allocation of variable clayfraction','','')
1570	clayfraction(:)=undef_sechiba
1571
1572	ALLOCATE (sandfraction(kjpindex),stat=ier)
1573	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable sandfraction','','')
1574	sandfraction(:)=undef_sechiba
1575
1576	ALLOCATE (siltfraction(kjpindex),stat=ier)
1577	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init','Problem in allocation of variable siltfraction','','')
1578	siltfraction(:)=undef_sechiba
1579
1580	ALLOCATE (bulk(kjpindex),stat=ier)
1581	IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
1582	'Problem in allocation of variable bulk','','')
1583	bulk(:)=undef_sechiba
1584
1585	ALLOCATE (soil_ph(kjpindex),stat=ier)
1586	IF (ier.NE.0) CALL ipslerr_p(3,'slowproc_init',&
1587	'Problem in allocation of variable soilph','','')
1588	soil_ph(:)=undef_sechiba
1589
1590	ALLOCATE (n_input(kjpindex,nvm,12,ninput),stat=ier)
1591	IF (ier.NE.0) THEN
1592	WRITE (numout,) ' error in n_input allocation. We stop. We need kjpindexninput words = ',kjpindex,ninput
1593	STOP 'slowproc_init'
1594	END IF
1595
1596	! Allocate variables to prescribe canopy structure when
1597	! stomate is not used
1598	IF (read_lai)THEN
1599	! cc_biomass and cc_n are prescribed from files with monthly values
1600	ALLOCATE (cc_biomass_m(kjpindex,nvm,ncirc,nparts,12,nelements),stat=ier)
1601	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
1602	'Problem in allocation of variable cc_biomass_m','','')
1603	ALLOCATE (cc_n_m(kjpindex,nvm,ncirc,12), stat=ier)
1604	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
1605	'Problem in allocation of variable cc_n_m','','')
1606	ELSE
1607	! allocate the variables but they will never be used
1608	ALLOCATE (cc_biomass_m(1,1,1,1,1,1), stat=ier)
1609	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
1610	'Problem in allocation of variable cc_biomass_m(1,1,1,1,1,1)','','')
1611	ALLOCATE (cc_n_m(1,1,1,1), stat=ier)
1612	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_init',&
1613	'Problem in allocation of variable cc_n_m(1,1,1,1)','','')
1614	ENDIF
1615
1616	!! 2. Read general parameters
1617
1618	!
1619	! Time step of STOMATE and LAI update when reading an LAI map
1620	!
1621	!Config Key = DT_STOMATE
1622	!Config Desc = Time step of STOMATE and other slow processes
1623	!Config If = OK_STOMATE
1624	!Config Def = one_day
1625	!Config Help = Time step (s) of regular update of vegetation
1626	!Config cover, LAI etc. This is also the time step
1627	!Config of STOMATE.
1628	!Config Units = [seconds]
1629	dt_stomate = one_day
1630	CALL getin_p('DT_STOMATE', dt_stomate)
1631
1632	!! 3. Read the soil related variables
1633	! The model could start from scratch, from a restart file or the value of
1634	! specific variables could be imposed. Imposing could make use of fixed
1635	! values or from maps. This results in many possible configurations some
1636	! of which are not very useful. The order of the code in this subroutine
1637	! already limits the number of possible configurations to initialize the
1638	! model but the real quality control on this issue is taking place in
1639	! sechiba in the subroutine check_configuration. The order implemented
1640	! here is: (1) Read the values from a restart file if available. If
1641	! no restart file is found, give the variable the value val_exp (done
1642	! in the subroutine restget_p). If a restart file was found, the value
1643	! for impose_soilt will be ingnored (this is taken care of in setvar_p by
1644	! checking whether the variable has the value val_exp or not). If no
1645	! restart file was found there are still two more options to initialize
1646	! the model: (2) initialize all soil variables by fixed values which can
1647	! be set in the run.def or their default values, or (3) initialize the
1648	! soil variables with values from a map or file (in this case possible
1649	! conflicts with the restart file are explicitly dealt with througf
1650	! IF-statements in this subroutine). Note that all the information
1651	! required to initialize the soil is stored in the sechiba restart. Hence,
1652	! the value of ok_stomate does not affect this part of the initialization.
1653
1654	! The variables are read from restart file. If at least one of the related variables are not found, the
1655	! variable call_slowproc_soilt will be true and the variables will be read and interpolated from file in
1656	! subroutine slowproc_soilt.
1657	call_slowproc_soilt=.FALSE.
1658
1659	! Add the soil classification as suffix for the variable name of njsc to make
1660	! sure that the correct njsc is read from the restart. A restart made with one
1661	! soil classification cannot be used for a simulation with another soil
1662	! classification. The model will crash by saying that the specific variable
1663	! for njsc was not found in the restart file.
1664	IF (soil_classif == 'zobler') THEN
1665	var_name= 'njsc_zobler'
1666	ELSE IF (soil_classif == 'usda') THEN
1667	var_name= 'njsc_usda'
1668	ELSE
1669	CALL ipslerr_p(3,'slowproc_init',&
1670	'Non supported soil typeclassification','','')
1671	END IF
1672
1673	! Index of the dominant soil type in the grid cell
1674	CALL ioconf_setatt_p('UNITS', '-')
1675	CALL ioconf_setatt_p('LONG_NAME','Index of soil type')
1676	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
1677	.TRUE., tmp_real, "gather", nbp_glo, index_g)
1678	IF ( ALL( tmp_real(:) .EQ. val_exp) ) THEN
1679	njsc (:) = undef_int
1680	call_slowproc_soilt=.TRUE.
1681	ELSE
1682	njsc = NINT(tmp_real)
1683	END IF
1684
1685	var_name= 'ks'
1686	CALL ioconf_setatt_p('UNITS', 'mm/d')
1687	CALL ioconf_setatt_p('LONG_NAME','Soil saturated water content')
1688	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., ks, "gather", nbp_glo, index_g)
1689	IF ( ALL(ks(:) .EQ. val_exp ) ) THEN
1690	! ks is not in restart file
1691	call_slowproc_soilt=.TRUE.
1692	END IF
1693
1694	var_name= 'mcs'
1695	CALL ioconf_setatt_p('UNITS', 'm3/m3')
1696	CALL ioconf_setatt_p('LONG_NAME','')
1697	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., mcs, "gather", nbp_glo, index_g)
1698	IF ( ALL(mcs(:) .EQ. val_exp ) ) THEN
1699	! mcs is not in restart file
1700	call_slowproc_soilt=.TRUE.
1701	END IF
1702
1703	var_name= 'mcr'
1704	CALL ioconf_setatt_p('UNITS', 'm3/m3')
1705	CALL ioconf_setatt_p('LONG_NAME','')
1706	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., mcr, "gather", nbp_glo, index_g)
1707	IF ( ALL(mcr(:) .EQ. val_exp ) ) THEN
1708	! mcr is not in restart file
1709	call_slowproc_soilt=.TRUE.
1710	END IF
1711
1712	var_name= 'mcfc'
1713	CALL ioconf_setatt_p('UNITS', 'm3/m3')
1714	CALL ioconf_setatt_p('LONG_NAME','')
1715	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., mcfc, "gather", nbp_glo, index_g)
1716	IF ( ALL(mcfc(:) .EQ. val_exp ) ) THEN
1717	! mcfc is not in restart file
1718	call_slowproc_soilt=.TRUE.
1719	END IF
1720
1721	var_name= 'mcw'
1722	CALL ioconf_setatt_p('UNITS', 'm3/m3')
1723	CALL ioconf_setatt_p('LONG_NAME','')
1724	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., mcw, "gather", nbp_glo, index_g)
1725	IF ( ALL(mcw(:) .EQ. val_exp ) ) THEN
1726	! mcw is not in restart file
1727	call_slowproc_soilt=.TRUE.
1728	END IF
1729
1730	var_name= 'nvan'
1731	CALL ioconf_setatt_p('UNITS', '-')
1732	CALL ioconf_setatt_p('LONG_NAME','')
1733	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., nvan, "gather", nbp_glo, index_g)
1734	IF ( ALL(nvan(:) .EQ. val_exp ) ) THEN
1735	! nvan is not in restart file
1736	call_slowproc_soilt=.TRUE.
1737	END IF
1738
1739	var_name= 'avan'
1740	CALL ioconf_setatt_p('UNITS', 'm-1')
1741	CALL ioconf_setatt_p('LONG_NAME','')
1742	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., avan, "gather", nbp_glo, index_g)
1743	IF ( ALL(avan(:) .EQ. val_exp ) ) THEN
1744	! avan is not in restart file
1745	call_slowproc_soilt=.TRUE.
1746	END IF
1747
1748	var_name= 'clay_frac'
1749	CALL ioconf_setatt_p('UNITS', '-')
1750	CALL ioconf_setatt_p('LONG_NAME','Fraction of clay in each mesh')
1751	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
1752	.TRUE., clayfraction, "gather", nbp_glo, index_g)
1753	IF ( ALL(clayfraction(:) .EQ. val_exp ) ) THEN
1754	! clayfraction is not in restart file
1755	call_slowproc_soilt=.TRUE.
1756	END IF
1757
1758	var_name= 'sand_frac'
1759	CALL ioconf_setatt_p('UNITS', '-')
1760	CALL ioconf_setatt_p('LONG_NAME','Fraction of sand in each mesh')
1761	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., sandfraction, "gather", nbp_glo, index_g)
1762	IF ( ALL(sandfraction(:) .EQ. val_exp ) ) THEN
1763	! sandfraction is not in restart file
1764	call_slowproc_soilt=.TRUE.
1765	END IF
1766
1767	! Read siltfrac instead of just recalculating it. It is already in the restart file.
1768	! Recalculating it can lead to a bitwise error unseen by looking at double precision,
1769	! which accumulates and creates a restartability problem in the future.
1770	var_name= 'silt_frac'
1771	CALL ioconf_setatt_p('UNITS', '-')
1772	CALL ioconf_setatt_p('LONG_NAME','Fraction of silt in each mesh')
1773	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., siltfraction, "gather", nbp_glo, index_g)
1774	IF ( ALL(siltfraction(:) .EQ. val_exp ) ) THEN
1775	! siltfraction is not in restart file
1776	call_slowproc_soilt=.TRUE.
1777	END IF
1778
1779	var_name= 'bulk'
1780	CALL ioconf_setatt_p('UNITS', '-')
1781	CALL ioconf_setatt_p('LONG_NAME','Bulk density in each mesh')
1782	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
1783	.TRUE., bulk, "gather", nbp_glo, index_g)
1784	IF ( ALL(bulk(:) .EQ. val_exp ) ) THEN
1785	! bulk is not in restart file
1786	call_slowproc_soilt=.TRUE.
1787	END IF
1788
1789	var_name= 'soil_ph'
1790	CALL ioconf_setatt_p('UNITS', '-')
1791	CALL ioconf_setatt_p('LONG_NAME','Soil pH in each mesh')
1792	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, &
1793	.TRUE., soil_ph, "gather", nbp_glo, index_g)
1794	IF ( ALL(soil_ph(:) .EQ. val_exp ) ) THEN
1795	! soil_ph is not in restart file
1796	call_slowproc_soilt=.TRUE.
1797	END IF
1798
1799	IF (impsoilt) THEN
1800
1801	!Config Key = SOIL_FRACTIONS
1802	!Config Desc = Areal fraction of the 13 soil USDA textures; the dominant one is selected, Loam by default
1803	!Config Def = 0.0, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0
1804	!Config If = IMPOSE_SOILT
1805	!Config Help = Determines the fraction of the 13 USDA classes with same order as in constantes_soil_var
1806	!Config Units = [-]
1807	soilclass(:,:)=val_exp
1808	CALL setvar_p (soilclass, val_exp, 'SOIL_FRACTIONS', soilclass_default)
1809	! Simplify a heterogeneous grid-cell into an homogeneous one
1810	! with the dominant texture
1811	njsc(:) = 0
1812	DO ji = 1, kjpindex
1813	! here we reduce to the dominant texture class
1814	njsc(ji) = MAXLOC(soilclass(ji,:),1)
1815	ENDDO
1816	njsc_imp = njsc(1) ! to prescribe the VG parameters consistely with the imposed texture
1817
1818
1819	!Config Key = CLAY_FRACTION
1820	!Config Desc = Fraction of the clay fraction (0-dim mode)
1821	!Config Def = 0.2
1822	!Config If = IMPOSE_SOIL
1823	!Config Help = Determines the fraction of clay in the grid box.
1824	! If clayfraction was not in restart file it will be read
1825	! from the run.def file instead or initialized based on
1826	! fractions of each textural class
1827	!Config Units = [-]
1828	clayfraction_default = clayfrac_usda(njsc_imp)
1829	CALL setvar_p (clayfraction, val_exp, 'CLAY_FRACTION', clayfraction_default)
1830
1831	!Config Key = SAND_FRACTION
1832	!Config Desc = Fraction of the sand fraction (0-dim mode)
1833	!Config Def = 0.4
1834	!Config If = IMPOSE_SOIL
1835	!Config Help = Determines the fraction of sand in the grid box.
1836	!Config Units = [-]
1837	sandfraction_default = sandfrac_usda(njsc_imp)
1838	CALL setvar_p (sandfraction, val_exp, 'SAND_FRACTION',sandfraction_default)
1839
1840	! Calculate silt fraction
1841	siltfraction(:) = 1. - clayfraction(:) - sandfraction(:)
1842
1843	!Config Key = BULK
1844	!Config Desc = Bulk density (0-dim mode)
1845	!Config Def = 1000.0
1846	!Config If = IMPOSE_SOIL
1847	!Config Help = Determines the bulk density in the grid box. The bulk density
1848	!Config is the weight of soil in a given volume.
1849	!Config Units = [-]
1850	CALL setvar_p (bulk, val_exp, 'BULK', bulk_default)
1851
1852	!Config Key = SOIL_PH
1853	!Config Desc = Soil pH (0-dim mode)
1854	!Config Def = 5.5
1855	!Config If = IMPOSE_SOIL
1856	!Config Help = Determines the pH in the grid box.
1857	!Config Units = [-]
1858	CALL setvar_p (soil_ph, val_exp, 'SOIL_PH', ph_default)
1859
1860	!Config Key = NVAN_IMP
1861	!Config Desc = NVAN parameter from Van genutchen equations
1862	!Config Def = 1.56 if Loam
1863	!Config If = IMPOSE_SOIL
1864	!Config Help = Determines the nvan in the grid box.
1865	!Config Units = [-]
1866	nvan_default = nvan_usda(njsc_imp)
1867	CALL setvar_p (nvan, val_exp, 'NVAN_IMP', nvan_default)
1868
1869	!Config Key = AVAN_IMP
1870	!Config Desc = AVAN parameter from Van genutchen equations
1871	!Config Def = 0.0036 if Loam
1872	!Config If = IMPOSE_SOIL
1873	!Config Help = Determines the avan in the grid box.
1874	!Config Units = [-]
1875	avan_default = avan_usda(njsc_imp)
1876	CALL setvar_p (avan, val_exp, 'AVAN_IMP', avan_default)
1877
1878	!Config Key = MCR_IMP
1879	!Config Desc = residual soil moisture
1880	!Config Def = 0.078 if Loam
1881	!Config If = IMPOSE_SOIL
1882	!Config Help = Determines the mcr in the grid box.
1883	!Config Units = [-]
1884	mcr_default = mcr_usda(njsc_imp)
1885	CALL setvar_p (mcr, val_exp, 'MCR_IMP', mcr_default)
1886
1887	!Config Key = MCS_IMP
1888	!Config Desc = saturation soil moisture
1889	!Config Def = 0.43 if Loam
1890	!Config If = IMPOSE_SOIL
1891	!Config Help = Determines the mcs in the grid box.
1892	!Config Units = [-]
1893	mcs_default = mcs_usda(njsc_imp)
1894	CALL setvar_p (mcs, val_exp, 'MCS_IMP', mcs_default)
1895
1896	!Config Key = KS_IMP
1897	!Config Desc = saturation conductivity
1898	!Config Def = 249.6 if Loam
1899	!Config If = IMPOSE_SOIL
1900	!Config Help = Determines the ks in the grid box.
1901	!Config Units = [mm/d]
1902	ks_default = ks_usda(njsc_imp)
1903	CALL setvar_p (ks, val_exp, 'KS_IMP', ks_default)
1904
1905	! By default, we calculate mcf and mcw from the above values, as in slowproc_soilt,
1906	! but they can be overruled by values from run.def
1907
1908	mvan(:) = un - (un / nvan(:))
1909	! Define matrix potential in mm for wilting point and field capacity (with sand vs clay-silt variation)
1910	psi_w(:) = 150000.
1911	DO ji=1, kjpindex
1912	IF ( ks(ji) .GE. 560 ) THEN ! Sandy soils (560 is equivalent of 2.75 at log scale of Ks, mm/d)
1913	psi_fc(ji) = 1000.
1914	ELSE ! Finer soils
1915	psi_fc(ji) = 3300.
1916	ENDIF
1917	ENDDO
1918	mcfc_default(:) = mcr(:) + (( mcs(:) - mcr(:)) / (un + ( avan(:) * psi_fc(:)) nvan(:)) mvan(:))
1919	mcw_default(:) = mcr(:) + (( mcs(:) - mcr(:)) / (un + ( avan(:) * psi_w(:)) nvan(:)) mvan(:))
1920
1921	!Config Key = MCFC_IMP
1922	!Config Desc = field capacity soil moisture
1923	!Config Def = 0.1654 if caclulated from default 5 parameters above
1924	!Config If = IMPOSE_SOIL
1925	!Config Help = Determines the mcfc in the grid box.
1926	!Config Units = [-]
1927	mcfc(:) = mcfc_default(:)
1928	CALL setvar_p (mcfc, val_exp, 'MCFC_IMP', mcfc_default)
1929
1930	!Config Key = MCW_IMP
1931	!Config Desc = wilting point soil moisture
1932	!Config Def = 0.0884 if caclulated from default 5 parameters above
1933	!Config If = IMPOSE_SOIL
1934	!Config Help = Determines the mcw in the grid box.
1935	!Config Units = [-]
1936	mcw(:) = mcw_default(:)
1937	CALL setvar_p (mcw, val_exp, 'MCW_IMP', mcw_default)
1938
1939	ELSEIF (.NOT. impsoilt) THEN
1940
1941	IF ( call_slowproc_soilt ) THEN
1942	! At least one of the output variables from slowproc_soilt were not found in the restart file
1943	! and the user did not want to impose values by making use of the run.def or the default model settings.
1944	! Read a map and initialize.
1945	CALL slowproc_soilt(njsc, ks, nvan, avan, mcr, mcs, mcfc, mcw, &
1946	kjpindex, lalo, neighbours, resolution, &
1947	contfrac, soilclass, clayfraction, sandfraction, siltfraction, &
1948	bulk, soil_ph)
1949	call_slowproc_soilt=.FALSE.
1950	ENDIF
1951
1952	ELSE
1953
1954	STOP 'The flag IMPOSE_SOILT is not defined correctly'
1955
1956	ENDIF
1957
1958	! XIOS export of Ks before changing the vertical profile
1959	CALL xios_orchidee_send_field("ksref",ks) ! mm/d (for CMIP6, once)
1960
1961
1962	!! 3. Read the infiltration related variables
1963	! This variable helps reducing surface runuff in flat areas
1964
1965	!! 3.a Looking first in the restart files
1966
1967	var_name= 'reinf_slope'
1968	CALL ioconf_setatt_p('UNITS', '-')
1969	CALL ioconf_setatt_p('LONG_NAME','Slope coef for reinfiltration')
1970	CALL restget_p (rest_id, var_name, nbp_glo, 1, 1, kjit, .TRUE., reinf_slope, "gather", nbp_glo, index_g)
1971
1972	!! 3.b We can also read from a map or prescribe, depending on IMPOSE_SLOPE
1973
1974	IF (impslope) THEN
1975
1976	!! Impose a constant value from the run.def (not anymore controlled by impveg)
1977
1978	!Config Key = REINF_SLOPE
1979	!Config Desc = Fraction of reinfiltrated surface runoff
1980	!Config Def = 0.1
1981	!Config If = IMPOSE_SLOPE
1982	!Config Help = Determines the reinfiltration ratio in the grid box due to flat areas
1983	!Config Units = [-]
1984	slope_default=0.1
1985	CALL setvar_p (reinf_slope, val_exp, 'SLOPE', slope_default)
1986
1987	ELSE
1988
1989	!! Initialize variables by call to slowproc_slope(reading of map) if not in restart file or if get_slope=T.
1990
1991	!Config Key = GET_SLOPE
1992	!Config Desc = Read slopes from file and do the interpolation
1993	!Config Def = n
1994	!Config If =
1995	!Config Help = Needed for reading the slope file and doing the interpolation. This will be
1996	! used by the re-infiltration parametrization
1997	!Config Units = [FLAG]
1998	get_slope = .FALSE.
1999	CALL getin_p('GET_SLOPE',get_slope)
2000
2001	!! If not found from restart or GET_SLOPE = T, we read from a map
2002	IF ( MINVAL(reinf_slope) .EQ. MAXVAL(reinf_slope) .AND. MAXVAL(reinf_slope) .EQ. val_exp .OR. get_slope) THEN
2003	IF (printlev_loc>=4) WRITE (numout,*) 'reinf_slope was not in restart file or get_slope=T. Now call slowproc_slope'
2004
2005	CALL slowproc_slope(kjpindex, lalo, neighbours, resolution, contfrac, reinf_slope)
2006	IF (printlev_loc>=4) WRITE (numout,*) 'After slowproc_slope'
2007
2008	ENDIF
2009
2010	ENDIF
2011
2012	!! 5. Read the vegetation related variables
2013	! The model could start from scratch, from a restart file or the value of
2014	! specific variables could be imposed. Imposing could make use of fixed
2015	! values or from maps. This results in many possible configurations some
2016	! of which are not very useful. The order of the code in this subroutine
2017	! already limits the number of possible configurations to initialize the
2018	! model but the real quality control on this issue is taking place in
2019	! sechiba in the subroutine check_configuration. The order implemented
2020	! here is: (1) Read the values from a restart file if available. If
2021	! no restart file is found, give the variable the value val_exp (done
2022	! in the subroutine restget_p). If a restart file was found, the value
2023	! for impveg will be ignored (this is taken care of in setvar_p by
2024	! checking whether the variable has the value val_exp or not). If no
2025	! restart file was found there are still two more options to initialize
2026	! the model: (2) initialize the vegetation fractions by fixed values which can
2027	! be set in the run.def or their default values, or (3) initialize the
2028	! vegetation fractions with values from a map or file. In case (2) and (3)
2029	! the default of the vegetation varaibles is set to zero. This enables the
2030	! users to prescribe the vegetation fractions but start the rest of the
2031	! model from scratch. Finally there is 4th option in which the vegetation
2032	! variables are also imposed or prescribed from a map. In this case
2033	! conflicts may be introduced, for example, the map contains biomass for a
2034	! given PFT but previous steps in the initialization resulted in a
2035	! veget_max of zero for that PFT. Note that all the information
2036	! required to initialize the vegetation is also stored in the sechiba restart.
2037	! Hence, the value of ok_stomate does not affect this part of the initialization.
2038
2039	! Set default value. It may get overwritten in the subsequent code
2040	found_restart=.TRUE.
2041
2042	! Define element string
2043	DO iele = 1,nelements
2044	IF (iele == icarbon) THEN
2045	element_str(iele) = 'c'
2046	ELSEIF (iele == initrogen) THEN
2047	element_str(iele) = 'n'
2048	ELSE
2049	STOP 'Define element_str'
2050	ENDIF
2051	ENDDO
2052
2053	!! 5.1 Try to read the values from a sechiba restart file.
2054	var_name= 'veget'
2055	CALL ioconf_setatt_p('UNITS', '-')
2056	CALL ioconf_setatt_p('LONG_NAME','Vegetation fraction')
2057	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
2058	veget, "gather", nbp_glo, index_g)
2059	IF ( ALL( veget(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2060
2061	var_name= 'veget_max'
2062	CALL ioconf_setatt_p('UNITS', '-')
2063	CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction')
2064	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
2065	veget_max, "gather", nbp_glo, index_g)
2066	IF ( ALL( veget_max(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2067
2068	var_name= 'frac_nobio'
2069	CALL ioconf_setatt_p('UNITS', '-')
2070	CALL ioconf_setatt_p('LONG_NAME','Special soil type fraction')
2071	CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., &
2072	frac_nobio, "gather", nbp_glo, index_g)
2073	IF ( ALL( frac_nobio(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2074
2075	var_name= 'circ_class_n'
2076	CALL ioconf_setatt_p('UNITS', 'trees m-2')
2077	CALL ioconf_setatt_p('LONG_NAME','Stand density')
2078	CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, kjit, .TRUE., &
2079	circ_class_n, "gather", nbp_glo, index_g)
2080	IF ( ALL( circ_class_n(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2081
2082	DO iele = 1,nelements
2083	var_name = 'cc_biomass_'//TRIM(element_str(iele))
2084	CALL ioconf_setatt_p('UNITS', 'gC(N) tree-1')
2085	CALL ioconf_setatt_p('LONG_NAME','Carbon (or N) mass for the different &
2086	& biomass components of an individual tree')
2087	CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, .TRUE., &
2088	circ_class_biomass(:,:,:,:,iele), "gather", nbp_glo, index_g)
2089	IF ( ALL( circ_class_biomass(:,:,:,:,iele) .EQ. val_exp ) ) found_restart=.FALSE.
2090	ENDDO
2091
2092	var_name= 'loss_gain'
2093	CALL ioconf_setatt_p('UNITS', '-')
2094	CALL ioconf_setatt_p('LONG_NAME','Fraction changes during land cover changes')
2095	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
2096	loss_gain, "gather", nbp_glo, index_g)
2097	IF (veget_update > 0) THEN
2098	! If veget_update is used we expect to have values for loss_gain
2099	! in the restart file. If that is not the case there was no restart.
2100	IF ( ALL( loss_gain(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2101	ELSE
2102	! If the model is run without veget_update, the value of loss_gain
2103	! never changes and remains val_exp. A restart may still have been
2104	! read.
2105	IF ( ALL( loss_gain(:,:) .EQ. val_exp ) ) found_restart=.TRUE.
2106	END IF
2107
2108	var_name= 'veget_max_new'
2109	CALL ioconf_setatt_p('UNITS', '-')
2110	CALL ioconf_setatt_p('LONG_NAME','Maximum vegetation fraction after land cover change')
2111	CALL restget_p (rest_id, var_name, nbp_glo, nvm, 1, kjit, .TRUE., &
2112	veget_max_new, "gather", nbp_glo, index_g)
2113	IF (veget_update > 0) THEN
2114	! If veget_update is used we expect to have values for veget_max_new
2115	! in the restart file. If that is not the case there was no restart.
2116	IF ( ALL( veget_max_new(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2117	ELSE
2118	! If the model is run without veget_update, the value of veget_max_new
2119	! never changes and remains val_exp. A restart may still have been
2120	! read.
2121	IF ( ALL( veget_max_new(:,:) .EQ. val_exp ) ) found_restart=.TRUE.
2122	END IF
2123
2124	var_name= 'frac_nobio_new'
2125	CALL ioconf_setatt_p('UNITS', '-')
2126	CALL ioconf_setatt_p('LONG_NAME','Non biological fraction after land cover change')
2127	CALL restget_p (rest_id, var_name, nbp_glo, nnobio, 1, kjit, .TRUE., &
2128	frac_nobio_new, "gather", nbp_glo, index_g)
2129	IF (veget_update > 0) THEN
2130	! If veget_update is used we expect to have values for frac_nobio_new
2131	! in the restart file. If that is not the case there was no restart.
2132	IF ( ALL( frac_nobio_new(:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2133	ELSE
2134	! If the model is run without veget_update, the value of frac_nobio_new
2135	! never changes and remains val_exp. A restart may still have been
2136	! read.
2137	IF ( ALL( frac_nobio_new(:,:) .EQ. val_exp ) ) found_restart=.TRUE.
2138	END IF
2139
2140	var_name= 'assim_param'
2141	CALL ioconf_setatt_p('UNITS', '-')
2142	CALL ioconf_setatt_p('LONG_NAME','Assimilation parameters, Vcmax, nue and leaf nitrogen')
2143	CALL restget_p (rest_id, var_name, nbp_glo, nvm, npco2, kjit, .TRUE., &
2144	assim_param, "gather", nbp_glo, index_g)
2145	IF ( ALL( assim_param(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2146
2147	!+++CHECK+++
2148	!!$ ! Are the values of frac_age what we expect for ok_bvoc? Seems that not
2149	!!$ ! much is happening with frac_age for the moment
2150	!!$ ! frac_age is used in ok_bvoc which can be called if ok_stomate = F.
2151	!!$ ! In case stomate is not used, it needs to be read from the sechiba
2152	!!$ ! restart file.
2153	!!$ CALL ioconf_setatt_p('UNITS', '-')
2154	!!$ CALL ioconf_setatt_p('LONG_NAME','Fraction of leaves in leaf age class ')
2155	!!$ CALL restget_p (rest_id, 'frac_age', nbp_glo, nvm, nleafages, kjit, .TRUE., &
2156	!!$ frac_age, "gather", nbp_glo, index_g)
2157	!!$ IF ( ALL( frac_age(:,:,:) .EQ. val_exp ) ) found_restart=.FALSE.
2158	!+++++++++++
2159
2160	!! 5.2 Impose vegetation fractions or read from a PFT map
2161	IF (.NOT. found_restart .AND. impveg) THEN
2162
2163	! impveg=TRUE: there can not be any land use change, veget_update must be =0
2164	! Read VEGET_UPDATE from run.def and exit if it is different from 0Y
2165	IF (veget_update /= 0) THEN
2166	WRITE(numout,*) 'veget_update=',veget_update,' is not coherent with impveg=',impveg
2167	CALL ipslerr_p(3,'slowproc_init','Incoherent values between impveg and veget_update', &
2168	'veget_update must be equal to 0 if impveg=true','')
2169	ENDIF
2170
2171	! If no restart file was found replace the val_exp by zero so
2172	! the calculations can start.
2173	IF (ALL(circ_class_biomass(:,:,:,:,:).EQ.val_exp) ) THEN
2174	circ_class_biomass(:,:,:,:,:) = zero
2175	circ_class_n(:,:,:) = zero
2176	ENDIF
2177
2178	! Initialize the vegetation fractions by reading run.def. Previously setvar_p was
2179	! used but it swapped the dimensions when kjpindex = nvm (thus when using 15 pixels).
2180	! Changed to getin_p which is typically used for PFT-dependent parameters.
2181	!Config Key = SECHIBA_VEGMAX
2182	!Config Desc = Maximum vegetation distribution within the mesh (0-dim mode)
2183	!Config If = IMPOSE_VEG
2184	!Config Def = 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.8, 0.0, 0.0, 0.0
2185	!Config Help = The fraction of vegetation is read from the restart file. If
2186	!Config it is not found there we will use the values provided here.
2187	!Config Units = [-]
2188	CALL getin_p('SECHIBA_VEGMAX',sechiba_vegmax)
2189	DO ivm = 1, nvm
2190	veget_max(:,ivm) = sechiba_vegmax(ivm)
2191	END DO
2192
2193	!Config Key = SECHIBA_FRAC_NOBIO
2194	!Config Desc = Fraction of other surface types within the mesh (0-dim mode)
2195	!Config If = IMPOSE_VEG
2196	!Config Def = 0.0
2197	!Config Help = The fraction of ice, lakes, etc. is read from the restart file. If
2198	!Config it is not found there we will use the values provided here.
2199	!Config For the moment, there is only ice.
2200	!Config Units = [-]
2201	! The routine setvar_p will only initialize the variable if it was not found in restart file.
2202	frac_nobio1 = frac_nobio(1,1)
2203	CALL setvar_p (frac_nobio1, val_exp, 'SECHIBA_FRAC_NOBIO', frac_nobio_fixed_test_1)
2204	frac_nobio(:,:) = frac_nobio1
2205
2206	! Check for precision errors
2207	count(:) = zero
2208	! note that the second dimension of veget_max is nvm but for frac_nobio it is nnobio
2209	fracsum(:) = SUM(veget_max(:,:),2) + SUM(frac_nobio(:,:),2)
2210	WHERE (ABS(fracsum(:)-un).GT.10*EPSILON(un))
2211	count(:) = un
2212	ENDWHERE
2213	IF (SUM(count(:)).GT.zero) THEN
2214	! At least one error was found
2215	DO ipts = 1,kjpindex
2216	IF (ABS(fracsum(ipts)-un).GT.min_stomate) THEN
2217	! Too big for a precision error
2218	WRITE(numout,*) 'ipts, veget_max, frac_nobio, total, ', ipts, &
2219	SUM(veget_max(ipts,:)), SUM(frac_nobio(ipts,:)), fracsum(ipts)
2220	CALL ipslerr_p(3,'slowproc.f90','The prescribed vegetation does not',&
2221	'add up to 1','check the run.def')
2222	ELSEIF ( ABS(fracsum(ipts)-un).LE.min_stomate .AND. &
2223	ABS(fracsum(ipts)-un).GT.10*EPSILON(un) ) THEN
2224	! Looks like a precision error so correct it
2225	residual = fracsum(ipts) - un
2226	! Note that dim=1 refers to the dimensions of the answer
2227	ivmax = MAXLOC(veget_max(ipts,:),DIM=1)
2228	IF (veget_max(ipts,ivmax).GT.residual) THEN
2229	veget_max(ipts,ivmax) = veget_max(ipts,ivmax) - residual
2230	CALL ipslerr_p(2,'slowproc.f90','correcting the prescribed veget_max',&
2231	'to account for a precision issue','')
2232	ELSE
2233	CALL ipslerr_p(3,'slowproc.f90','Could not correct a precision error',&
2234	'check the code because this is unecpected','')
2235	END IF
2236	END IF
2237	END DO ! ipts
2238	END IF ! at least one error
2239
2240	ELSE
2241
2242	! The DGVM cannot be combined with land use change if agriculture is not
2243	! accounted for by reading a land cover change map (agriculture cannot
2244	! be predicted by the dgvm and therefore needs to be prescribed by a map)
2245	IF (veget_update > 0 .AND. ok_dgvm .AND. .NOT. agriculture) THEN
2246	CALL ipslerr_p(3,'slowproc_init',&
2247	'The combination DGVM=TRUE, AGRICULTURE=FALSE and VEGET_UPDATE>0 is not possible', &
2248	'Set VEGET_UPDATE=0Y in run.def','')
2249	END IF
2250
2251	IF ( .NOT. found_restart .OR. vegetmap_reset) THEN
2252
2253	! Only when there is no restart and the values have not been imposed, the model
2254	! will read the vegetation fractions from a file
2255	IF (printlev_loc>=3) WRITE(numout,*) 'Before call read_vegetmax in &
2256	& initialization phase without restart files'
2257
2258	! Call the routine to read the vegetation from file (output is veget_max_new)
2259	CALL slowproc_readvegetmax(kjpindex, lalo, neighbours, resolution, contfrac, &
2260	veget_max, veget_max_new, frac_nobio_new, .TRUE.)
2261
2262	! Check the map that was just read for errors.
2263	CALL check_read_vegetmax(kjpindex, veget_max_new, frac_nobio_new)
2264
2265	! Replace the val_exp (needed to check whether a restart was found)
2266	! by zero so the calculations can start
2267	IF (ALL(circ_class_biomass(:,:,:,:,:).EQ.val_exp) ) THEN
2268	circ_class_biomass(:,:,:,:,:) = zero
2269	circ_class_n(:,:,:) = zero
2270	veget_max(:,:) = veget_max_new(:,:)
2271	frac_nobio(:,:) = frac_nobio_new(:,:)
2272	ENDIF
2273
2274	!! Reset totaly or partialy veget_max if using DGVM
2275	IF ( ok_dgvm ) THEN
2276
2277	! If we are dealing with dynamic vegetation then all natural PFTs should
2278	! be set to veget_max = 0. In case no agriculture is desired, agriculture
2279	! PFTS should be set to 0 as well
2280	IF (agriculture) THEN
2281
2282	DO jv = 2, nvm
2283	IF (natural(jv)) THEN
2284	veget_max(:,jv)=zero
2285	ENDIF
2286	ENDDO
2287
2288	! Calculate the fraction of crop for each point.
2289	! Sum only on the indexes corresponding to the non_natural pfts
2290	frac_crop_tot(:) = zero
2291	DO jv = 2, nvm
2292	IF(.NOT. natural(jv)) THEN
2293	DO ji = 1, kjpindex
2294	frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
2295	ENDDO
2296	ENDIF
2297	END DO
2298
2299	! Calculate the fraction of bare soil
2300	DO ji = 1, kjpindex
2301	veget_max(ji,1) = un - frac_crop_tot(ji) - SUM(frac_nobio(ji,:))
2302	ENDDO
2303
2304	ELSE
2305
2306	! No agriculture land in this simulation
2307	veget_max(:,:) = zero
2308	DO ji = 1, kjpindex
2309	veget_max(ji,1) = un - SUM(frac_nobio(ji,:))
2310	ENDDO
2311
2312	END IF ! agriculture is considered in the DGVM
2313
2314	END IF ! end ok_dgvm
2315
2316	END IF ! No restart was found
2317
2318	END IF ! impose vegetation fractions
2319
2320	!! Continue initializing variables not found in restart file. Case for both impveg=true and false.
2321	ALLOCATE(cn_leaf_min_2D(kjpindex, nvm), STAT=ier)
2322	ALLOCATE(cn_leaf_max_2D(kjpindex, nvm), STAT=ier)
2323	ALLOCATE(cn_leaf_init_2D(kjpindex, nvm), STAT=ier)
2324
2325	IF (impose_cn .AND. read_cn) THEN
2326	! cn_leaf_min_2D, cn_leaf_max_2D and cn_leaf_init_2D are set in slowproc_readcnleaf by reading a map in slowproc_readcnleaf
2327	! Note that they are not explicitly passed to this subroutine, but they are module variables, and slowproc_readcnleaf is
2328	! still in this module, so the values are changed nonetheless.
2329	CALL slowproc_readcnleaf(kjpindex, lalo, neighbours, resolution, contfrac)
2330	ELSE
2331	! cn_leaf_min_2D, cn_leaf_max_2D and cn_leaf_init_2D take scalar values with constant spatial distribution
2332	DO ji=1,kjpindex
2333	cn_leaf_min_2D(ji,:)=cn_leaf_min(:)
2334	cn_leaf_init_2D(ji,:)=cn_leaf_init(:)
2335	cn_leaf_max_2D(ji,:)=cn_leaf_max(:)
2336	ENDDO
2337	ENDIF
2338
2339	!! 5.3 Initialize vegetation characteristics
2340	! If a restart file has been read, the vegetation characteristics are
2341	! already known. Note that reading the vegetation characteristics is
2342	! only controlled by the read_lai flag.The user could still decide to
2343	! use all information from the restart but overwrite circ_class_biomass
2344	! and circ_class_n. If no restart file has been read this far, sechiba
2345	! will need a description of the canopy to be able to run. This description
2346	! should come from a so called lai map (note that the map no longer contains
2347	! lai but contains information on the biomass and number of individuals)
2348
2349	!+++CHECK+++
2350	IF (read_lai)THEN
2351
2352	! Initialize
2353	found_restart = .TRUE.
2354
2355	! Read "canopy structure map". This map should be based on
2356	! a previous simulation with ORCHIDEE.
2357	! The difference with a normal restart is that it should read
2358	! circ_class_biomass and circ_class_n for 12 months.
2359	var_name= 'cc_biomass_monthly'
2360	CALL ioconf_setatt_p('UNITS', 'g C(N) m-2 tree-1')
2361	CALL ioconf_setatt_p('LONG_NAME','Monthly values for biomass &
2362	& components per circumference class')
2363	DO iele = 1,nelements
2364	DO imonth = 1,nmonth
2365	10 FORMAT(I2)
2366	WRITE (month_str,10) imonth
2367	var_name = 'cc_biomass_m_'//TRIM(month_str)//'_'//TRIM(element_str(iele))
2368	CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, nparts, kjit, .TRUE., &
2369	cc_biomass_m(:,:,:,:,imonth,iele),"gather", nbp_glo, index_g)
2370	IF ( ALL( cc_biomass_m(:,:,:,:,imonth,iele) .EQ. val_exp ) ) found_restart=.FALSE.
2371	ENDDO
2372	ENDDO
2373
2374	var_name = 'cc_n_m'
2375	CALL ioconf_setatt_p('UNITS', 'tree-1 m-2')
2376	CALL ioconf_setatt_p('LONG_NAME','trees per m2 for each circ class')
2377	CALL restget_p (rest_id, var_name, nbp_glo, nvm, ncirc, 12, kjit, .TRUE. , &
2378	cc_n_m, "gather", nbp_glo, index_g)
2379	IF ( ALL( cc_n_m(:,:,:,:) .EQ. val_exp) ) found_restart=.FALSE.
2380
2381	IF ( .NOT. found_restart ) THEN
2382
2383	WRITE(numout,*) 'AHAAA: inside read_lai - did not find a restart'
2384	! cc_biomass_m and/or cc_n_m were not found in the restart file try
2385	! to find and read a dedicated file that contains monthly values
2386	! for these variables
2387	! See #286
2388	IF (ncirc.NE.3) THEN
2389	WRITE(numout,*) 'Current number of circumference classes (ncirc), ', ncirc
2390	CALL ipslerr_p(3,'instead of reading a LAI map a handfull of fixed biomass',&
2391	'data is read and set for the entire domain.', &
2392	'These values excpect that ncirc = 3','This seems not to be the case')
2393	END IF
2394	!+++TEMP+++
2395	circ_class_biomass(:,:,:,:,:) = zero
2396	circ_class_n(:,:,:) = zero
2397	DO ji = 1,kjpindex
2398	DO jv = 2,nvm
2399	circ_class_biomass(ji,jv,1,:,icarbon) = 3*(/64.1790961402884, 1219.15235836900, 564.11952303, &
2400	712.783132227959, 417.796173293409, 122.105778809076, 20.5181600482659, &
2401	337.744066746780, 46.6473441173028/)
2402	circ_class_biomass(ji,jv,1,:,initrogen) = 3*(/5.38391872316575,14.5306615478275, 6.32728500214539, &
2403	6.73356880989017, 3.63140992343535, 8.80379728708368, 0.909221528487578, &
2404	4.255487191806592E-004, 6.783452513144551E-003/)
2405	circ_class_biomass(ji,jv,2,:,icarbon) = 3*(/285.559552359068, 8632.15052183103, 3862.94977896271, &
2406	4440.95806491165, 2462.91756260235, 543.299510808887, 20.5181600482660, &
2407	337.744066746985, 99.9253437952986/)
2408	circ_class_biomass(ji,jv,2,:,initrogen) = 3*(/10.8985571313903, 36.6657154882537, 15.9658547505304, &
2409	16.9910445846784, 9.16326091799929, 17.8213477283047, 3.105548985182576E-003, &
2410	4.255487191808893E-004, 1.603616996966766E-002/)
2411	circ_class_biomass(ji,jv,3,:,icarbon) = 3*(/1358.39825416204, 66727.3342051582, 28610.5603591189, &
2412	28941.8798532254, 15160.4663937242, 2584.45953172628, 20.5181600482660, &
2413	337.744066746983, 180.177367238784/)
2414	circ_class_biomass(ji,jv,3,:,initrogen) = 3*(/18.7135366977149, 74.2989491440166, 32.3530091900281, &
2415	34.4304410998095, 18.5683177833507, 30.6004217526930, 1.039620165307951E-005, &
2416	4.255487191808977E-004, 5.568363409712271E-002/)
2417	circ_class_n(ji,jv,:) = (/0.373684875218478, 0.124561625072826, 4.152054169094205E-002/)
2418	END DO
2419	END DO
2420
2421	! Initialize other canopy variables with zeros.
2422	! setvar checks whether the restart was found.
2423	CALL setvar_p (frac_age, val_exp, 'FRAC_AGE',zero)
2424	CALL setvar_p (loss_gain, val_exp, 'LOSS_GAIN', zero)
2425	CALL setvar_p (veget_max_new, val_exp, 'VEGET_MAX_NEW', zero)
2426	CALL setvar_p (frac_nobio_new, val_exp, 'FRAC_NOBIO_NEW', zero)
2427
2428	! Read LAI map and interpolate
2429	!!$ ! CHECK - Should be activated again
2430	!!$ CALL slowproc_interlai (kjpindex, lalo, resolution, neighbours, &
2431	!!$ contfrac, cc_biomass_m, circ_class_biomass, cc_n_m, &
2432	!!$ circ_class_n)
2433	!++++++++++
2434
2435	!!$ ! Read lai map
2436	!!$ lai(: ,1) = zero
2437	!!$ ! Loop over PFTs
2438	!!$ DO jv = 2,nvm
2439	!!$
2440	!!$ SELECT CASE (type_of_lai(jv))
2441	!!$
2442	!!$ CASE ("mean ")
2443	!!$ ! Force MAXVAL of laimap on lai on this PFT
2444	!!$ DO ji = 1,kjpindex
2445	!!$ lai(ji,jv) = MAXVAL(laimap(ji,jv,:))
2446	!!$ ENDDO
2447	!!$
2448	!!$ CASE ("inter")
2449	!!$ ! Do the interpolation between laimax and laimin
2450	!!$ IF (mm .EQ. 1 ) THEN
2451	!!$ ! If January
2452	!!$ IF (dd .LE. 15) THEN
2453	!!$ lai(:,jv) = laimap(:,jv,12)*(1-(dd+15)/30.) + &
2454	!!$ laimap(:,jv,1)*((dd+15)/30.)
2455	!!$ ELSE
2456	!!$ lai(:,jv) = laimap(:,jv,1)*(1-(dd-15)/30.) + &
2457	!!$ laimap(:,jv,2)*((dd-15)/30.)
2458	!!$ ENDIF
2459	!!$ ELSE IF (mm .EQ. 12) THEN
2460	!!$ ! If December
2461	!!$ IF (dd .LE. 15) THEN
2462	!!$ lai(:,jv) = laimap(:,jv,11)*(1-(dd+15)/30.) + &
2463	!!$ laimap(:,jv,12)*((dd+15)/30.)
2464	!!$ ELSE
2465	!!$ lai(:,jv) = laimap(:,jv,12)*(1-(dd-15)/30.) + &
2466	!!$ laimap(:,jv,1)*((dd-15)/30.)
2467	!!$ ENDIF
2468	!!$ ELSE
2469	!!$ ! All other months
2470	!!$ IF (dd .LE. 15) THEN
2471	!!$ lai(:,jv) = laimap(:,jv,mm-1)*(1-(dd+15)/30.) + &
2472	!!$ laimap(:,jv,mm)*((dd+15)/30.)
2473	!!$ ELSE
2474	!!$ lai(:,jv) = laimap(:,jv,mm)*(1-(dd-15)/30.) + &
2475	!!$ laimap(:,jv,mm+1)*((dd-15)/30.)
2476	!!$ ENDIF
2477	!!$ ENDIF ! Which months
2478	!!$
2479	!!$ CASE default
2480	!!$ ! Problem - not clear how to interpolate
2481	!!$ WRITE (numout,*) 'This kind of lai choice is not possible. '// &
2482	!!$ ' We stop with type_of_lai ',jv,' = ', type_of_lai(jv)
2483	!!$ CALL ipslerr_p(3,'slowproc_canopy',&
2484	!!$ 'Bad value for type_of_lai','read_lai=true','')
2485	!!$
2486	!!$ END SELECT ! type_of_lai
2487	!!$
2488	!!$ ENDDO
2489
2490	ENDIF ! read_lai
2491
2492	ENDIF
2493	!+++++++++++
2494
2495	! If no restart was found, the model will need to make up its assimilation
2496	! parameters to calculate photosynthesis and transpiration. Note that
2497	! circ_class_biomass should be available either through a restart file,
2498	! or an lai map (that no longer contains lai but contains biomass and
2499	! and the number of individuals.
2500	IF ( .NOT. found_restart .AND. read_lai ) THEN
2501
2502	! Initialize the variables revelant for the assimilation parameters
2503	DO jv = 1, nvm
2504	assim_param(:,jv,ivcmax) = vcmax_fix(jv)
2505	assim_param(:,jv,inue) = nue_opt(jv)
2506	assim_param(:,jv,ileafN) = SUM( &
2507	circ_class_biomass(:,jv,:,ileaf,initrogen) * &
2508	circ_class_n(:,jv,:),2 )
2509	ENDDO
2510	ENDIF
2511
2512	!+++CHECK+++
2513	! Special case for DGVM and restart file.
2514	! JG why is specific treatement needed for DGVM ? Is not the veget_max variable
2515	! correct in the end of last run ?
2516	IF (found_restart) THEN
2517
2518	! WITH restarts for vegetation and DGVM and NO AGRICULTURE
2519	IF ( ok_dgvm .AND. .NOT. agriculture ) THEN
2520	! Calculate the total fraction of crops for each point
2521	frac_crop_tot(:) = zero
2522	DO jv = 2, nvm
2523	IF ( .NOT. natural (jv)) THEN
2524	DO ji = 1, kjpindex
2525	frac_crop_tot(ji) = frac_crop_tot(ji) + veget_max(ji,jv)
2526	ENDDO
2527	ENDIF
2528	ENDDO
2529
2530	! Add the crops fraction to the bare soil fraction
2531	DO ji = 1, kjpindex
2532	veget_max(ji,1) = veget_max(ji,1) + frac_crop_tot(ji)
2533	ENDDO
2534
2535	! Set the crops fraction to zero
2536	DO jv = 2, nvm
2537	IF ( .NOT. natural (jv)) THEN
2538	veget_max(:,jv) = zero
2539	ENDIF
2540	ENDDO
2541	ENDIF
2542	ENDIF ! end found_restart
2543	!+++++++++++
2544
2545
2546	!! 7. Some calculations always done, with and without restart files
2547	! The variables veget, veget_max and frac_nobio were all read from
2548	! restart file or initialized above. Calculate now totfrac_nobio and
2549	! soiltiles using these variables.
2550	IF (ok_bare_soil_new) THEN
2551
2552	!+++CHECK+++
2553	! We no longer want to treat the gaps in the canopy as
2554	! bare soil. It needs to be tested what will happen with
2555	! the evaporation in the single-layer model. The multi-
2556	! layer energy budget should be able to correctly deal
2557	! with the gaps in the canopy.
2558	tot_bare_soil(:) = veget_max(:,1)
2559
2560	! Total frac nobio
2561	totfrac_nobio(:) = SUM(frac_nobio(:,:),2)
2562	!+++++++++++
2563
2564	ELSE
2565
2566	! Initialize
2567	fracsum(:) = zero
2568	tot_bare_soil(:) = veget_max(:,1)
2569
2570	! Calculate bare soil fraction
2571	DO ji = 1, kjpindex
2572
2573	! Total frac nobio
2574	totfrac_nobio(ji) = SUM(frac_nobio(ji,:))
2575
2576	DO jv = 2, nvm
2577
2578	! Move the canopy gaps into the bare soil
2579	! fraction for this time step. Calculate
2580	! the total fraction of bare soil in the
2581	! grid
2582	tot_bare_soil(ji) = tot_bare_soil(ji) + &
2583	(veget_max(ji,jv) - veget(ji,jv))
2584	fracsum(ji) = fracsum(ji) + veget(ji,jv)
2585
2586	ENDDO
2587
2588	! Consistency check
2589	fracsum(ji) = fracsum(ji) + tot_bare_soil(ji) + SUM(frac_nobio(ji,:))
2590	IF (fracsum(ji) .LT. 0.99999) THEN
2591	WRITE(numout,*)' ATTENTION, in ji, fracsum LT 1: ', ji, fracsum(ji)
2592	WRITE(numout,*)' frac_nobio = ',SUM(frac_nobio(ji,:))
2593	WRITE(numout,*)' veget = ',veget(ji,:)
2594	WRITE(numout,*)' tot_bare_soil = ',tot_bare_soil(ji)
2595	ENDIF
2596	ENDDO
2597
2598	ENDIF ! ok_bare_soil_new
2599
2600	!! 8. Calculate soiltiles
2601	! Soiltiles are only used in hydrol, but we fix them in here because some time
2602	! it might depend on a changing vegetation (but then some adaptation should be
2603	! made to hydrol) and be also used in the other modules to perform separated
2604	! energy balances.
2605	! The sum of all soiltiles makes one, and corresponds to the bio fraction
2606	! of the grid cell (called vegtot in hydrol)
2607	soiltile(:,:) = zero
2608	DO jv = 1, nvm
2609	jst = pref_soil_veg(jv)
2610	DO ji = 1, kjpindex
2611	soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
2612	ENDDO
2613	ENDDO
2614
2615	DO ji = 1, kjpindex
2616	IF (totfrac_nobio(ji) .LT. (1-EPSILON(un))) THEN
2617	! If the calculation of 1-totfrac_nobio is correct its value
2618	! should be identical to SUM(soiltile) give or take precision
2619	! issues.
2620	IF (ABS(SUM(soiltile(ji,:))-(1-totfrac_nobio(ji))).LT.min_sechiba) THEN
2621	! If the numbers are very similar, the divsion may result in
2622	! errors of 10e-10. By taking the minimum we protect against
2623	! such conditions.
2624	soiltile(ji,:)=MIN(soiltile(ji,:)/(1.-totfrac_nobio(ji)),un)
2625	ELSE
2626	! Mismatch between SUM(soiltile) and 1-totfrac_nobio.
2627	CALL ipslerr_p (3,'slowproc_main',&
2628	'Mismatch between SUM(soiltile) and 1-totfrac_nobio','','')
2629	ENDIF
2630	ELSE
2631	soiltile(ji,:)=zero
2632	ENDIF
2633	ENDDO
2634
2635	!! 10. Initialize different sources of nitrogen
2636	IF(ok_ncycle .AND. (.NOT. impose_CN)) THEN
2637	IF((.NOT. impose_ninput_dep) .OR. (.NOT. impose_ninput_fert) .OR. (.NOT. impose_ninput_bnf)) THEN
2638	var_name= 'Ninput_year'
2639	CALL ioconf_setatt_p('UNITS', '-')
2640	CALL ioconf_setatt_p('LONG_NAME','Last year get in N input file.')
2641	! Read Ninput_year from restart file. For restget_p interface for scalar value, the default value
2642	! if the variable is not in the restart file is given as argument, here use REAL(Ninput_year_orig)
2643	CALL restget_p (rest_id, var_name, kjit, .TRUE., REAL(Ninput_year_orig), Ninput_year)
2644
2645	IF (Ninput_reinit) THEN
2646	! Reset Ninput_year
2647	Ninput_year=Ninput_year_orig
2648	ENDIF
2649
2650
2651	!Config Key = NINPUT_UPDATE
2652	!Config Desc = Update N input frequency
2653	!Config If = ok_ncycle .AND. (.NOT. impose_cn) .AND. .NOT. impsoilt
2654	!Config Def = 0Y
2655	!Config Help = The veget datas will be update each this time step.
2656	!Config Units = [years]
2657	!
2658	ninput_update=0
2659	WRITE(ninput_str,'(a)') '0Y'
2660	CALL getin_p('NINPUT_UPDATE', ninput_str)
2661	l=INDEX(TRIM(ninput_str),'Y')
2662	READ(ninput_str(1:(l-1)),"(I2.2)") ninput_update
2663	WRITE(numout,*) "Update frequency for N inputs in years :",ninput_update
2664	ENDIF
2665
2666
2667	IF(.NOT. impose_Ninput_dep) THEN
2668	FOUND_RESTART=.TRUE.
2669	CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
2670	CALL ioconf_setatt_p('LONG_NAME','N ammonium deposition')
2671	CALL restget_p (rest_id, 'Nammonium', nbp_glo, nvm, 12, kjit, .TRUE., N_input(:,:,:,iammonium), &
2672	"gather", nbp_glo, index_g)
2673	IF ( ALL( N_input(:,:,:,iammonium) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
2674
2675	CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
2676	CALL ioconf_setatt_p('LONG_NAME','N nitrate deposition')
2677	CALL restget_p (rest_id, 'Nnitrate', nbp_glo, nvm, 12, kjit, .TRUE., N_input(:,:,:,initrate), &
2678	"gather", nbp_glo, index_g)
2679	IF ( ALL( N_input(:,:,:,initrate) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
2680
2681	IF(.NOT. FOUND_RESTART) THEN
2682	! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
2683	fieldname='Nammonium'
2684	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2685	N_input(:,:,:,iammonium), Ninput_year)
2686	fieldname='Nnitrate'
2687	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2688	N_input(:,:,:,initrate), Ninput_year)
2689	! Conversion from mgN/m2/yr to gN/m2/day
2690	N_input(:,:,:,iammonium)=N_input(:,:,:,iammonium)/1000/one_year
2691	N_input(:,:,:,initrate)=N_input(:,:,:,initrate)/1000/one_year
2692	ENDIF
2693	ELSE
2694	!Config Key = NAMMONIUM
2695	!Config Desc = Amount of N ammonium deposition
2696	!Config Def = 0
2697	!Config If = ok_ncycle .AND. (.NOT. impose_cn)
2698	!Config Help =
2699	!Config Units = [gN m-2 d-1]
2700	nammonium=zero
2701	CALL getin_p('NAMMONIUM',nammonium)
2702	n_input(:,:,:,iammonium)=nammonium
2703	!Config Key = NNITRATE
2704	!Config Desc = Amount of N nitrate deposition
2705	!Config Def = 0
2706	!Config If = ok_ncycle .AND. (.NOT. impose_cn)
2707	!Config Help =
2708	!Config Units = [gN m-2 d-1]
2709	nnitrate=zero
2710	CALL getin_p ('NNITRATE',nnitrate)
2711	n_input(:,:,:,initrate)=nnitrate
2712	ENDIF
2713
2714
2715	IF(.NOT. impose_Ninput_fert) THEN
2716	FOUND_RESTART=.TRUE.
2717
2718	CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
2719	CALL ioconf_setatt_p('LONG_NAME','N fertilizer')
2720	CALL restget_p (rest_id, 'Nfert', nbp_glo, nvm, 12, kjit, .TRUE., N_input(:,:,:,ifert), "gather", nbp_glo, index_g)
2721	IF ( ALL( N_input(:,:,:,ifert) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
2722
2723	IF(.NOT. FOUND_RESTART) THEN
2724	! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
2725	fieldname='Nfert'
2726	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2727	N_input_temp, Ninput_year)
2728	! Conversion from gN/m2(cropland)/yr to gN/m2/day
2729	N_input(:,:,:,ifert) = N_input_temp(:,:,:)/one_year
2730
2731	fieldname='Nfert_cropland'
2732	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2733	N_input_temp, Ninput_year)
2734	! Conversion from gN/m2(cropland)/yr to gN/m2/day
2735	N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/one_year
2736
2737	fieldname='Nfert_pasture'
2738	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2739	N_input_temp, Ninput_year)
2740	! Conversion from gN/m2(pasture)/yr to gN/m2/day
2741	N_input(:,:,:,ifert) = N_input(:,:,:,ifert)+ N_input_temp(:,:,:)/one_year
2742	ENDIF
2743	ELSE
2744	!Config Key = NFERT
2745	!Config Desc = Amount of N fertiliser
2746	!Config Def = 0
2747	!Config If = ok_ncycle .AND. (.NOT. impose_cn)
2748	!Config Help =
2749	!Config Units = [gN m-2 d-1]
2750	nfert=zero
2751	CALL getin_p ('NFERT',nfert)
2752	n_input(:,:,:,ifert)=nfert
2753	ENDIF
2754
2755
2756	IF(.NOT. impose_Ninput_manure) THEN
2757	FOUND_RESTART=.TRUE.
2758
2759	CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
2760	CALL ioconf_setatt_p('LONG_NAME','N manure')
2761	CALL restget_p (rest_id, 'Nmanure', nbp_glo, nvm, 12, kjit, .TRUE., N_input(:,:,:,imanure), "gather", nbp_glo, index_g)
2762	IF ( ALL( N_input(:,:,:,imanure) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
2763
2764
2765	IF(.NOT. FOUND_RESTART) THEN
2766	! Read the new N inputs from file. Output is Ninput and frac_nobio_nextyear.
2767	N_input(:,:,:,imanure) = zero
2768	fieldname='Nmanure_cropland'
2769	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2770	N_input_temp, Ninput_year)
2771	! Conversion from gN/m2(cropland)/yr to gN/m2/day
2772	N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/one_year
2773
2774	fieldname='Nmanure_pasture'
2775	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2776	N_input_temp, Ninput_year)
2777	! Conversion from gN/m2(cropland)/yr to gN/m2/day
2778	N_input(:,:,:,imanure) = N_input(:,:,:,imanure)+N_input_temp(:,:,:)/one_year
2779	ENDIF
2780	ELSE
2781	!Config Key = NMANURE
2782	!Config Desc = Amount of N manure
2783	!Config Def = 0
2784	!Config If = ok_ncycle .AND. (.NOT. impose_cn)
2785	!Config Help =
2786	!Config Units = [gN m-2 d-1]
2787	nmanure=zero
2788	CALL getin_p ('NMANURE',nmanure)
2789	n_input(:,:,:,imanure)=nmanure
2790	ENDIF
2791
2792
2793
2794	IF(.NOT. impose_Ninput_bnf) THEN
2795	FOUND_RESTART=.TRUE.
2796	CALL ioconf_setatt_p('UNITS', 'kgN m-2 yr-1')
2797	CALL ioconf_setatt_p('LONG_NAME','N bilogical fixation')
2798	CALL restget_p (rest_id, 'Nbnf', nbp_glo, nvm, 12, kjit, .TRUE., N_input(:,:,:,ibnf), "gather", nbp_glo, index_g)
2799	IF ( ALL( N_input(:,:,:,ibnf) .EQ. val_exp ) ) FOUND_RESTART=.FALSE.
2800
2801	IF(.NOT. FOUND_RESTART) THEN
2802	fieldname='Nbnf'
2803	CALL slowproc_Ninput(kjpindex, lalo, neighbours, resolution, contfrac, fieldname, &
2804	N_input(:,:,:,ibnf), Ninput_year)
2805
2806	! Conversion from kgN/km2/yr to gN/m2/day
2807	N_input(:,:,:,ibnf) = N_input(:,:,:,ibnf)/1000./one_year
2808	ENDIF
2809	ELSE
2810	!Config Key = NBNF
2811	!Config Desc = Amount of N biological fixation
2812	!Config Def = 0
2813	!Config If = ok_ncycle .AND. (.NOT. impose_cn)
2814	!Config Help =
2815	!Config Units = [gN m-2 d-1]
2816	nbnf=zero
2817	CALL getin_p ('NBNF',nbnf)
2818	n_input(:,:,:,ibnf)=nbnf
2819	ENDIF
2820	ELSE
2821	n_input(:,:,:,:)=zero
2822	ENDIF
2823
2824	!! Calculate fraction of landuse tiles to be used only for diagnostic variables
2825	fraclut(:,:)=0
2826	nwdFraclut(:,id_psl)=0
2827	nwdFraclut(:,id_crp)=1.
2828	nwdFraclut(:,id_urb)=xios_default_val
2829	nwdFraclut(:,id_pst)=xios_default_val
2830	DO jv=1,nvm
2831	IF (natural(jv)) THEN
2832	fraclut(:,id_psl) = fraclut(:,id_psl) + veget_max(:,jv)
2833	IF(.NOT. is_tree(jv)) THEN
2834	nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl) + veget_max(:,jv)
2835	ENDIF
2836	ELSE
2837	fraclut(:,id_crp) = fraclut(:,id_crp) + veget_max(:,jv)
2838	ENDIF
2839	END DO
2840
2841	WHERE (fraclut(:,id_psl) > min_sechiba)
2842	nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl)/fraclut(:,id_psl)
2843	ELSEWHERE
2844	nwdFraclut(:,id_psl) = xios_default_val
2845	END WHERE
2846
2847
2848	IF (printlev_loc>=3) WRITE (numout,*) ' slowproc_init done '
2849
2850	END SUBROUTINE slowproc_init
2851
2852	!! ================================================================================================================================
2853	!! SUBROUTINE : slowproc_clear
2854	!!
2855	!>\BRIEF Clear all variables related to slowproc and stomate modules
2856	!!
2857	!_ ================================================================================================================================
2858
2859	SUBROUTINE slowproc_clear
2860
2861	! 1 clear all the variables defined as common for the routines in slowproc
2862
2863	IF (ALLOCATED (clayfraction)) DEALLOCATE (clayfraction)
2864	IF (ALLOCATED (sandfraction)) DEALLOCATE (sandfraction)
2865	IF (ALLOCATED (siltfraction)) DEALLOCATE (siltfraction)
2866	IF (ALLOCATED (bulk)) DEALLOCATE (bulk)
2867	IF (ALLOCATED (soil_ph)) DEALLOCATE (soil_ph)
2868	IF (ALLOCATED (cc_biomass_m)) DEALLOCATE (cc_biomass_m)
2869	IF (ALLOCATED (cc_n_m)) DEALLOCATE (cc_n_m)
2870
2871	! 2. Clear all the variables in stomate
2872
2873	CALL stomate_clear
2874	!
2875	END SUBROUTINE slowproc_clear
2876
2877	!!$!! ================================================================================================================================
2878	!!$!! SUBROUTINE : slowproc_derivvar
2879	!!$!!
2880	!!$!>\BRIEF Initializes variables related to the
2881	!!$!! parameters to be assimilated, the maximum water on vegetation, the vegetation height,
2882	!!$!! and the fraction of soil covered by dead leaves and the vegetation height
2883	!!$!!
2884	!!$!! DESCRIPTION : (definitions, functional, design, flags):
2885	!!$!! (1) Initialization of the variables relevant for the assimilation parameters
2886	!!$!! (2) Intialization of the fraction of soil covered by dead leaves
2887	!!$!! (3) Initialization of the Vegetation height per PFT
2888	!!$!! (3) Initialization the maximum water on vegetation for interception with a particular treatement of the PFT no.1
2889	!!$!!
2890	!!$!! RECENT CHANGE(S): None
2891	!!$!!
2892	!!$!! MAIN OUTPUT VARIABLE(S): ::qsintmax, ::deadleaf_cover, ::height
2893	!!$!!
2894	!!$!! REFERENCE(S) : None
2895	!!$!!
2896	!!$!! FLOWCHART : None
2897	!!$!! \n
2898	!!$!_ ================================================================================================================================
2899	!!$
2900	!!$ SUBROUTINE slowproc_derivvar (kjpindex, veget, circ_class_biomass,circ_class_n, &
2901	!!$ qsintmax, deadleaf_cover, height, temp_growth)
2902	!!$
2903	!!$ !! INTERFACE DESCRIPTION
2904	!!$
2905	!!$ !! 0.1 Input scalar and fields
2906	!!$ INTEGER(i_std),INTENT (in) :: kjpindex !! Domain size - terrestrial pixels only
2907	!!$ REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in) :: veget !! Fraction of pixel covered by PFT in the mesh (unitless)
2908	!!$ !! 0.2. Output scalar and fields
2909	!!$ REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: qsintmax !! Maximum water on vegetation for interception(mm)
2910	!!$ REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: deadleaf_cover !! fraction of soil covered by dead leaves (unitless)
2911	!!$ REAL(r_std),DIMENSION (:,:,:,:,:), INTENT (inout) :: circ_class_biomass
2912	!!$ REAL(r_std),DIMENSION (:,:,:), INTENT (inout) :: circ_class_n
2913	!!$ REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (out) :: height !! height of the vegetation or surface in general ??? (m)
2914	!!$ REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: temp_growth !! growth temperature (Â°C)
2915	!!$ !
2916	!!$ !! 0.3 Local declaration
2917	!!$ REAL(r_std),DIMENSION (kjpindex,nvm) :: lai !! PFT leaf area index (m^{2} m^{-2})
2918	!!$ INTEGER(i_std) :: ji, jv !! Local indices
2919	!!$!_ ================================================================================================================================
2920	!!$
2921	!!$ !! 1. Intialize the fraction of soil covered by dead leaves
2922	!!$ deadleaf_cover(:) = zero
2923	!!$
2924	!!$ !! 2. Initialize vegetation height and LAI per PFT
2925	!!$ height(:,1) = zero
2926	!!$ lai(:,ibare_sechiba) = zero
2927	!!$ DO jv = 1, nvm
2928	!!$ DO ji = 1, kjpindex
2929	!!$ height(:,jv) = wood_to_qmheight(circ_class_biomass(ji,jv,:,:,icarbon, &
2930	!!$ circ_class_n(ji,jv,:),jv)
2931	!!$ lai(ji,jv) = cc_to_lai(circ_class_biomass(ji,jv,:,ileaf,icarbon),&
2932	!!$ circ_class_n(ji,jv,:),jv)
2933	!!$ ENDDO
2934	!!$ ENDDO
2935	!!$
2936	!!$ !! 3. Initialize the maximum water on vegetation for interception
2937	!!$ qsintmax(:,:) = qsintcst * veget(:,:) * lai(:,:)
2938	!!$ qsintmax(:,1) = zero
2939	!!$
2940	!!$ !! 4. Initialize the growth temperature
2941	!!$ temp_growth(:)=25.
2942	!!$
2943	!!$ END SUBROUTINE slowproc_derivvar
2944
2945
2946	!! ================================================================================================================================
2947	!! SUBROUTINE : slowproc_mean
2948	!!
2949	!>\BRIEF Accumulates field_in over a period of dt_tot.
2950	!! Has to be called at every time step (dt).
2951	!! Mean value is calculated if ldmean=.TRUE.
2952	!! field_mean must be initialized outside of this routine!
2953	!!
2954	!! DESCRIPTION : (definitions, functional, design, flags):
2955	!! (1) AcumAcuumlm
2956	!!
2957	!! RECENT CHANGE(S): None
2958	!!
2959	!! MAIN OUTPUT VARIABLE(S): ::field_main
2960	!!
2961	!! REFERENCE(S) : None
2962	!!
2963	!! FLOWCHART : None
2964	!! \n
2965	!_ ================================================================================================================================
2966
2967	SUBROUTINE slowproc_mean (kjpindex, n_dim2, dt_tot, dt, ldmean, field_in, field_mean)
2968
2969	!
2970	!! 0 declarations
2971
2972	!! 0.1 input scalar and variables
2973	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size- terrestrial pixels only
2974	INTEGER(i_std), INTENT(in) :: n_dim2 !! Number of PFTs
2975	REAL(r_std), INTENT(in) :: dt_tot !! Time step of stomate (in days). The period over which the accumulation or the mean is computed
2976	REAL(r_std), INTENT(in) :: dt !! Time step in days
2977	LOGICAL, INTENT(in) :: ldmean !! Flag to calculate the mean after the accumulation ???
2978	REAL(r_std), DIMENSION(kjpindex,n_dim2), INTENT(in) :: field_in !! Daily field
2979
2980	!! 0.3 Modified field; The computed sum or mean field over dt_tot time period depending on the flag ldmean
2981	REAL(r_std), DIMENSION(kjpindex,n_dim2), INTENT(inout) :: field_mean !! Accumulated field at dt_tot time period or mean field over dt_tot
2982
2983
2984	!_ ================================================================================================================================
2985
2986	!
2987	! 1. Accumulation the field over dt_tot period
2988	!
2989	field_mean(:,:) = field_mean(:,:) + field_in(:,:) * dt
2990
2991	!
2992	! 2. If the flag ldmean set, the mean field is computed over dt_tot period
2993	!
2994	IF (ldmean) THEN
2995	field_mean(:,:) = field_mean(:,:) / dt_tot
2996	ENDIF
2997
2998	END SUBROUTINE slowproc_mean
2999
3000
3001
3002	!! ================================================================================================================================
3003	!! SUBROUTINE : slowproc_long
3004	!!
3005	!>\BRIEF Calculates a temporally smoothed field (field_long) from
3006	!! instantaneous input fields.Time constant tau determines the strength of the smoothing.
3007	!! For tau -> infinity??, field_long becomes the true mean value of field_inst
3008	!! (but the spinup becomes infinietly long, too).
3009	!! field_long must be initialized outside of this routine!
3010	!!
3011	!! DESCRIPTION : (definitions, functional, design, flags):
3012	!! (1) Testing the time coherence betwen the time step dt and the time tau over which
3013	!! the rescaled of the mean is performed
3014	!! (2) Computing the rescaled mean over tau period
3015	!! MAIN OUTPUT VARIABLE(S): field_long
3016	!!
3017	!! RECENT CHANGE(S): None
3018	!!
3019	!! MAIN OUTPUT VARIABLE(S): ::field_long
3020	!!
3021	!! REFERENCE(S) : None
3022	!!
3023	!! FLOWCHART : None
3024	!! \n
3025	!_ ================================================================================================================================
3026
3027	SUBROUTINE slowproc_long (kjpindex, n_dim2, dt, tau, field_inst, field_long)
3028
3029	!
3030	! 0 declarations
3031	!
3032
3033	! 0.1 input scalar and fields
3034
3035	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size- terrestrial pixels only
3036	INTEGER(i_std), INTENT(in) :: n_dim2 !! Second dimension of the fields, which represents the number of PFTs
3037	REAL(r_std), INTENT(in) :: dt !! Time step in days
3038	REAL(r_std), INTENT(in) :: tau !! Integration time constant (has to have same unit as dt!)
3039	REAL(r_std), DIMENSION(kjpindex,n_dim2), INTENT(in) :: field_inst !! Instantaneous field
3040
3041
3042	! 0.2 modified field
3043
3044	! Long-term field
3045	REAL(r_std), DIMENSION(kjpindex,n_dim2), INTENT(inout) :: field_long !! Mean value of the instantaneous field rescaled at tau time period
3046
3047	!_ ================================================================================================================================
3048
3049	!
3050	! 1 test coherence of the time
3051
3052	IF ( ( tau .LT. dt ) .OR. ( dt .LE. zero ) .OR. ( tau .LE. zero ) ) THEN
3053	WRITE(numout,*) 'slowproc_long: Problem with time steps'
3054	WRITE(numout,*) 'dt=',dt
3055	WRITE(numout,*) 'tau=',tau
3056	ENDIF
3057
3058	!
3059	! 2 integration of the field over tau
3060
3061	field_long(:,:) = ( field_inst(:,:)dt + field_long(:,:)(tau-dt) ) / tau
3062
3063	END SUBROUTINE slowproc_long
3064
3065
3066	!! ================================================================================================================================
3067	!! SUBROUTINE : slowproc_canopy
3068	!!
3069	!>\BRIEF Convert circ_class_biomass and circ_class_n in a 3D canopy used
3070	!! in the albedo, transpiration and energy budget calculations
3071	!!
3072	!! DESCRIPTION :
3073	!!
3074	!! RECENT CHANGE(S): None
3075	!!
3076	!! MAIN OUTPUT VARIABLE(S): ::lai_per_level, ::z_array_out,
3077	!! ::max_height_store, ::laieff_fit, ::frac_age
3078	!!
3079	!! REFERENCE(S) : None
3080	!!
3081	!! FLOWCHART : None
3082	!! \n
3083	!_ ================================================================================================================================
3084
3085	SUBROUTINE slowproc_canopy(kjpindex, circ_class_biomass, circ_class_n, &
3086	veget_max, lai_per_level, z_array_out, &
3087	max_height_store, laieff_fit, frac_age)
3088	!
3089	! 0. Declarations
3090	!
3091	!! 0.1 Input variables
3092	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only
3093	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass !! Biomass of the different components per
3094	!! PFT and circ class (g C(N) tree-1 y-1)
3095	REAL(r_std), DIMENSION(:,:,:), INTENT(in) :: circ_class_n !! Number of trees per circ_class (trees m-2)
3096	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in) :: veget_max !! Maximum fraction of vegetation type including
3097	!! none biological fraction (unitless)
3098
3099	!! 0.2 Modified variables
3100
3101	!! 0.3 Output
3102	REAL(r_std), DIMENSION(:,:,:), INTENT(out) :: lai_per_level !! This is the LAI per vertical level
3103	!! @tex $(m^{2} m^{-2})$
3104	REAL(r_std),DIMENSION(kjpindex,nvm,ncirc,nlevels_tot), INTENT(out) &
3105	:: z_array_out !! Height above soil of the Pgap points.
3106	!! @tex $(m)$ @endtex
3107	REAL(r_std), DIMENSION(kjpindex, nvm), INTENT(out) :: max_height_store !! ???
3108	TYPE(laieff_type),DIMENSION (:,:,:),INTENT(out) :: laieff_fit !! Fitted parameters for the effective LAI
3109	REAL(r_std),DIMENSION(kjpindex,nvm,nleafages),INTENT(out) &
3110	:: frac_age !! leaf age distribution calculated in stomate
3111
3112	!! 0.4 Local
3113	REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot) :: z_level_photo !! The height of the levels that we will
3114	!! use to calculate the effective LAI for
3115	!! the albedo routines and photosynthesis.
3116	!! @tex $(m)$ @endtex
3117
3118	INTEGER(i_std) :: ji, jv, icir !! Indices
3119
3120	!_ ================================================================================================================================
3121
3122	!! 1. Calculate canopy structure
3123	! Compute the height of the photosynthesis levels given the height
3124	! of the energy levels and the vegetation on the grid square. The
3125	! hightest levels will be a function of the height of the vegetation
3126	! so that we don't waste computational time on empty levels.
3127	CALL calculate_z_level_photo(kjpindex, circ_class_biomass, circ_class_n, &
3128	z_level_photo)
3129
3130	! Finding the true LAI per level is different from finding the
3131	! effective LAI per level, so we'll do that here. This only
3132	! changes once every day so hopefully it is not too expensive.
3133	! It will eventually be needed by the energy budget. It is
3134	! also needed by effective_lai for grasses and crops.
3135	CALL find_lai_per_level(kjpindex, z_level_photo, &
3136	circ_class_biomass, circ_class_n, lai_per_level, &
3137	max_height_store)
3138
3139	! Change the dimensions of z_level_photo so it can be used in
3140	! sechiba, mleb, and fitting_laieff
3141	DO icir = 1,ncirc
3142	z_array_out(:,:,icir,:) = z_level_photo(:,:,:)
3143	END DO
3144
3145	! Now we actually find the effective LAI and fit the function
3146	! we'll use later on. Note that this fir allows us to calculate
3147	! the effective lai once per day. This should not be repeated
3148	! every half hour!
3149	CALL fitting_laieff(kjpindex, z_array_out, circ_class_biomass, &
3150	circ_class_n, veget_max, lai_per_level, laieff_fit)
3151
3152
3153	!! 2. Calculate frac_age
3154	! The variable frac_age is only used when BVOCs are calculated.
3155	! slowproc_canopy should only be used when only sechiba is used.
3156	frac_age(:,:,1) = un
3157	frac_age(:,:,2) = zero
3158	frac_age(:,:,3) = zero
3159	frac_age(:,:,4) = zero
3160
3161	WRITE(numout,*) 'Leaving slowproc_canopy'
3162
3163	END SUBROUTINE slowproc_canopy
3164
3165
3166	!! ================================================================================================================================
3167	!! SUBROUTINE : slowproc_veget
3168	!!
3169	!>\BRIEF Calucate veget and soiltile.
3170	!!
3171	!! DESCRIPTION : Calucate veget and soiltile.
3172	!! (1) Calculate veget
3173	!! (2) Calculate totfrac_nobio
3174	!! (3) Calculate soiltile
3175	!! (4) Calculate fraclut
3176	!!
3177	!! RECENT CHANGE(S):
3178	!! Slowproc_veget is called four times in slowproc: (1) after reading and cleaning the
3179	!! land cover map in slowproc. There is no reason to do these tests again as they
3180	!! were just done in the code prior to this call. (2) during the initialization.
3181	!! veget_max should is either read from a file (and thus error checked) or comes
3182	!! from a restart file and was error checked earlier. (3) After the call to stomate
3183	!! main. In stomate veget_max may change after LCC. Sapiens_lcchange avoids too
3184	!! small changes. No need to check again. (4) slowproc_change_frac calls slowproc_veget.
3185	!! slowproc_change_frac is called once in sechiba_main after slowproc_main (and thus
3186	!! indirectly after sapiens_lcchange.f90). The fraction should have been taken care of
3187	!! sapiens_lcchange.f90.
3188	!! Keeping that code is a perfect way to create undetectable mass balance problems
3189	!! because: (1) mass balance closure is not checked in slowproc and sechiba yet and
3190	!! (2) these PFTs contain carbon and nitrogen. Simply truncating and normalizing
3191	!! their cover fractions should result in mass balance problems. By removing the
3192	!! code below, changes in veget_max occur right after reading the maps (and thus
3193	!! before the PFT is getting a biomass) or in sapiens_lcchange where changes in
3194	!! cover fractions are correctly accounted for and mass balance closure is checked.
3195	!! In the trunk slowproc_veget_max_limit contains the code that has been commented out
3196	!! in this version. When merging do not accept this code or add a mass balance check
3197	!! over slowproc and sechiba.
3198	!!
3199	!! MAIN OUTPUT VARIABLE(S): :: frac_nobio, totfrac_nobio, veget_max, veget, soiltile, fraclut
3200	!!
3201	!! REFERENCE(S) : None
3202	!!
3203	!! FLOWCHART : None
3204	!! \n
3205	!_ ================================================================================================================================
3206
3207	SUBROUTINE slowproc_veget (kjpindex, lai_per_level, z_array_out, &
3208	coszang_noon, circ_class_biomass, circ_class_n, frac_nobio, totfrac_nobio, &
3209	veget_max, veget, soiltile, tot_bare_soil, fraclut, nwdFraclut, Pgap_cumul)
3210
3211	!! 0.1 Input variables
3212	INTEGER(i_std), INTENT(in) :: kjpindex !! Domain size - terrestrial pixels only
3213	REAL(r_std), DIMENSION(:,:,:), INTENT(in) :: lai_per_level !! This is the LAI per vertical level
3214	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in) :: circ_class_biomass !! Biomass of the different components per
3215	!! PFT and circ class (g C(N) tree-1 y-1)
3216	REAL(r_std), DIMENSION(:,:,:), INTENT(in) :: circ_class_n !! Number of trees per circ_class (trees m-2) !! @tex $(m^{2} m^{-2})$
3217	REAL(r_std), DIMENSION(:,:), INTENT(in) :: frac_nobio !! Fraction of the mesh which is covered by ice, lakes, ...
3218	REAL(r_std), DIMENSION(:,:), INTENT(in) :: veget_max !! Maximum fraction of vegetation type including
3219	!! none biological fraction (unitless)
3220	REAL(r_std), DIMENSION(:,:,:,:), INTENT(in) :: z_array_out !! The physical height of the levels used in the
3221	!! effective LAI routines @tex $(m)$
3222	REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: coszang_noon !! The cosine of the solar zenith angle at noon
3223
3224
3225	!! 0.2 Output variables
3226	REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out) :: veget !! Fraction of pixel covered by PFT in the mesh (unitless)
3227	REAL(r_std),DIMENSION (kjpindex), INTENT (out) :: totfrac_nobio
3228	REAL(r_std), DIMENSION (kjpindex,nstm), INTENT(out) :: soiltile !! Fraction of each soil tile within vegtot (0-1, unitless)
3229	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out) :: fraclut !! Fraction of each landuse tile (0-1, unitless)
3230	REAL(r_std), DIMENSION (kjpindex,nlut), INTENT(out) :: nwdFraclut !! Fraction of non-woody vegetation in each landuse tile (0-1, unitless)
3231	REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot), INTENT(out) :: Pgap_cumul !! The probability of finding a gap in the in canopy from the top
3232	!! of the canopy to a given level (unitless, between 0-1)
3233
3234	!! 0.3 Modified variables
3235	REAL(r_std),DIMENSION(:), INTENT (inout) :: tot_bare_soil !! Total evaporating bare soil fraction
3236
3237	!! 0.4 Local scalar and varaiables
3238	INTEGER(i_std) :: ilev, ji, jv !! Indices
3239	INTEGER(i_std) :: jst, ivm !! Indices
3240	REAL(r_std), DIMENSION(nlevels_tot,kjpindex,nvm) :: laieff_temp !! The effective LAI. Not used here, just need it as an
3241	!! argument in this routine.
3242	REAL(r_std), DIMENSION(kjpindex,nvm,1) :: lai_per_level_temp !! The total LAI found for the PFT and grid square.
3243	REAL(r_std),DIMENSION(kjpindex,nvm,nlevels_tot) :: z_array4 !! Same as z_array, but one less dimension.
3244	!! @tex $(m)$ @endtex (local because the call to
3245	!! effective_lai requires it)
3246	REAL(r_std), DIMENSION(kjpindex,nvm,nlevels_tot) :: z_array2_out !! Same as z_array, but one less dimension.
3247	!! @tex $(m)$ @endtex (local because the
3248	!! call to effective_lai requires it)]
3249	REAL(r_std), DIMENSION(kjpindex) :: fracsum !! Sum of both fracnobio and veget_max
3250
3251	!_ ================================================================================================================================
3252
3253	IF(printlev_loc>=4) WRITE(numout,*) 'Entering slowproc_veget'
3254
3255
3256	!! 4. Calculate veget making use of the canopy structure
3257	! Determine the coverage based on stand structure and LAI. There
3258	! should always be trees in the model even if we only run sechiba.
3259	! The veget should be related to the effective LAI if you are looking
3260	! straight down on the canopy. So let us use the same routine
3261	! that we use for the effective LAI but put the solar angle equal to
3262	! the zenith, zero degrees. We use the light that reaches the forest
3263	! floor in the calculation of veget. For some applications, i.e.,
3264	! recruitment it would be better to use the solar angle at noon, but
3265	! for turbulence-related and precipitation-related application zenith
3266	! is preferred. To avoid having different Pgaps we use zenith.
3267	veget(:,:) = zero
3268	CALL effective_lai(kjpindex, nlevels_tot, z_array_out, circ_class_biomass, &
3269	circ_class_n, veget_max, coszang_noon, lai_per_level, &
3270	laieff_temp, Pgap_cumul_out=Pgap_cumul)
3271
3272	! Now convert the transmission probability (1, light makes it through
3273	! without hitting anything) to veget (1*veget_max, the canopy is
3274	! completely opaque).
3275	DO ivm=1,nvm
3276
3277	! We don't want to overwrite the bare soil value, since that
3278	! means something different than the other values.
3279	IF(ivm == ibare_sechiba) THEN
3280	! Calculate veget
3281	veget(:,ibare_sechiba)=zero
3282	ELSE
3283	IF (hack_pgap) THEN
3284	! Note that the exctinction coefficient for calculating veget
3285	! was set to 1.0. Use the old approach following Lambert-Beer
3286	veget(:,ivm) = veget_max(:,ivm)(un-exp(-SUM(lai_per_level(:,ivm,:),2)1.0))
3287	ELSE
3288	! Use the new approach based on Pgap
3289	veget(:,ivm)=veget_max(:,ivm)*(un-Pgap_cumul(:,ivm,1))
3290	END IF
3291	ENDIF
3292
3293	ENDDO
3294
3295	!! 6. Calculate totfrac_nobio and tot_bare_soil making use of veget
3296	IF (ok_bare_soil_new) THEN
3297
3298	!+++CHECK+++
3299	! We no longer want to treat the gaps in the canopy as
3300	! bare soil. It needs to be tested what will happen with
3301	! the evaporation in the single-layer model. The multi-
3302	! layer energy budget should be able to correctly deal
3303	! with the gaps in the canopy.
3304	tot_bare_soil(:) = veget_max(:,1)
3305
3306	! Total frac nobio
3307	totfrac_nobio(:) = SUM(frac_nobio(:,:),2)
3308	!+++++++++++
3309
3310	ELSE
3311
3312	! Initialize
3313	fracsum(:) = zero
3314	tot_bare_soil(:) = veget_max(:,1)
3315
3316	! Calculate bare soil fraction
3317	DO ji = 1, kjpindex
3318
3319	! Total frac nobio
3320	totfrac_nobio(ji) = SUM(frac_nobio(ji,:))
3321
3322	DO jv = 2, nvm
3323
3324	! Move the canopy gaps into the bare soil
3325	! fraction for this time step. Calculate
3326	! the total fraction of bare soil in the
3327	! grid
3328	tot_bare_soil(ji) = tot_bare_soil(ji) + &
3329	(veget_max(ji,jv) - veget(ji,jv))
3330	fracsum(ji) = fracsum(ji) + veget(ji,jv)
3331
3332	ENDDO
3333
3334	! Consistency check
3335	fracsum(ji) = fracsum(ji) + tot_bare_soil(ji) + SUM(frac_nobio(ji,:))
3336	IF (fracsum(ji) .LT. 0.99999) THEN
3337	WRITE(numout,*)' ATTENTION, in ji, fracsum LT 1: ', ji, fracsum(ji)
3338	WRITE(numout,*)' frac_nobio = ',SUM(frac_nobio(ji,:))
3339	WRITE(numout,*)' veget = ',SUM(veget(ji,:))
3340	WRITE(numout,*)' veget_max = ',SUM(veget_max(ji,:))
3341	WRITE(numout,*)' tot_bare_soil = ',tot_bare_soil(ji)
3342	ENDIF
3343	ENDDO
3344
3345	ENDIF ! ok_bare_soil_new
3346
3347	!! 4. Calculate soiltiles
3348	! Soiltiles are only used in hydrol, but we fix them in here because some time
3349	! it might depend on a changing vegetation (but then some adaptation should be
3350	! made to hydrol) and be also used in the other modules to perform separated
3351	! energy balances. The sum of all soiltiles makes one, and corresponds to the
3352	! bio fraction of the grid cell (called vegtot in hydrol).
3353	soiltile(:,:) = zero
3354	DO jv = 1, nvm
3355	jst = pref_soil_veg(jv)
3356	DO ji = 1, kjpindex
3357	soiltile(ji,jst) = soiltile(ji,jst) + veget_max(ji,jv)
3358	ENDDO
3359	ENDDO
3360
3361	DO ji = 1, kjpindex
3362	IF (totfrac_nobio(ji) .LT. (1-EPSILON(un))) THEN
3363	! If the calculation of 1-totfrac_nobio is correct its value
3364	! should be identical to SUM(soiltile) give or take precision
3365	! issues.
3366	IF (ABS(SUM(soiltile(ji,:))-(1-totfrac_nobio(ji))).LT.min_sechiba) THEN
3367	! If the numbers are very similar, the divsion may result in
3368	! errors of 10e-10. By taking the minimum we protect against
3369	! such conditions. Note that the new notation is expected
3370	! to be a bit more precise than the old notation. It probably
3371	! doesn really matter but it may help to increase surface
3372	! balance closure at 10e-13 or better.
3373	!!$ soiltile(ji,:)=MIN(soiltile(ji,:)/(1.-totfrac_nobio(ji)),un)
3374	soiltile(ji,:)=MIN(soiltile(ji,:)/SUM(soiltile(ji,:)),un)
3375	ELSE
3376	! Mismatch between SUM(soiltile) and 1-totfrac_nobio.
3377	WRITE(numout,*) 'kjpindex, totfrac_nobio, soiltile, ', &
3378	ji, totfrac_nobio(ji), SUM(soiltile(ji,:))
3379	CALL ipslerr_p (3,'slowproc_main',&
3380	'Mismatch between SUM(soiltile) and 1-totfrac_nobio','','')
3381	ENDIF
3382	ELSE
3383	soiltile(ji,:)=zero
3384	ENDIF
3385	ENDDO
3386
3387	!! 5. Calculate fraction of landuse tiles to be used only for diagnostic variables
3388	fraclut(:,:)=0
3389	nwdFraclut(:,id_psl)=0
3390	nwdFraclut(:,id_crp)=1.
3391	nwdFraclut(:,id_urb)=xios_default_val
3392	nwdFraclut(:,id_pst)=xios_default_val
3393	DO jv=1,nvm
3394	IF (natural(jv)) THEN
3395	fraclut(:,id_psl) = fraclut(:,id_psl) + veget_max(:,jv)
3396	IF(.NOT. is_tree(jv)) THEN
3397	nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl) + veget_max(:,jv)
3398	ENDIF
3399	ELSE
3400	fraclut(:,id_crp) = fraclut(:,id_crp) + veget_max(:,jv)
3401	ENDIF
3402	END DO
3403
3404
3405	WHERE (fraclut(:,id_psl) > min_sechiba)
3406	nwdFraclut(:,id_psl) = nwdFraclut(:,id_psl)/fraclut(:,id_psl)
3407	ELSEWHERE
3408	nwdFraclut(:,id_psl) = xios_default_val
3409	END WHERE
3410
3411	END SUBROUTINE slowproc_veget
3412
3413
3414	!! ================================================================================================================================
3415	!! SUBROUTINE : slowproc_interlai
3416
3417	! Read an LAI map. In ORCHIDEE-CN-CAN lai is no longer passed from one
3418	! routine to another but more importantly it changed from a 1-D to a 3-D
3419	! variable. Reading, e.g. MODIS LAI, and using that information to force
3420	! ORCHIDEE-CN-CAN would first require to downscale the observed pixel-level
3421	! LAI into PFT-level LAI. Subsequently, assumptions should be made to
3422	! convert the 1-D LAI into circ_class_biomass and circ_class_n which in
3423	! turn are used to calculate a 3-D canopy structure that is used in the
3424	! laieff calculation to calculate a 1-D effective LAI. The 1-D MODIS LAI
3425	! cannot be assumed to be the same as the 1-D effective LAI. What was
3426	! previously known as read_lai and laimap has therefore been replaces by
3427	! code that reads a file containing circ_class_biomass and circ_class_n.
3428
3429	SUBROUTINE slowproc_interlai(nbpt, lalo, resolution, neighbours, contfrac, laimap)
3430
3431	USE interpweight
3432
3433	IMPLICIT NONE
3434
3435	!
3436	!
3437	!
3438	! 0.1 INPUT
3439	!
3440	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs to be interpolated
3441	REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes
3442	!! (beware of the order = 1 : latitude, 2 : longitude)
3443	REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size in km of each grid-box in X and Y
3444	INTEGER(i_std), INTENT(in) :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point
3445	!! (1=North and then clockwise)
3446	REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box.
3447	!
3448	! 0.2 OUTPUT
3449	!
3450	REAL(r_std), INTENT(out) :: laimap(nbpt,nvm,12) !! lai read variable and re-dimensioned
3451	!
3452	! 0.3 LOCAL
3453	!
3454	CHARACTER(LEN=80) :: filename !! name of the LAI map read
3455	INTEGER(i_std) :: ib, ip, jp, it, jv
3456	REAL(r_std) :: lmax, lmin, ldelta
3457	LOGICAL :: renormelize_lai ! flag to force LAI renormelization
3458	INTEGER :: ier
3459
3460	REAL(r_std), DIMENSION(nbpt) :: alaimap !! availability of the lai interpolation
3461	INTEGER, DIMENSION(4) :: invardims
3462	REAL(r_std), DIMENSION(nbpt,nvm,12) :: lairefrac !! lai fractions re-dimensioned
3463	REAL(r_std), DIMENSION(nbpt,nvm,12) :: fraclaiinterp !! lai fractions re-dimensioned
3464	REAL(r_std), DIMENSION(:), ALLOCATABLE :: vmin, vmax !! min/max values to use for the
3465	!! renormalization
3466	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
3467	CHARACTER(LEN=80) :: lonname, latname !! lon, lat names in input file
3468	REAL(r_std), DIMENSION(nvm) :: variabletypevals !! Values for all the types of the variable
3469	!! (variabletypevals(1) = -un, not used)
3470	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
3471	!! 'XYKindTime': Input values are kinds
3472	!! of something with a temporal
3473	!! evolution on the dx*dy matrix'
3474	LOGICAL :: nonegative !! whether negative values should be removed
3475	CHARACTER(LEN=50) :: maskingtype !! Type of masking
3476	!! 'nomask': no-mask is applied
3477	!! 'mbelow': take values below maskvals(1)
3478	!! 'mabove': take values above maskvals(1)
3479	!! 'msumrange': take values within 2 ranges;
3480	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
3481	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
3482	!! (normalized by maskvals(3))
3483	!! 'var': mask values are taken from a
3484	!! variable inside the file (>0)
3485	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
3486	!! `maskingtype')
3487	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
3488	!_ ================================================================================================================================
3489
3490	!
3491	!Config Key = LAI_FILE
3492	!Config Desc = Name of file from which the vegetation map is to be read
3493	!Config If = LAI_MAP
3494	!Config Def = lai2D.nc
3495	!Config Help = The name of the file to be opened to read the LAI
3496	!Config map is to be given here. Usualy SECHIBA runs with a 5kmx5km
3497	!Config map which is derived from a Nicolas VIOVY one.
3498	!Config Units = [FILE]
3499	!
3500	filename = 'lai2D.nc'
3501	CALL getin_p('LAI_FILE',filename)
3502	variablename = 'LAI'
3503
3504	IF (xios_interpolation) THEN
3505	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_interlai: Use XIOS to read and interpolate " &
3506	// TRIM(filename) //" for variable " //TRIM(variablename)
3507
3508	CALL xios_orchidee_recv_field('lai_interp',lairefrac)
3509	CALL xios_orchidee_recv_field('frac_lai_interp',fraclaiinterp)
3510	alaimap(:) = fraclaiinterp(:,1,1)
3511	ELSE
3512
3513	IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_interlai: Start interpolate " &
3514	// TRIM(filename) //" for variable " //TRIM(variablename)
3515
3516	! invardims: shape of variable in input file to interpolate
3517	invardims = interpweight_get_var4dims_file(filename, variablename)
3518	! Check coherence of dimensions read from the file
3519	IF (invardims(4) /= 12) CALL ipslerr_p(3,'slowproc_interlai','Wrong dimension of time dimension in input file for lai','','')
3520	IF (invardims(3) /= nvm) CALL ipslerr_p(3,'slowproc_interlai','Wrong dimension of PFT dimension in input file for lai','','')
3521
3522	ALLOCATE(vmin(nvm),stat=ier)
3523	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable vmin','','')
3524
3525	ALLOCATE(vmax(nvm), STAT=ier)
3526	IF (ier /= 0) CALL ipslerr_p(3,'slowproc_interlai','Problem in allocation of variable vmax','','')
3527
3528
3529	! Assigning values to vmin, vmax
3530	vmin = un
3531	vmax = nvm*un
3532
3533	variabletypevals = -un
3534
3535	!! Variables for interpweight
3536	! Type of calculation of cell fractions
3537	fractype = 'default'
3538	! Name of the longitude and latitude in the input file
3539	lonname = 'longitude'
3540	latname = 'latitude'
3541	! Should negative values be set to zero from input file?
3542	nonegative = .TRUE.
3543	! Type of mask to apply to the input data (see header for more details)
3544	maskingtype = 'mbelow'
3545	! Values to use for the masking
3546	maskvals = (/ 20., undef_sechiba, undef_sechiba /)
3547	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
3548	namemaskvar = ''
3549
3550	CALL interpweight_4D(nbpt, nvm, variabletypevals, lalo, resolution, neighbours, &
3551	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
3552	maskvals, namemaskvar, nvm, invardims(4), -1, fractype, &
3553	-1., -1., lairefrac, alaimap)
3554
3555	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_interlai after interpweight_4D'
3556
3557	ENDIF
3558
3559
3560
3561	!
3562	!
3563	!Config Key = RENORM_LAI
3564	!Config Desc = flag to force LAI renormelization
3565	!Config If = LAI_MAP
3566	!Config Def = n
3567	!Config Help = If true, the laimap will be renormalize between llaimin and llaimax parameters.
3568	!Config Units = [FLAG]
3569	!
3570	renormelize_lai = .FALSE.
3571	CALL getin_p('RENORM_LAI',renormelize_lai)
3572
3573	!
3574	laimap(:,:,:) = zero
3575	!
3576	IF (printlev_loc >= 5) THEN
3577	WRITE(numout,*)' slowproc_interlai before starting loop nbpt:', nbpt
3578	END IF
3579
3580	! Assigning the right values and giving a value where information was not found
3581	DO ib=1,nbpt
3582	IF (alaimap(ib) < min_sechiba) THEN
3583	DO jv=1,nvm
3584	laimap(ib,jv,:) = (llaimax(jv)+llaimin(jv))/deux
3585	ENDDO
3586	ELSE
3587	DO jv=1, nvm
3588	DO it=1, 12
3589	laimap(ib,jv,it) = lairefrac(ib,jv,it)
3590	ENDDO
3591	ENDDO
3592	END IF
3593	ENDDO
3594	!
3595	! Normelize the read LAI by the values SECHIBA is used to
3596	!
3597	IF ( renormelize_lai ) THEN
3598	DO ib=1,nbpt
3599	DO jv=1, nvm
3600	lmax = MAXVAL(laimap(ib,jv,:))
3601	lmin = MINVAL(laimap(ib,jv,:))
3602	ldelta = lmax-lmin
3603	IF ( ldelta < min_sechiba) THEN
3604	! LAI constante ... keep it constant
3605	laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)+(llaimax(jv)+llaimin(jv))/deux
3606	ELSE
3607	laimap(ib,jv,:) = (laimap(ib,jv,:)-lmin)/(lmax-lmin)*(llaimax(jv)-llaimin(jv))+llaimin(jv)
3608	ENDIF
3609	ENDDO
3610	ENDDO
3611	ENDIF
3612
3613	! Write diagnostics
3614	CALL xios_orchidee_send_field("interp_avail_alaimap",alaimap)
3615	CALL xios_orchidee_send_field("interp_diag_lai",laimap)
3616
3617	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_interlai ended'
3618
3619	END SUBROUTINE slowproc_interlai
3620
3621	!! ================================================================================================================================
3622	!! SUBROUTINE : slowproc_readvegetmax
3623	!!
3624	!>\BRIEF Read and interpolate a vegetation map (by pft)
3625	!!
3626	!! DESCRIPTION : (definitions, functional, design, flags):
3627	!!
3628	!! RECENT CHANGE(S): The subroutine was previously called slowproc_update.
3629	!!
3630	!! MAIN OUTPUT VARIABLE(S):
3631	!!
3632	!! REFERENCE(S) : None
3633	!!
3634	!! FLOWCHART : None
3635	!! \n
3636	!_ ================================================================================================================================
3637
3638	SUBROUTINE slowproc_readvegetmax(nbpt, lalo, neighbours, resolution, contfrac, veget_last_in, &
3639	veget_next_out, frac_nobio_next, init)
3640
3641	USE interpweight
3642	IMPLICIT NONE
3643
3644	!
3645	!
3646	!
3647	! 0.1 INPUT
3648	!
3649	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs
3650	!! to be interpolated
3651	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo !! Vector of latitude and longitudes (beware of the order !)
3652	INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours !! Vector of neighbours for each grid point
3653	!! (1=North and then clockwise)
3654	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution !! The size in km of each grid-box in X and Y
3655	REAL(r_std), DIMENSION(nbpt), INTENT(in) :: contfrac !! Fraction of continent in the grid
3656	!
3657	REAL(r_std), DIMENSION(nbpt,nvm), INTENT(in) :: veget_last_in !! old max vegetfrac
3658	LOGICAL, INTENT(in) :: init !! initialisation : in case of dgvm, it forces update of all PFTs
3659	!
3660	! 0.2 OUTPUT
3661	!
3662	REAL(r_std), DIMENSION(nbpt,nvm), INTENT(out) :: veget_next_out !! new max vegetfrac
3663	REAL(r_std), DIMENSION(nbpt,nnobio), INTENT(out) :: frac_nobio_next !! new fraction of the mesh which is
3664	!! covered by ice, lakes, ...
3665
3666	!
3667	! 0.3 LOCAL
3668	!
3669	!
3670	CHARACTER(LEN=80) :: filename
3671	INTEGER(i_std) :: ib, inobio, jv, ivma
3672	REAL(r_std) :: sumf, err, norm
3673	!
3674	! for DGVM case :
3675	REAL(r_std) :: sum_veg ! sum of vegets
3676	REAL(r_std) :: sum_nobio ! sum of nobios
3677	REAL(r_std) :: sumvAnthro_old, sumvAnthro ! last an new sum of antrhopic vegets
3678	REAL(r_std) :: rapport ! (S-B) / (S-A)
3679	LOGICAL :: partial_update ! if TRUE, partialy update PFT (only anthropic ones)
3680	! e.g. in case of DGVM and not init (optional parameter)
3681	REAL(r_std), DIMENSION(nbpt,nvmap) :: veget_last !! Temporary variable for veget_last_in on the same number of pfts as in the file
3682	REAL(r_std), DIMENSION(nbpt,nvmap) :: veget_next !! Temporary variable for veget_next_out on the same number of pfts as in the file
3683	REAL(r_std), DIMENSION(nbpt,nvmap) :: vegetrefrac !! veget fractions re-dimensioned
3684	REAL(r_std), DIMENSION(nbpt) :: aveget !! Availability of the soilcol interpolation
3685	REAL(r_std), DIMENSION(nbpt,nvm) :: aveget_nvm !! Availability of the soilcol interpolation
3686	REAL(r_std), DIMENSION(nvmap) :: vmin, vmax !! min/max values to use for the renormalization
3687	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
3688	CHARACTER(LEN=80) :: lonname, latname !! lon, lat names in input file
3689	REAL(r_std), DIMENSION(nvmap) :: variabletypevals !! Values for all the types of the variable
3690	!! (variabletypevals(1) = -un, not used)
3691	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
3692	!! 'XYKindTime': Input values are kinds
3693	!! of something with a temporal
3694	!! evolution on the dx*dy matrix'
3695	LOGICAL :: nonegative !! whether negative values should be removed
3696	CHARACTER(LEN=50) :: maskingtype !! Type of masking
3697	!! 'nomask': no-mask is applied
3698	!! 'mbelow': take values below maskvals(1)
3699	!! 'mabove': take values above maskvals(1)
3700	!! 'msumrange': take values within 2 ranges;
3701	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
3702	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
3703	!! (normalized by maskvals(3))
3704	!! 'var': mask values are taken from a
3705	!! variable inside the file (>0)
3706	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
3707	!! `maskingtype')
3708	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
3709	CHARACTER(LEN=250) :: msg
3710
3711	!_ ================================================================================================================================
3712
3713	IF (printlev_loc >= 5) PRINT *,' In slowproc_readvegetmax'
3714
3715	!Config Key = VEGETATION_FILE
3716	!Config Desc = Name of file from which the vegetation map is to be read
3717	!Config If =
3718	!Config Def = PFTmap.nc
3719	!Config Help = The name of the file to be opened to read a vegetation
3720	!Config map (in pft) is to be given here.
3721	!Config Units = [FILE]
3722	!
3723	filename = 'PFTmap.nc'
3724	CALL getin_p('VEGETATION_FILE',filename)
3725	variablename = 'maxvegetfrac'
3726
3727
3728	IF (xios_interpolation) THEN
3729	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readvegetmax: Use XIOS to read and interpolate " &
3730	// TRIM(filename) // " for variable " // TRIM(variablename)
3731
3732	CALL xios_orchidee_recv_field('frac_veget',vegetrefrac)
3733	CALL xios_orchidee_recv_field('frac_veget_frac',aveget_nvm)
3734	aveget(:)=aveget_nvm(:,1)
3735
3736	DO ib = 1, nbpt
3737	IF (aveget(ib) > min_sechiba) THEN
3738	vegetrefrac(ib,:) = vegetrefrac(ib,:)/aveget(ib) ! intersected area normalization
3739	vegetrefrac(ib,:) = vegetrefrac(ib,:)/SUM(vegetrefrac(ib,:))
3740	ENDIF
3741	ENDDO
3742
3743	ELSE
3744
3745	IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_readvegetmax: Start interpolate " &
3746	// TRIM(filename) // " for variable " // TRIM(variablename)
3747
3748	! Assigning values to vmin, vmax
3749	vmin = 1
3750	vmax = nvmap*1._r_std
3751
3752	variabletypevals = -un
3753
3754	!! Variables for interpweight
3755	! Type of calculation of cell fractions
3756	fractype = 'default'
3757	! Name of the longitude and latitude in the input file
3758	lonname = 'lon'
3759	latname = 'lat'
3760	! Should negative values be set to zero from input file?
3761	nonegative = .FALSE.
3762	! Type of mask to apply to the input data (see header for more details)
3763	maskingtype = 'msumrange'
3764	! Values to use for the masking
3765	maskvals = (/ 1.-1.e-7, 0., 2. /)
3766	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
3767	namemaskvar = ''
3768	CALL interpweight_3D(nbpt, nvmap, variabletypevals, lalo, resolution, neighbours, &
3769	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
3770	maskvals, namemaskvar, nvmap, 0, 1, fractype, &
3771	-1., -1., vegetrefrac, aveget)
3772	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_readvegetmax after interpeeight_3D'
3773	ENDIF
3774
3775	!! Consider special case with age classes.
3776	IF (nagec > 1)THEN
3777	! If we are using age classes, we have to do this a little differently.
3778	! We pass fake arrays which get the new vegetation from the maps for
3779	! the PFTs ignoring the age classes, and then we set up the vegetation
3780	! for the age classes using that information.
3781	DO ivma=1,nvmap
3782	veget_last(:,ivma)=SUM(veget_last_in(:,start_index(ivma):start_index(ivma)+nagec_pft(ivma)-1))
3783	ENDDO
3784	ELSE
3785	! If you forget to include NAGEC in your input file, you may have an
3786	! error here.
3787	IF(nvmap .NE. nvm)THEN
3788	CALL ipslerr_p (3,'slowproc_readvegetmax', 'The number of PFTs including all &
3789	age classes is not the same','as the number excluding age classes, despite that &
3790	NAGEC=1.', 'Please check the value of NAGEC in your run.def.')
3791	ENDIF
3792
3793	! Standard case with only 1 age class. All the PFT's are read from the
3794	! file.
3795	veget_last(:,:) = veget_last_in(:,:)
3796	END IF
3797	!
3798	! Compute the logical for partial (only anthropic) PTFs update
3799	IF (ok_dgvm .AND. .NOT. init) THEN
3800	partial_update= .TRUE.
3801	ELSE
3802	partial_update=.FALSE.
3803	END IF
3804
3805	IF (printlev_loc >= 5) THEN
3806	WRITE(numout,*)' slowproc_readvegetmax before updating loop nbpt:', nbpt
3807	END IF
3808
3809	IF ( .NOT. partial_update ) THEN
3810	! Case for not DGVM or (DGVM and init)
3811	veget_next(:,:)=zero
3812
3813	IF (printlev_loc >=3 .AND. ANY(aveget < min_sechiba)) THEN
3814	WRITE(numout,*) 'Some grid cells on the model grid did not have any points on the source grid.'
3815	IF (init) THEN
3816	WRITE(numout,*) 'Initialization with full fraction of bare soil are done for the below grid cells.'
3817	ELSE
3818	WRITE(numout,*) 'Old values are kept for the below grid cells.'
3819	ENDIF
3820	WRITE(numout,*) 'List of grid cells (ib, lat, lon):'
3821	END IF
3822
3823	DO ib = 1, nbpt
3824	! vegetrefrac is already normalized to sum equal one for each grid cell
3825	veget_next(ib,:) = vegetrefrac(ib,:)
3826
3827	IF (aveget(ib) < min_sechiba) THEN
3828	IF (printlev_loc >=3) WRITE(numout,*) ib,lalo(ib,1),lalo(ib,2)
3829	IF (init) THEN
3830	veget_next(ib,1) = un
3831	veget_next(ib,2:nvmap) = zero
3832	ELSE
3833	veget_next(ib,:) = veget_last(ib,:)
3834	ENDIF
3835	ENDIF
3836	ENDDO
3837	ELSE
3838	! Partial update
3839	DO ib = 1, nbpt
3840	IF (aveget(ib) > min_sechiba) THEN
3841	! For the case with properly interpolated grid cells (aveget>0)
3842
3843	! last veget for this point
3844	sum_veg=SUM(veget_last(ib,:))
3845	!
3846	! If the DGVM is activated, only anthropic PFTs are utpdated, the others are copied from previous time-step
3847	veget_next(ib,:) = veget_last(ib,:)
3848
3849	DO jv = 2, nvmap
3850	IF ( .NOT. natural(jv) ) THEN
3851	veget_next(ib,jv) = vegetrefrac(ib,jv)
3852	ENDIF
3853	ENDDO
3854
3855	sumvAnthro_old = zero
3856	sumvAnthro = zero
3857	DO jv = 2, nvmap
3858	IF ( .NOT. natural(jv) ) THEN
3859	sumvAnthro = sumvAnthro + veget_next(ib,jv)
3860	sumvAnthro_old = sumvAnthro_old + veget_last(ib,jv)
3861	ENDIF
3862	ENDDO
3863
3864	IF ( sumvAnthro_old < sumvAnthro ) THEN
3865	! Increase of non natural vegetations (increase of agriculture)
3866	! The proportion of natural PFT's must be preserved
3867	! ie the sum of vegets is preserved
3868	! and natural PFT / (sum of veget - sum of antropic veget)
3869	! is preserved.
3870	rapport = ( sum_veg - sumvAnthro ) / ( sum_veg - sumvAnthro_old )
3871	DO jv = 1, nvmap
3872	IF ( natural(jv) ) THEN
3873	veget_next(ib,jv) = veget_last(ib,jv) * rapport
3874	ENDIF
3875	ENDDO
3876	ELSE
3877	! Increase of natural vegetations (decrease of agriculture)
3878	! The decrease of agriculture is replaced by bare soil. The DGVM will
3879	! re-introduce natural PFT's.
3880	DO jv = 1, nvmap
3881	IF ( natural(jv) ) THEN
3882	veget_next(ib,jv) = veget_last(ib,jv)
3883	ENDIF
3884	ENDDO
3885	veget_next(ib,1) = veget_next(ib,1) + sumvAnthro_old - sumvAnthro
3886	ENDIF
3887
3888	! test
3889	IF ( ABS( SUM(veget_next(ib,:)) - sum_veg ) > 10*EPSILON(un) ) THEN
3890	WRITE(numout,*) 'slowproc_readvegetmax _______'
3891	msg = " No conservation of sum of veget for point "
3892	WRITE(numout,*) TRIM(msg), ib, ",(", lalo(ib,1),",", lalo(ib,2), ")"
3893	WRITE(numout,*) " last sum of veget ", sum_veg, " new sum of veget ", &
3894	SUM(veget_next(ib,:)), " error : ", SUM(veget_next(ib,:))-sum_veg
3895	WRITE(numout,*) " Anthropic modifications : last ",sumvAnthro_old," new ",sumvAnthro
3896	CALL ipslerr_p (3,'slowproc_readvegetmax', &
3897	& 'No conservation of sum of veget_next', &
3898	& "The sum of veget_next is different after reading Land Use map.", &
3899	& '(verify the dgvm case model.)')
3900	ENDIF
3901	ELSE
3902	! For the case when there was a propblem with the interpolation, aveget < min_sechiba
3903	WRITE(numout,*) 'slowproc_readvegetmax _______'
3904	WRITE(numout,*) " No land point in the map for point ", ib, ",(", lalo(ib,1), ",", &
3905	lalo(ib,2),")"
3906	CALL ipslerr_p (2,'slowproc_readvegetmax', &
3907	& 'Problem with vegetation file for Land Use.', &
3908	& "No land point in the map for point", &
3909	& '(verify your land use file.)')
3910	veget_next(ib,:) = veget_last(ib,:)
3911	ENDIF
3912
3913	ENDDO
3914	ENDIF
3915	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_readvegetmax after updating'
3916	!
3917	frac_nobio_next (:,:) = un
3918
3919	! Works only for one nnobio !! (ie ice)
3920	DO inobio=1,nnobio
3921	DO jv=1,nvmap
3922	DO ib = 1, nbpt
3923	frac_nobio_next(ib,inobio) = frac_nobio_next(ib,inobio) - veget_next(ib,jv)
3924	ENDDO
3925	ENDDO
3926	ENDDO
3927
3928	DO ib = 1, nbpt
3929	sum_veg = SUM(veget_next(ib,:))
3930	sum_nobio = SUM(frac_nobio_next(ib,:))
3931	IF (sum_nobio < 0.) THEN
3932	frac_nobio_next(ib,:) = zero
3933	veget_next(ib,1) = veget_next(ib,1) + sum_nobio
3934	sum_veg = SUM(veget_next(ib,:))
3935	ENDIF
3936	sumf = sum_veg + sum_nobio
3937	IF (sumf > min_sechiba) THEN
3938	veget_next(ib,:) = veget_next(ib,:) / sumf
3939	frac_nobio_next(ib,:) = frac_nobio_next(ib,:) / sumf
3940	norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
3941	err=norm-un
3942	IF (printlev_loc >=5) WRITE(numout,*) " slowproc_readvegetmax: ib ",ib, &
3943	" SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un, sumf",err,sumf
3944	IF (abs(err) > -EPSILON(un)) THEN
3945	IF ( SUM(frac_nobio_next(ib,:)) > min_sechiba ) THEN
3946	frac_nobio_next(ib,1) = frac_nobio_next(ib,1) - err
3947	ELSE
3948	veget_next(ib,1) = veget_next(ib,1) - err
3949	ENDIF
3950	norm=SUM(veget_next(ib,:))+SUM(frac_nobio_next(ib,:))
3951	err=norm-un
3952	IF (printlev_loc >=5) WRITE(numout,*) " slowproc_readvegetmax: ib ", ib, &
3953	" SUM(veget_next(ib,:)+frac_nobio_next(ib,:))-un",err
3954	IF (abs(err) > EPSILON(un)) THEN
3955	WRITE(numout,*) ' slowproc_readvegetmax _______'
3956	WRITE(numout,*) "update : Problem with point ",ib,",(",lalo(ib,1),",",lalo(ib,2),")"
3957	WRITE(numout,*) " err(sum-1.) = ",abs(err)
3958	CALL ipslerr_p (2,'slowproc_readvegetmax', &
3959	& 'Problem with sum vegetation + sum fracnobio for Land Use.', &
3960	& "sum not equal to 1.", &
3961	& '(verify your land use file.)')
3962	aveget(ib) = -0.6
3963	ENDIF
3964	ENDIF
3965	ELSE
3966	! sumf < min_sechiba
3967	WRITE(numout,*) ' slowproc_readvegetmax _______'
3968	WRITE(numout,*)" No vegetation nor frac_nobio for point ", ib, ",(", lalo(ib,1), ",", &
3969	lalo(ib,2),")"
3970	WRITE(numout,*)" Replaced by bare_soil !! "
3971	veget_next(ib,1) = un
3972	veget_next(ib,2:nvmap) = zero
3973	frac_nobio_next(ib,:) = zero
3974	CALL ipslerr_p (2,'slowproc_readvegetmax', &
3975	& 'Problem with vegetation file for Land Use.', &
3976	& "No vegetation nor frac_nobio for point ", &
3977	& '(verify your land use file.)')
3978	ENDIF
3979	ENDDO
3980
3981
3982	IF ( nagec > 1 ) THEN
3983	! Now we need to change this into the map with age classes.
3984	! We have the total area for each PFT for next year from the map.
3985	! However, we do not have the area for each age class; this is
3986	! only present in the simulation, not the maps. I am going to
3987	! put all of the vegetmax for a given PFT in only the youngest
3988	! age class for now. This will be properly taken into account in
3989	! land_cover_change_main. The reason we don't do it here is because
3990	! the age classes can change between this part of the code and between
3991	! land_cover_change main, due to growth or death.
3992	veget_next_out(:,:) = 0.0
3993	DO ivma=1,nvmap
3994	veget_next_out(:,start_index(ivma))=veget_next(:,ivma)
3995	ENDDO
3996
3997	ELSE
3998	! Standard case with 1 age class
3999	veget_next_out(:,:) = veget_next(:,:)
4000	END IF
4001
4002	! Write diagnostics
4003	CALL xios_orchidee_send_field("interp_avail_aveget",aveget)
4004	CALL xios_orchidee_send_field("interp_diag_vegetrefrac",vegetrefrac)
4005	CALL xios_orchidee_send_field("interp_diag_veget_next",veget_next)
4006
4007	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_readvegetmax ended'
4008
4009	END SUBROUTINE slowproc_readvegetmax
4010
4011
4012	!! ================================================================================================================================
4013	!! SUBROUTINE : slowproc_readcnleaf
4014	!!
4015	!>\BRIEF Read and interpolate a map (by pft) with cn leaf ratio
4016	!!
4017	!! DESCRIPTION : Note that the variables modified are not explicit INTENT(OUT), but they
4018	!! are module variables, so they don't need to be explicitly passed.
4019	!!
4020	!! RECENT CHANGE(S):
4021	!!
4022	!! MAIN OUTPUT VARIABLE(S): ::cn_leaf_min_2D, ::cn_leaf_init_2D, ::cn_leaf_max_2D
4023	!!
4024	!! REFERENCE(S) : None
4025	!!
4026	!! FLOWCHART : None
4027	!! \n
4028	!_ ================================================================================================================================
4029
4030	SUBROUTINE slowproc_readcnleaf(nbpt, lalo, neighbours, resolution, contfrac)
4031
4032	USE interpweight
4033
4034	IMPLICIT NONE
4035
4036	!
4037	!
4038	!
4039	! 0.1 INPUT
4040	!
4041	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs
4042	!! to be interpolated
4043	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo !! Vector of latitude and longitudes (beware of the order !)
4044	INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours !! Vector of neighbours for each grid point
4045	!! (1=North and then clockwise)
4046	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution !! The size in km of each grid-box in X and Y
4047	REAL(r_std), DIMENSION(nbpt), INTENT(in) :: contfrac !! Fraction of continent in the grid
4048	!
4049	!
4050	! 0.2 OUTPUT
4051	!
4052
4053	!
4054	! 0.3 LOCAL
4055	!
4056	!
4057	CHARACTER(LEN=80) :: filename
4058	INTEGER(i_std) :: ib, inobio, jv
4059	REAL(r_std) :: sumf, err, norm
4060	!
4061	! for DGVM case :
4062	REAL(r_std) :: sum_veg ! sum of vegets
4063	REAL(r_std) :: sum_nobio ! sum of nobios
4064	REAL(r_std), DIMENSION(nbpt) :: acnleaf !! Availability of the soilcol interpolation
4065	REAL(r_std) :: vmin, vmax !! min/max values to use for the renormalization
4066	REAL(r_std), DIMENSION(nbpt,1) :: defaultvalue
4067	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
4068	CHARACTER(LEN=80) :: lonname, latname !! lon, lat names in input file
4069	REAL(r_std), DIMENSION(nvm) :: variabletypevals !! Values for all the types of the variable
4070	!! (variabletypevals(1) = -un, not used)
4071	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
4072	!! 'XYKindTime': Input values are kinds
4073	!! of something with a temporal
4074	!! evolution on the dx*dy matrix'
4075	LOGICAL :: nonegative !! whether negative values should be removed
4076	CHARACTER(LEN=50) :: maskingtype !! Type of masking
4077	!! 'nomask': no-mask is applied
4078	!! 'mbelow': take values below maskvals(1)
4079	!! 'mabove': take values above maskvals(1)
4080	!! 'msumrange': take values within 2 ranges;
4081	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
4082	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
4083	!! (normalized by maskvals(3))
4084	!! 'var': mask values are taken from a
4085	!! variable inside the file (>0)
4086	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
4087	!! `maskingtype')
4088	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
4089	CHARACTER(LEN=250) :: msg
4090	REAL(r_std), DIMENSION(nbpt,nvm,1) :: cnleaf !! cn leaf read
4091
4092	!_ ================================================================================================================================
4093
4094	IF (printlev_loc >= 5) PRINT *,' In slowproc_readcnleaf'
4095
4096	!
4097	!Config Key = CNLEAF_FILE
4098	!Config Desc = Name of file from which the cn leaf ratio is to be read
4099	!Config If =
4100	!Config Def = cnleaf_map.nc
4101	!Config Help = The name of the file to be opened to read a 2D cn leaf ratio
4102	!Config Units = [FILE]
4103	!
4104	filename = 'cnleaf_map.nc'
4105	CALL getin_p('CNLEAF_FILE',filename)
4106
4107	!
4108	!Config Key = CNLEAF_VAR
4109	!Config Desc = Name of the variable in the file from which the cn leaf ratio is to be read
4110	!Config If =
4111	!Config Def = leaf_cn.nc
4112	!Config Help = The name of the variable to be opened to read a 2D cn leaf ratio
4113	!Config Units = [VAR]
4114	!
4115	variablename = 'leaf_cn'
4116	CALL getin_p('CNLEAF_VAR', variablename)
4117
4118	IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_readcnleaf: Start interpolate " &
4119	// TRIM(filename) // " for variable " // TRIM(variablename)
4120
4121	! Assigning values to vmin, vmax
4122	vmin = 0.
4123	vmax = 0.
4124
4125	variabletypevals = -un
4126
4127	!! Variables for interpweight
4128	! Type of calculation of cell fractions
4129	fractype = 'default'
4130	! Name of the longitude and latitude in the input file
4131	lonname = 'lon'
4132	latname = 'lat'
4133	! Should negative values be set to zero from input file?
4134	nonegative = .FALSE.
4135	! Type of mask to apply to the input data (see header for more details)
4136	maskingtype = 'nomask'
4137	! Values to use for the masking
4138	maskvals = (/ 1.-1.e-7, min_sechiba, 2. /)
4139	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
4140	namemaskvar = ''
4141
4142	! SUBROUTINE interpweight_3D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours, &
4143	! contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype, &
4144	! maskvalues, maskvarname, dim1, dim2, initime, typefrac, &
4145	! maxresollon, maxresollat, outvar3D, aoutvar)
4146	! CALL interpweight_3D(nbpt, nvm, variabletypevals, lalo, resolution, neighbours, &
4147	! contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
4148	! maskvals, namemaskvar, nvm, 0, 0, fractype, &
4149	! -1., -1., cnleaf, acnleaf)
4150
4151	! SUBROUTINE interpweight_4Dcont(nbpt, dim1, dim2, lalo, resolution, neighbours, &
4152	! contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype, &
4153	! maskvalues, maskvarname, initime, typefrac, defaultvalue, defaultNOvalue, &
4154	! outvar4D, aoutvar)
4155
4156	defaultvalue=0.
4157	CALL interpweight_4Dcont(nbpt, nvm, 1, lalo, resolution, neighbours, &
4158	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
4159	maskvals, namemaskvar, -1, fractype, defaultvalue, 0., cnleaf, acnleaf)
4160
4161	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_readcnleaf after interpeeight_3D'
4162
4163
4164	cn_leaf_min_2D(:,:)=cnleaf(:,:,1)
4165	cn_leaf_init_2D(:,:)=cnleaf(:,:,1)
4166	cn_leaf_max_2D(:,:)=1000.
4167
4168
4169	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_readcnleaf ended'
4170
4171	END SUBROUTINE slowproc_readcnleaf
4172
4173
4174	!! ================================================================================================================================
4175	!! SUBROUTINE : slowproc_nearest
4176	!!
4177	!>\BRIEF looks for nearest grid point on the fine map
4178	!!
4179	!! DESCRIPTION : (definitions, functional, design, flags):
4180	!!
4181	!! RECENT CHANGE(S): None
4182	!!
4183	!! MAIN OUTPUT VARIABLE(S): ::inear
4184	!!
4185	!! REFERENCE(S) : None
4186	!!
4187	!! FLOWCHART : None
4188	!! \n
4189	!_ ================================================================================================================================
4190
4191	SUBROUTINE slowproc_nearest(iml, lon5, lat5, lonmod, latmod, inear)
4192
4193	!! INTERFACE DESCRIPTION
4194
4195	!! 0.1 input variables
4196
4197	INTEGER(i_std), INTENT(in) :: iml !! size of the vector
4198	REAL(r_std), DIMENSION(iml), INTENT(in) :: lon5, lat5 !! longitude and latitude vector, for the 5km vegmap
4199	REAL(r_std), INTENT(in) :: lonmod, latmod !! longitude and latitude modelled
4200
4201	!! 0.2 output variables
4202
4203	INTEGER(i_std), INTENT(out) :: inear !! location of the grid point from the 5km vegmap grid
4204	!! closest from the modelled grid point
4205
4206	!! 0.4 Local variables
4207
4208	REAL(r_std) :: pa, p
4209	REAL(r_std) :: coscolat, sincolat
4210	REAL(r_std) :: cospa, sinpa
4211	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: cosang
4212	INTEGER(i_std) :: i
4213	INTEGER(i_std), DIMENSION(1) :: ineartab
4214	INTEGER :: ALLOC_ERR
4215
4216	!_ ================================================================================================================================
4217
4218	ALLOCATE(cosang(iml), STAT=ALLOC_ERR)
4219	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_nearest','Error in allocation for cosang','','')
4220
4221	pa = pi/2.0 - latmod*pi/180.0 ! dist. between north pole and the point a
4222	!! COLATITUDE, in radian
4223	cospa = COS(pa)
4224	sinpa = SIN(pa)
4225
4226	DO i = 1, iml
4227
4228	sincolat = SIN( pi/2.0 - lat5(i)*pi/180.0 ) !! sinus of the colatitude
4229	coscolat = COS( pi/2.0 - lat5(i)*pi/180.0 ) !! cosinus of the colatitude
4230
4231	p = (lonmod-lon5(i))*pi/180.0 !! angle between a & b (between their meridian)in radians
4232
4233	!! dist(i) = ACOS( cospacoscolat + sinpasincolat*COS(p))
4234	cosang(i) = cospacoscolat + sinpasincolat*COS(p) !! TL : cosang is maximum when angle is at minimal value
4235	!! orthodromic distance between 2 points : cosang = cosinus (arc(AB)/R), with
4236	!R = Earth radius, then max(cosang) = max(cos(arc(AB)/R)), reached when arc(AB)/R is minimal, when
4237	! arc(AB) is minimal, thus when point B (corresponding grid point from LAI MAP) is the nearest from
4238	! modelled A point
4239	ENDDO
4240
4241	ineartab = MAXLOC( cosang(:) )
4242	inear = ineartab(1)
4243
4244	DEALLOCATE(cosang)
4245	END SUBROUTINE slowproc_nearest
4246
4247
4248	!! ================================================================================================================================
4249	!! SUBROUTINE : slowproc_soilt
4250	!!
4251	!>\BRIEF Interpolate the Zobler or Reynolds/USDA soil type map
4252	!!
4253	!! DESCRIPTION : Read and interpolate Zobler or Reynolds/USDA soil type map.
4254	!! Read and interpolate soil bulk and soil ph from file.
4255	!!
4256	!! RECENT CHANGE(S): Nov 2014, ADucharne
4257	!! Nov 2020, Salma Tafasca and Agnes Ducharne: adding a choice for spmipexp/SPMIPEXP,
4258	!! and everything needed to read all maps and assign parameter values.
4259	!!
4260	!! MAIN OUTPUT VARIABLE(S): ::soiltype, ::clayfraction, sandfraction, siltfraction, ::bulk, ::soilph
4261	!!
4262	!! REFERENCE(S) : Reynold, Jackson, and Rawls (2000). Estimating soil water-holding capacities
4263	!! by linking the Food and Agriculture Organization soil map of the world with global pedon
4264	!! databases and continuous pedotransfer functions, WRR, 36, 3653-3662
4265	!!
4266	!! FLOWCHART : None
4267	!! \n
4268	!_ ================================================================================================================================
4269
4270	SUBROUTINE slowproc_soilt(njsc, ks, nvan, avan, mcr, mcs, mcfc, mcw, &
4271	nbpt, lalo, neighbours, resolution, contfrac, &
4272	soilclass, clayfraction, sandfraction, siltfraction, bulk, soil_ph)
4273
4274	USE interpweight
4275
4276	IMPLICIT NONE
4277	!
4278	!
4279	! This subroutine should read the Zobler/Reynolds map and interpolate to the model grid.
4280	! The method is to get fraction of the three/12 main soiltypes for each grid box.
4281	! For the Zobler case, also called FAO in the code, the soil fraction are going to be put
4282	! into the array soiltype in the following order : coarse, medium and fine.
4283	! For the Reynolds/USDA case, the soiltype array follows the order defined in constantes_soil_var.f90
4284	!
4285	!
4286	!! 0.1 INPUT
4287	!
4288	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs to be interpolated
4289	REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !)
4290	INTEGER(i_std), INTENT(in) :: neighbours(nbpt,NbNeighb)!! Vector of neighbours for each grid point
4291	!! (1=North and then clockwise)
4292	REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size in km of each grid-box in X and Y
4293	REAL(r_std), INTENT(in) :: contfrac(nbpt) !! Fraction of land in each grid box.
4294	!
4295	! 0.2 OUTPUT
4296	!
4297	INTEGER(i_std),DIMENSION (nbpt), INTENT (out) :: njsc !! Index of the dominant soil textural class in the grid cell (1-nscm, unitless)
4298	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: ks !! Hydraulic conductivity at saturation (mm {-1})
4299	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: nvan !! Van Genuchten coeficients n (unitless)
4300	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: avan !! Van Genuchten coeficients a (mm-1})
4301	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: mcr !! Residual volumetric water content (m^{3} m^{-3})
4302	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: mcs !! Saturated volumetric water content (m^{3} m^{-3})
4303	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: mcfc !! Volumetric water content at field capacity (m^{3} m^{-3})
4304	REAL(r_std),DIMENSION (nbpt), INTENT (out) :: mcw !! Volumetric water content at wilting point (m^{3} m^{-3})
4305
4306	REAL(r_std), INTENT(out) :: soilclass(nbpt, nscm) !! Soil type map to be created from the Zobler map
4307	!! or a map defining the 12 USDA classes (e.g. Reynolds)
4308	!! Holds the area of each texture class in the ORCHIDEE grid cells
4309	!! Final unit = fraction of ORCHIDEE grid-cell (unitless)
4310	REAL(r_std), INTENT(out) :: clayfraction(nbpt) !! The fraction of clay as used by STOMATE
4311	REAL(r_std), INTENT(out) :: sandfraction(nbpt) !! The fraction of sand (for SP-MIP)
4312	REAL(r_std), INTENT(out) :: siltfraction(nbpt) !! The fraction of silt (for SP-MIP)
4313	REAL(r_std), INTENT(out) :: bulk(nbpt) !! Bulk density as used by STOMATE
4314	REAL(r_std), INTENT(out) :: soil_ph(nbpt) !! Soil pH as used by STOMATE
4315	!
4316	!
4317	! 0.3 LOCAL
4318	!
4319	REAL(r_std), DIMENSION(nbpt) :: param !! to be introduced in function: interpweight
4320	CHARACTER(LEN=80) :: filename
4321	INTEGER(i_std) :: ib, ilf, nbexp, i
4322	INTEGER(i_std) :: fopt !! Nb of pts from the texture map within one ORCHIDEE grid-cell
4323	INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: solt !! Texture the different points from the input texture map
4324	!! in one ORCHIDEE grid cell (unitless)
4325	!
4326	! Number of texture classes in Zobler
4327	!
4328	INTEGER(i_std), PARAMETER :: nzobler = 7 !! Nb of texture classes according in the Zobler map
4329	REAL(r_std),ALLOCATABLE :: textfrac_table(:,:) !! conversion table between the texture index
4330	!! and the granulometric composition
4331	!
4332	INTEGER :: ALLOC_ERR
4333	INTEGER :: ntextinfile !! number of soil textures in the in the file
4334	REAL(r_std), DIMENSION(:,:), ALLOCATABLE :: textrefrac !! text fractions re-dimensioned
4335	REAL(r_std), DIMENSION(nbpt) :: atext !! Availability of the texture interpolation
4336	REAL(r_std), DIMENSION(nbpt) :: abulkph !! Availability of the bulk and ph interpolation
4337	REAL(r_std), DIMENSION(nbpt) :: aparam !! Availability of the parameter interpolation
4338	CHARACTER(LEN=80) :: spmipexp !! designing the number of sp-mip experiment
4339	CHARACTER(LEN=80) :: unif_case !! designing the model of experiment 4 (sp_mip)
4340	REAL(r_std) :: vmin, vmax !! min/max values to use for the
4341
4342	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
4343	CHARACTER(LEN=80) :: lonname, latname !! lon, lat name in input file
4344	REAL(r_std), DIMENSION(:), ALLOCATABLE :: variabletypevals !! Values for all the types of the variable
4345	!! (variabletypevals(1) = -un, not used)
4346	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
4347	!! 'XYKindTime': Input values are kinds
4348	!! of something with a temporal
4349	!! evolution on the dx*dy matrix'
4350	LOGICAL :: nonegative !! whether negative values should be removed
4351	CHARACTER(LEN=50) :: maskingtype !! Type of masking
4352	!! 'nomask': no-mask is applied
4353	!! 'mbelow': take values below maskvals(1)
4354	!! 'mabove': take values above maskvals(1)
4355	!! 'msumrange': take values within 2 ranges;
4356	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
4357	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
4358	!! (normalized by maskvals(3))
4359	!! 'var': mask values are taken from a
4360	!! variable inside the file (>0)
4361	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
4362	!! `maskingtype')
4363	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
4364	INTEGER(i_std), DIMENSION(:), ALLOCATABLE :: vecpos
4365	CHARACTER(LEN=80) :: fieldname !! name of the field read in the N input map
4366	REAL(r_std) :: sgn !! sum of fractions excluding glaciers and ocean
4367
4368	! For the calculation of field capacity and wilting point
4369	REAL(r_std),DIMENSION (nbpt) :: mvan !! Van Genuchten parameter m
4370	REAL(r_std),DIMENSION (nbpt) :: psi_w !! Matrix potential characterizing the wilting point (mm)
4371	REAL(r_std),DIMENSION (nbpt) :: psi_fc !! Matrix potential characterizing the field capacity (mm)
4372
4373	!_ ================================================================================================================================
4374
4375	IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_soilt'
4376
4377	! The soil parameters are defined by several keywords in run.def:
4378	! (a) soil_classif tells which kind of soil texture map you will read (mandatory):
4379	! - usda for 12 USDA texture classes (Reynolds, SoilGrids, SPMIP, etc) updated to 13 classes
4380	! for clay oxisols by Salma Tafasca
4381	! - zobler to read teh Zobler map and reduce it to 3 classes (fine, medium, coarse)
4382	! (b) spmipexp was introduced by Salma Tafasca for the SPMIP project
4383	! maps: Reading the soil parameter maps of SPMIP
4384	! unif: Imposing uniform soil texture over the globe (4 texture options, with parameter values imposed by SP-MIP)
4385	! Even with maps, some parameters (thermics) are defined based on texture.
4386	! So we read a soil texture map in all experiments but unif, where soil texture is imposed by njsc(:).
4387	! (c) unif_case to choose the soil texture assigned if spmipexp=maps (4 hard_coded possibilities)
4388
4389	! IMPORTANT: if no spmipexp is defined in run.def, the model works as before, by deriving the soil parameters
4390	! from a soil texture map, itself defined by the SOILTYPE_CLASSIF keyword, and soil_classif variable
4391	! But to get a uniform texture (exp 4), you need to select a soil texture map using soil_classif, even if it's not read
4392
4393	!Config Key = SPMIPEXP
4394	!Config Desc = Types of alternative hydraulic parameters
4395	!Config Def = 'texture'
4396	!Config If =
4397	!Config Help = possible values: maps, unif
4398	!Config Units = [-]
4399	spmipexp='texture' ! default is to define parameters from soil texture, with soil_classif = 'zobler' or 'usda'
4400	CALL getin_p("SPMIPEXP",spmipexp)
4401
4402	IF (spmipexp == 'unif') THEN
4403	! case where unif=exp4 is selected: uniform soil parameters
4404	! the values of the hydraulic parameters below come from SP-MIP,
4405	! and correspond to the Rosetta PTF (Schaap et al., 2001)
4406
4407	! sp_mip_experiment_4: select another level of experiment: a, b, c or d in run.def
4408
4409	!Config Key = UNIF_CASE
4410	!Config Desc = Types of uniform soil textures in SPMIP, possible values: a, b, c and d
4411	!Config Def = 'b'
4412	!Config If =
4413	!Config Help = possible values: a, b, c and d
4414	!Config Units = [-]
4415	unif_case='b' ! default = loamy soil
4416	CALL getin_p("UNIF_CASE",unif_case)
4417
4418	SELECTCASE (unif_case)
4419
4420	CASE ('a') ! loamy sand
4421	clayfraction=0.06
4422	sandfraction=0.81
4423	siltfraction=0.13
4424	DO ib=1 , nbpt
4425	njsc(ib) = 2
4426	mcr(ib) = 0.049
4427	mcs(ib) = 0.39
4428	ks(ib) = (1.41e-5)100024*3600
4429	avan(ib) = 3.475*(1e-3)
4430	nvan(ib) = 1.746
4431	mcfc(ib) = 0.1039
4432	mcw(ib) = 0.05221
4433	ENDDO
4434
4435	CASE ('b') !loam
4436	clayfraction=0.2
4437	sandfraction=0.4
4438	siltfraction=0.4
4439	DO ib=1, nbpt
4440	njsc(ib) = 6
4441	mcr(ib) = 0.061
4442	mcs(ib) = 0.399
4443	ks(ib) = (3.38e-6)100024*3600
4444	avan(ib) = 1.112*(1e-3)
4445	nvan(ib) = 1.472
4446	mcfc(ib) = 0.236
4447	mcw(ib) = 0.09115
4448	ENDDO
4449
4450	CASE ('c') !silt
4451	clayfraction=0.1
4452	sandfraction=0.06
4453	siltfraction=0.84
4454	DO ib=1, nbpt
4455	njsc(ib)=5
4456	mcr(ib) = 0.05
4457	mcs(ib) = 0.489
4458	ks(ib) = (2.81e-6)100024*3600
4459	avan(ib) = 0.6577*(1e-3)
4460	nvan(ib) = 1.679
4461	mcfc(ib) = 0.2854
4462	mcw(ib) = 0.06944
4463	ENDDO
4464
4465	CASE ('d')!clay
4466	clayfraction=0.55
4467	sandfraction=0.15
4468	siltfraction=0.3
4469	DO ib=1, nbpt
4470	njsc(ib)=12
4471	mcr(ib) = 0.098
4472	mcs(ib) = 0.459
4473	ks(ib) = (9.74e-7)100024*3600
4474	avan(ib) = 1.496*(1e-3)
4475	nvan(ib) = 1.253
4476	mcfc(ib) = 0.3329
4477	mcw(ib) = 0.1897
4478	ENDDO
4479
4480	CASE DEFAULT
4481
4482	WRITE (numout,*) 'Unsupported experiment number. Choose between a, b, c or d according to sp_mip_experiment_4 number'
4483	CALL ipslerr_p(3,'hydrol_init','Unsupported experiment number. ',&
4484	'Choose between a,b,c or d','')
4485	ENDSELECT
4486
4487	ELSE ! spmipexp is either exp1=maps, or texture for exp2 or exp3 (or typing error!)
4488
4489	!
4490	! Needs to be a configurable variable
4491	!
4492	!
4493	!Config Key = SOILCLASS_FILE
4494	!Config Desc = Name of file from which soil types are read
4495	!Config Def = soils_param.nc
4496	!Config If = NOT(IMPOSE_VEG)
4497	!Config Help = The name of the file to be opened to read the soil types.
4498	!Config The data from this file is then interpolated to the grid of
4499	!Config of the model. The aim is to get fractions for sand loam and
4500	!Config clay in each grid box. This information is used for soil hydrology
4501	!Config and respiration.
4502	!Config Units = [FILE]
4503	!
4504	! soils_param.nc file is 1deg soil texture file (Zobler)
4505	! The USDA map from Reynolds is soils_param_usda.nc (1/12deg resolution)
4506
4507
4508	filename = 'soils_param.nc'
4509	CALL getin_p('SOILCLASS_FILE',filename)
4510
4511	variablename = 'soiltext'
4512
4513	!! Variables for interpweight
4514	! Type of calculation of cell fractions
4515	fractype = 'default'
4516
4517	IF (xios_interpolation) THEN
4518	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Use XIOS to read and interpolate " &
4519	// TRIM(filename) // " for variable " // TRIM(variablename)
4520
4521	SELECT CASE(soil_classif)
4522
4523	CASE('none')
4524	ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
4525	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4526	DO ib=1, nbpt
4527	njsc(ib) = usda_default ! 6 = Loam
4528	clayfraction(ib) = clayfrac_usda(usda_default)
4529	sandfraction(ib) = sandfrac_usda(usda_default)
4530	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4531	ENDDO
4532
4533	CASE('zobler')
4534	IF (printlev_loc>=2) WRITE(numout,*) "Using a soilclass map with Zobler classification, to be read using XIOS"
4535	!
4536	ALLOCATE(textrefrac(nbpt,nzobler))
4537	ALLOCATE(textfrac_table(nzobler,ntext), STAT=ALLOC_ERR)
4538	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4539	CALL get_soilcorr_zobler (nzobler, textfrac_table)
4540
4541	CALL xios_orchidee_recv_field('soiltext1',textrefrac(:,1))
4542	CALL xios_orchidee_recv_field('soiltext2',textrefrac(:,2))
4543	CALL xios_orchidee_recv_field('soiltext3',textrefrac(:,3))
4544	CALL xios_orchidee_recv_field('soiltext4',textrefrac(:,4))
4545	CALL xios_orchidee_recv_field('soiltext5',textrefrac(:,5))
4546	CALL xios_orchidee_recv_field('soiltext6',textrefrac(:,6))
4547	CALL xios_orchidee_recv_field('soiltext7',textrefrac(:,7))
4548
4549	CALL get_soilcorr_zobler (nzobler, textfrac_table)
4550	!
4551	!
4552	DO ib =1, nbpt
4553	soilclass(ib,:)=0.
4554	soilclass(ib,fao2usda(1))=textrefrac(ib,1)
4555	soilclass(ib,fao2usda(2))=textrefrac(ib,2)+textrefrac(ib,3)+textrefrac(ib,4)+textrefrac(ib,7)
4556	soilclass(ib,fao2usda(3))=textrefrac(ib,5)
4557
4558	! clayfraction is the sum of the % of clay (as a mineral of small granulometry, and not as a texture)
4559	! over the zobler pixels composing the ORCHIDEE grid-cell
4560	clayfraction(ib) = textfrac_table(1,3) * textrefrac(ib,1)+textfrac_table(2,3) * textrefrac(ib,2) + &
4561	textfrac_table(3,3) * textrefrac(ib,3)+textfrac_table(4,3) * textrefrac(ib,4) + &
4562	textfrac_table(5,3) * textrefrac(ib,5)+textfrac_table(7,3) * textrefrac(ib,7)
4563
4564	sandfraction(ib) = textfrac_table(1,2) * textrefrac(ib,1)+textfrac_table(2,2) * textrefrac(ib,2) + &
4565	textfrac_table(3,2) * textrefrac(ib,3)+textfrac_table(4,2) * textrefrac(ib,4) + &
4566	textfrac_table(5,2) * textrefrac(ib,5)+textfrac_table(7,2) * textrefrac(ib,7)
4567
4568	siltfraction(ib) = textfrac_table(1,1) * textrefrac(ib,1)+textfrac_table(2,1) * textrefrac(ib,2) + &
4569	textfrac_table(3,1) * textrefrac(ib,3)+textfrac_table(4,1) * textrefrac(ib,4) + &
4570	textfrac_table(5,1) * textrefrac(ib,5)+textfrac_table(7,1) * textrefrac(ib,7)
4571
4572	sgn=SUM(soilclass(ib,:)) ! grid-cell fraction with texture info
4573
4574	IF (sgn < min_sechiba) THEN ! if no texture info in this grid-point, we assume that texture = Loam
4575	njsc(ib) = usda_default ! 6 = Loam
4576	clayfraction(ib) = clayfrac_usda(usda_default)
4577	sandfraction(ib) = sandfrac_usda(usda_default)
4578	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4579	atext(ib)=0.
4580	ELSE
4581	atext(ib)=sgn
4582	clayfraction(ib) = clayfraction(ib) / sgn
4583	sandfraction(ib) = sandfraction(ib) / sgn
4584	siltfraction(ib) = siltfraction(ib) / sgn
4585	soilclass(ib,:) = soilclass(ib,:) / sgn
4586	njsc(ib) = MAXLOC(soilclass(ib,:),1) ! Dominant texture class
4587	ENDIF
4588
4589	ENDDO
4590
4591
4592
4593	CASE('usda')
4594
4595	IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: start case usda'
4596
4597	WRITE(numout,*) "Using a soilclass map with usda classification, to be read using XIOS"
4598	!
4599	ALLOCATE(textrefrac(nbpt,nscm))
4600	ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
4601	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4602
4603	CALL get_soilcorr_usda (nscm, textfrac_table)
4604
4605	IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'
4606
4607	CALL xios_orchidee_recv_field('soiltext1',textrefrac(:,1))
4608	CALL xios_orchidee_recv_field('soiltext2',textrefrac(:,2))
4609	CALL xios_orchidee_recv_field('soiltext3',textrefrac(:,3))
4610	CALL xios_orchidee_recv_field('soiltext4',textrefrac(:,4))
4611	CALL xios_orchidee_recv_field('soiltext5',textrefrac(:,5))
4612	CALL xios_orchidee_recv_field('soiltext6',textrefrac(:,6))
4613	CALL xios_orchidee_recv_field('soiltext7',textrefrac(:,7))
4614	CALL xios_orchidee_recv_field('soiltext8',textrefrac(:,8))
4615	CALL xios_orchidee_recv_field('soiltext9',textrefrac(:,9))
4616	CALL xios_orchidee_recv_field('soiltext10',textrefrac(:,10))
4617	CALL xios_orchidee_recv_field('soiltext11',textrefrac(:,11))
4618	CALL xios_orchidee_recv_field('soiltext12',textrefrac(:,12))
4619	CALL xios_orchidee_recv_field('soiltext13',textrefrac(:,13))
4620
4621	CALL get_soilcorr_usda (nscm, textfrac_table)
4622	IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'
4623
4624	DO ib =1, nbpt
4625	clayfraction(ib) = 0.0
4626	DO ilf = 1,nscm
4627	soilclass(ib,ilf)=textrefrac(ib,ilf)
4628	clayfraction(ib) = clayfraction(ib) + textfrac_table(ilf,3)*textrefrac(ib,ilf)
4629	sandfraction(ib) = sandfraction(ib) + textfrac_table(ilf,2)*textrefrac(ib,ilf)
4630	siltfraction(ib) = siltfraction(ib) + textfrac_table(ilf,1)*textrefrac(ib,ilf)
4631	! textfrac_table holds the %silt,%sand,%clay
4632	ENDDO
4633
4634
4635	sgn=SUM(soilclass(ib,:)) ! grid-cell fraction with texture info
4636
4637	IF (sgn < min_sechiba) THEN ! if no texture info in this grid-point, we assume that texture = Loam
4638	njsc(ib) = usda_default ! 6 = Loam
4639	clayfraction(ib) = clayfrac_usda(usda_default)
4640	sandfraction(ib) = sandfrac_usda(usda_default)
4641	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4642	atext(ib)=0
4643	ELSE
4644	soilclass(ib,:) = soilclass(ib,:) / sgn
4645	clayfraction(ib) = clayfraction(ib) / sgn
4646	sandfraction(ib) = sandfraction(ib) / sgn
4647	siltfraction(ib) = siltfraction(ib) / sgn
4648	atext(ib)=sgn
4649	njsc(ib) = MAXLOC(soilclass(ib,:),1) ! Dominant texture class
4650	ENDIF
4651	ENDDO
4652
4653	CASE DEFAULT
4654	WRITE(numout,*) 'slowproc_soilt:'
4655	WRITE(numout,*) ' A non supported soil type classification has been chosen'
4656	CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
4657	END SELECT
4658
4659	ELSE ! xios_interpolation
4660	! Read and interpolate using stardard method with IOIPSL and aggregate
4661
4662	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate " &
4663	// TRIM(filename) // " for variable " // TRIM(variablename)
4664
4665	! Name of the longitude and latitude in the input file
4666	lonname = 'nav_lon'
4667	latname = 'nav_lat'
4668
4669	IF (printlev_loc >= 2) WRITE(numout,*) "slowproc_soilt: Start interpolate " &
4670	// TRIM(filename) // " for variable " // TRIM(variablename)
4671
4672	IF ( TRIM(soil_classif) /= 'none' ) THEN
4673
4674	! Define a variable for the number of soil textures in the input file
4675	SELECTCASE(soil_classif)
4676	CASE('zobler')
4677	ntextinfile=nzobler
4678	CASE('usda')
4679	ntextinfile=nscm
4680	CASE DEFAULT
4681	WRITE(numout,*) 'slowproc_soilt:'
4682	WRITE(numout,*) ' A non supported soil type classification has been chosen'
4683	CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
4684	ENDSELECT
4685
4686	ALLOCATE(textrefrac(nbpt,ntextinfile), STAT=ALLOC_ERR)
4687	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable textrefrac',&
4688	'','')
4689
4690	! Assigning values to vmin, vmax
4691	vmin = un
4692	vmax = ntextinfile*un
4693
4694	ALLOCATE(variabletypevals(ntextinfile), STAT=ALLOC_ERR)
4695	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variabletypevals','','')
4696	variabletypevals = -un
4697
4698	!! Variables for interpweight
4699	! Should negative values be set to zero from input file?
4700	nonegative = .FALSE.
4701	! Type of mask to apply to the input data (see header for more details)
4702	maskingtype = 'mabove'
4703	! Values to use for the masking
4704	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
4705	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') ( not used)
4706	namemaskvar = ''
4707
4708	CALL interpweight_2D(nbpt, ntextinfile, variabletypevals, lalo, resolution, neighbours, &
4709	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
4710	maskvals, namemaskvar, 0, 0, -1, fractype, -1., -1., textrefrac, atext)
4711
4712	ALLOCATE(vecpos(ntextinfile), STAT=ALLOC_ERR)
4713	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable vecpos','','')
4714	ALLOCATE(solt(ntextinfile), STAT=ALLOC_ERR)
4715	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_soilt','Problem in allocation of variable solt','','')
4716
4717	IF (printlev_loc >= 5) THEN
4718	WRITE(numout,*)' slowproc_soilt after interpweight_2D'
4719	WRITE(numout,*)' slowproc_soilt before starting loop nbpt:', nbpt
4720	WRITE(numout,*)" slowproc_soilt starting classification '" // TRIM(soil_classif) // "'..."
4721	END IF
4722	ELSE
4723	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_soilt using default values all points are propertly ' // &
4724	'interpolated atext = 1. everywhere!'
4725	atext = 1.
4726	END IF
4727
4728	nbexp = 0
4729	SELECTCASE(soil_classif)
4730	CASE('none')
4731	ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
4732	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4733	DO ib=1, nbpt
4734	njsc(ib) = usda_default ! 6 = Loam
4735	clayfraction(ib) = clayfrac_usda(usda_default)
4736	sandfraction(ib) = sandfrac_usda(usda_default)
4737	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4738	ENDDO
4739	CASE('zobler')
4740	IF (printlev_loc>=2) WRITE(numout,*) "Using a soilclass map with Zobler classification"
4741	!
4742	ALLOCATE(textfrac_table(nzobler,ntext), STAT=ALLOC_ERR)
4743	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4744	CALL get_soilcorr_zobler (nzobler, textfrac_table)
4745	!
4746	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_soilt after getting table of textures'
4747	DO ib =1, nbpt
4748	soilclass(ib,:) = zero
4749	clayfraction(ib) = zero
4750	sandfraction(ib) = zero
4751	siltfraction(ib) = zero
4752	!
4753	! vecpos: List of positions where textures were not zero
4754	! vecpos(1): number of not null textures found
4755	vecpos = interpweight_ValVecR(textrefrac(ib,:),nzobler,zero,'neq')
4756	fopt = vecpos(1)
4757
4758	IF ( fopt .EQ. 0 ) THEN
4759	! No points were found for current grid box, use default values
4760	nbexp = nbexp + 1
4761	njsc(ib) = usda_default ! 6=Loam
4762	clayfraction(ib) = clayfrac_usda(usda_default)
4763	sandfraction(ib) = sandfrac_usda(usda_default)
4764	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4765	ELSE
4766	IF (fopt == nzobler) THEN
4767	! All textures are not zero
4768	solt=(/(i,i=1,nzobler)/)
4769	ELSE
4770	DO ilf = 1,fopt
4771	solt(ilf) = vecpos(ilf+1)
4772	END DO
4773	END IF
4774	!
4775	! Compute the fraction of each textural class
4776	!
4777	sgn = 0.
4778	DO ilf = 1,fopt
4779	!
4780	! Here we make the correspondance between the 7 zobler textures and the 3 textures in ORCHIDEE
4781	! and soilclass correspond to surfaces covered by the 3 textures of ORCHIDEE (coase,medium,fine)
4782	! For type 6 = glacier, default values are set and it is also taken into account during the normalization
4783	! of the fractions (done in interpweight_2D)
4784	! Note that type 0 corresponds to ocean but it is already removed using the mask above.
4785	!
4786	IF ( (solt(ilf) .LE. nzobler) .AND. (solt(ilf) .GT. 0) .AND. &
4787	(solt(ilf) .NE. 6) ) THEN
4788	SELECT CASE(solt(ilf))
4789	CASE(1)
4790	soilclass(ib,fao2usda(1)) = soilclass(ib,fao2usda(1)) + textrefrac(ib,solt(ilf))
4791	CASE(2)
4792	soilclass(ib,fao2usda(2)) = soilclass(ib,fao2usda(2)) + textrefrac(ib,solt(ilf))
4793	CASE(3)
4794	soilclass(ib,fao2usda(2)) = soilclass(ib,fao2usda(2)) + textrefrac(ib,solt(ilf))
4795	CASE(4)
4796	soilclass(ib,fao2usda(2)) = soilclass(ib,fao2usda(2)) + textrefrac(ib,solt(ilf))
4797	CASE(5)
4798	soilclass(ib,fao2usda(3)) = soilclass(ib,fao2usda(3)) + textrefrac(ib,solt(ilf))
4799	CASE(7)
4800	soilclass(ib,fao2usda(2)) = soilclass(ib,fao2usda(2)) + textrefrac(ib,solt(ilf))
4801	CASE DEFAULT
4802	WRITE(numout,*) 'We should not be here, an impossible case appeared'
4803	CALL ipslerr_p(3,'slowproc_soilt','Bad value for solt','','')
4804	END SELECT
4805	! clayfraction is the sum of the % of clay (as a mineral of small granulometry, and not as a texture)
4806	! over the zobler pixels composing the ORCHIDEE grid-cell
4807	clayfraction(ib) = clayfraction(ib) + &
4808	& textfrac_table(solt(ilf),3) * textrefrac(ib,solt(ilf))
4809	sandfraction(ib) = sandfraction(ib) + &
4810	& textfrac_table(solt(ilf),2) * textrefrac(ib,solt(ilf))
4811	siltfraction(ib) = siltfraction(ib) + &
4812	& textfrac_table(solt(ilf),1) * textrefrac(ib,solt(ilf))
4813	! Sum the fractions which are not glaciers nor ocean
4814	sgn = sgn + textrefrac(ib,solt(ilf))
4815	ELSE
4816	IF (solt(ilf) .GT. nzobler) THEN
4817	WRITE(numout,*) 'The file contains a soil color class which is incompatible with this program'
4818	CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible','','')
4819
4820	ENDIF
4821	END IF
4822	ENDDO
4823
4824	IF ( (sgn .LT. min_sechiba) .OR. (atext(ib) .LT. min_sechiba)) THEN
4825	! Set default values if grid cells were only covered by glaciers or ocean
4826	! or if now information on the source grid was found.
4827	nbexp = nbexp + 1
4828	njsc(ib) = usda_default ! 6 = Loam
4829	clayfraction(ib) = clayfrac_usda(usda_default)
4830	sandfraction(ib) = sandfrac_usda(usda_default)
4831	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4832	ELSE
4833	! Normalize using the fraction of surface not including glaciers and ocean
4834	soilclass(ib,:) = soilclass(ib,:)/sgn
4835	clayfraction(ib) = clayfraction(ib)/sgn
4836	sandfraction(ib) = sandfraction(ib)/sgn
4837	siltfraction(ib) = siltfraction(ib)/sgn
4838	njsc(ib) = MAXLOC(soilclass(ib,:),1) ! Dominant texture class
4839	ENDIF
4840	ENDIF
4841	ENDDO
4842
4843	! The "USDA" case reads a map of the 12 USDA texture classes,
4844	! such as to assign the corresponding soil properties
4845	CASE("usda")
4846	IF (printlev_loc>=2) WRITE(numout,*) "Using a soilclass map with usda classification"
4847
4848	ALLOCATE(textfrac_table(nscm,ntext), STAT=ALLOC_ERR)
4849	IF (ALLOC_ERR/=0) CALL ipslerr_p(3,'slowproc_soilt','Error in allocation for textfrac_table','','')
4850
4851	CALL get_soilcorr_usda (nscm, textfrac_table)
4852
4853	IF (printlev_loc>=4) WRITE (numout,*) 'slowproc_soilt: After get_soilcorr_usda'
4854	!
4855	DO ib =1, nbpt
4856	! GO through the point we have found
4857	!
4858	!
4859	! Provide which textures were found
4860	! vecpos: List of positions where textures were not zero
4861	! vecpos(1): number of not null textures found
4862	vecpos = interpweight_ValVecR(textrefrac(ib,:),ntextinfile,zero,'neq')
4863	fopt = vecpos(1)
4864
4865	!
4866	! Check that we found some points
4867	!
4868	soilclass(ib,:) = 0.0
4869	clayfraction(ib) = 0.0
4870	sandfraction(ib) = 0.0
4871	siltfraction(ib) = 0.0
4872
4873	IF ( fopt .EQ. 0) THEN
4874	! No points were found for current grid box, use default values
4875	IF (printlev_loc>=3) WRITE(numout,*)'slowproc_soilt: no soil class in input file found for point=', ib
4876	nbexp = nbexp + 1
4877	njsc(ib) = usda_default ! 6 = Loam
4878	clayfraction(ib) = clayfrac_usda(usda_default)
4879	sandfraction(ib) = sandfrac_usda(usda_default)
4880	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4881	ELSE
4882	IF (fopt == nscm) THEN
4883	! All textures are not zero
4884	solt(:) = (/(i,i=1,nscm)/)
4885	ELSE
4886	DO ilf = 1,fopt
4887	solt(ilf) = vecpos(ilf+1)
4888	END DO
4889	END IF
4890	!
4891	! Compute the fraction of each textural class
4892	DO ilf = 1,fopt
4893	IF ( (solt(ilf) .LE. nscm) .AND. (solt(ilf) .GT. 0) ) THEN
4894	soilclass(ib,solt(ilf)) = textrefrac(ib,solt(ilf))
4895	clayfraction(ib) = clayfraction(ib) + textfrac_table(solt(ilf),3) * &
4896	textrefrac(ib,solt(ilf))
4897	sandfraction(ib) = sandfraction(ib) + textfrac_table(solt(ilf),2) * &
4898	textrefrac(ib,solt(ilf))
4899	siltfraction(ib) = siltfraction(ib) + textfrac_table(solt(ilf),1) * &
4900	textrefrac(ib,solt(ilf))
4901	ELSE
4902	IF (solt(ilf) .GT. nscm) THEN
4903	WRITE(,) 'The file contains a soil color class which is incompatible with this program'
4904	CALL ipslerr_p(3,'slowproc_soilt','Problem soil color class incompatible 2','','')
4905	ENDIF
4906	ENDIF
4907	!
4908	ENDDO
4909
4910	njsc(ib) = MAXLOC(soilclass(ib,:),1) ! Dominant texture class
4911
4912	! Set default values if the surface in source file is too small
4913	! Warning - This test is donne differently for Zobler (based on sgn, related to class 6=ice)
4914	IF ( atext(ib) .LT. min_sechiba) THEN
4915	nbexp = nbexp + 1
4916	njsc(ib) = usda_default ! 6 = Loam
4917	clayfraction(ib) = clayfrac_usda(usda_default)
4918	sandfraction(ib) = sandfrac_usda(usda_default)
4919	siltfraction(ib) = 1.-clayfrac_usda(usda_default)-sandfrac_usda(usda_default)
4920	ENDIF
4921	ENDIF
4922
4923	ENDDO
4924
4925	IF (printlev_loc>=4) WRITE (numout,*) ' slowproc_soilt: End case usda'
4926
4927	CASE DEFAULT
4928	WRITE(numout,*) 'slowproc_soilt _______'
4929	WRITE(numout,*) ' A non supported soil type classification has been chosen'
4930	CALL ipslerr_p(3,'slowproc_soilt','non supported soil type classification','','')
4931	ENDSELECT
4932	IF (printlev_loc >= 5 ) WRITE(numout,*)' slowproc_soilt end of type classification'
4933
4934	IF ( nbexp .GT. 0 ) THEN
4935	WRITE(numout,*) 'slowproc_soilt:'
4936	WRITE(numout,*) ' The interpolation of variable soiltext had ', nbexp
4937	WRITE(numout,*) ' points without data. This are either coastal points or ice covered land.'
4938	WRITE(numout,*) ' The problem was solved by using the default soil types.'
4939	ENDIF
4940
4941	IF (ALLOCATED(variabletypevals)) DEALLOCATE (variabletypevals)
4942	IF (ALLOCATED(textrefrac)) DEALLOCATE (textrefrac)
4943	IF (ALLOCATED(solt)) DEALLOCATE (solt)
4944	IF (ALLOCATED(textfrac_table)) DEALLOCATE (textfrac_table)
4945
4946	ENDIF ! xios_interpolation
4947
4948
4949	! End of soil texture reading, for 'maps' and classical behavior
4950
4951	IF (spmipexp == 'maps') THEN
4952	IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_soilt: Read soil hydraulic parameters with IOIPSL'
4953
4954	! Read using IOIPSL and interpolate using aggregate tool in ORCHIDEE
4955
4956	!Config Key = PARAM_FILE
4957	!Config Desc = Name of file from which soil parameter values are read
4958	!Config Def = params_sp_mip.nc
4959	!Config Help = The name of the file to be opened to read values of parameters.
4960	!Config The data from this file is then interpolated to the grid of
4961	!Config of the model.
4962	!Config Units = [FILE]
4963	!
4964	! params_sp_mip.nc file is 0.5 deg soil hydraulic parameters file provided by sp_mip
4965
4966	filename = 'params_sp_mip.nc'
4967	CALL getin_p('PARAM_FILE',filename)
4968
4969	!! Variables for interpweight
4970	! Type of calculation of cell fractions
4971	fractype = 'default'
4972	! Name of the longitude and latitude in the input file
4973	lonname = 'nav_lon'
4974	latname = 'nav_lat'
4975	! Assigning values to vmin, vmax (there are not types/categories
4976	vmin =0.
4977	vmax = 99999.
4978	!! Variables for interpweight
4979	! Should negative values be set to zero from input file?
4980	nonegative = .FALSE.
4981	! Type of mask to apply to the input data (see header for more details)
4982	maskingtype = 'mabove'
4983	! Values to use for the masking
4984	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
4985	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') ( not used)
4986	namemaskvar = ''
4987
4988	variablename = 'ks'
4989	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_soilt: Read and interpolate " &
4990	// TRIM(filename) // " for variable " // TRIM(variablename)
4991	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
4992	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
4993	maskvals, namemaskvar, -1, fractype, 0., 0., &
4994	ks, aparam)
4995	WRITE(numout,*) 'ks map is read _______'
4996
4997	variablename = 'alpha'
4998	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
4999	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5000	maskvals, namemaskvar, -1, fractype, 0., 0., &
5001	avan, aparam)
5002	WRITE(numout,*) 'avan map read _______'
5003
5004	variablename = 'thetar'
5005	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5006	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5007	maskvals, namemaskvar, -1, fractype, 0., 0., &
5008	mcr, aparam)
5009	WRITE(numout,*) 'thetar map read _______'
5010
5011	variablename = 'thetas'
5012	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5013	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5014	maskvals, namemaskvar, -1, fractype, 0., 0., &
5015	mcs, aparam)
5016	WRITE(numout,*) 'thetas map read _______'
5017
5018	variablename = 'thetapwpvg' ! mcw
5019	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5020	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5021	maskvals, namemaskvar, -1, fractype, 0., 0., &
5022	mcw, aparam)
5023	WRITE(numout,*) 'thetapwpvg map read _______'
5024
5025	variablename = 'thetafcvg' !mcfc
5026	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5027	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5028	maskvals, namemaskvar, -1, fractype, 0., 0., &
5029	mcfc, aparam)
5030	WRITE(numout,*) 'thetafcvg map read _______'
5031
5032	variablename = 'nvg'
5033	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5034	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5035	maskvals, namemaskvar, -1, fractype, 0., 0., &
5036	nvan, aparam)
5037	WRITE(numout,*) 'nvan map read _______'
5038
5039	ELSE ! spmipexp is not maps nor unif, then it must be texture
5040	IF (spmipexp == 'texture') THEN
5041	! Whichever the soil texture map, we can use the USDA parameter vectors with 13 values
5042	nvan(:) = nvan_usda(njsc(:))
5043	avan(:) = avan_usda(njsc(:))
5044	mcr(:) = mcr_usda(njsc(:))
5045	mcs(:) = mcs_usda(njsc(:))
5046	ks(:) = ks_usda(njsc(:))
5047	!!$ mcfc(:) = mcf_usda(njsc(:))
5048	!!$ mcw(:) = mcw_usda(njsc(:))
5049
5050	!! Calculation of FC and WP based on above 5 parameters
5051	mvan(:) = un - (un / nvan(:))
5052	! Define matrix potential in mm for wilting point and field capacity (with sand vs clay-silt variation)
5053	psi_w(:) = 150000.
5054	DO ib=1, nbpt
5055	IF ( ks(ib) .GE. 560 ) THEN ! Sandy soils (560 is equivalent of 2.75 at log scale of Ks, mm/d)
5056	psi_fc(ib) = 1000.
5057	ELSE ! Finer soils
5058	psi_fc(ib) = 3300.
5059	ENDIF
5060	ENDDO
5061	mcfc(:) = mcr(:) + (( mcs(:) - mcr(:)) / (un + ( avan(:) * psi_fc(:)) nvan(:)) mvan(:))
5062	mcw(:) = mcr(:) + (( mcs(:) - mcr(:)) / (un + ( avan(:) * psi_w(:)) nvan(:)) mvan(:))
5063
5064	ELSE ! if spmipexp is not among texture or maps or unif
5065	WRITE(numout,*) "Unsupported spmipexp=",spmipexp
5066	WRITE(numout,*) "Choose between texture, maps, and unif"
5067	CALL ipslerr_p(3,'soilproc_soilt','Bad choice of spmipexp','Choose between texture, maps, and unif','')
5068	ENDIF
5069	ENDIF
5070	ENDIF ! SPMIPEXP
5071
5072
5073	!!
5074	!! Read and interpolate soil bulk and soil ph using IOIPSL or XIOS
5075	!!
5076	IF (xios_interpolation) THEN
5077	! Read and interpolate using XIOS
5078
5079	! Check if the restart file for sechiba is read.
5080	! Reading of soilbulk and soilph with XIOS is only activated if restname==NONE.
5081	IF (restname_in /= 'NONE') THEN
5082	CALL ipslerr_p(3,'slowproc_soilt','soilbulk and soilph can not be read with XIOS if sechiba restart file exist',&
5083	'Remove sechiba restart file and start again','')
5084	END IF
5085
5086	IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_soilt: Read soilbulk and soilph with XIOS'
5087	CALL xios_orchidee_recv_field('soilbulk', bulk)
5088	CALL xios_orchidee_recv_field('soilph', soil_ph)
5089
5090	ELSE
5091	! Read using IOIPSL and interpolate using aggregate tool in ORCHIDEE
5092	IF (printlev_loc>=3) WRITE (numout,*) 'slowproc_soilt: Read soilbulk and soilph with IOIPSL'
5093
5094	!! Read soilbulk
5095
5096	!Config Key = SOIL_BULK_FILE
5097	!Config Desc = Name of file from which soil bulk should be read
5098	!Config Def = soil_bulk_and_ph.nc
5099	!Config If =
5100	!Config Help =
5101	!Config Units = [FILE]
5102
5103	! By default, bulk and ph is stored in the same file but they could be separated if needed.
5104	filename = 'soil_bulk_and_ph.nc'
5105	CALL getin_p('SOIL_BULK_FILE',filename)
5106
5107	fieldname= 'soilbulk'
5108	! Name of the longitude and latitude in the input file
5109	lonname = 'nav_lon'
5110	latname = 'nav_lat'
5111	vmin=0 ! not used in interpweight_2Dcont
5112	vmax=0 ! not used in interpweight_2Dcont
5113
5114	! Should negative values be set to zero from input file?
5115	nonegative = .FALSE.
5116	! Type of mask to apply to the input data (see header for more details)
5117	maskingtype = 'mabove'
5118	! Values to use for the masking
5119	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
5120	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') ( not used)
5121	namemaskvar = ''
5122	! Type of calculation of cell fractions
5123	fractype = 'default'
5124	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5125	contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5126	maskvals, namemaskvar, -1, fractype, bulk_default, undef_sechiba, &
5127	bulk, abulkph)
5128
5129	!! Read soilph
5130
5131	!Config Key = SOIL_PH_FILE
5132	!Config Desc = Name of file from which soil ph should be read
5133	!Config Def = soil_bulk_and_ph.nc
5134	!Config If =
5135	!Config Help =
5136	!Config Units = [FILE]
5137
5138	filename = 'soil_bulk_and_ph.nc'
5139	CALL getin_p('SOIL_PH_FILE',filename)
5140
5141	fieldname= 'soilph'
5142	! Name of the longitude and latitude in the input file
5143	lonname = 'nav_lon'
5144	latname = 'nav_lat'
5145	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5146	contfrac, filename, fieldname, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5147	maskvals, namemaskvar, -1, fractype, ph_default, undef_sechiba, &
5148	soil_ph, abulkph)
5149
5150	END IF ! xios_interpolation
5151
5152
5153	! Write diagnostics
5154	CALL xios_orchidee_send_field("interp_avail_atext",atext)
5155	CALL xios_orchidee_send_field("interp_diag_soilclass",soilclass)
5156	CALL xios_orchidee_send_field("interp_diag_njsc",REAL(njsc, r_std))
5157	CALL xios_orchidee_send_field("interp_diag_clayfraction",clayfraction)
5158	CALL xios_orchidee_send_field("interp_diag_sandfraction",sandfraction)
5159	CALL xios_orchidee_send_field("interp_diag_siltfraction",siltfraction)
5160	CALL xios_orchidee_send_field("interp_diag_bulk",bulk)
5161	CALL xios_orchidee_send_field("interp_diag_soil_ph",soil_ph)
5162
5163	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_soilt ended'
5164
5165	END SUBROUTINE slowproc_soilt
5166
5167	!! ================================================================================================================================
5168	!! SUBROUTINE : slowproc_slope
5169	!!
5170	!>\BRIEF Calculate mean slope coef in each model grid box from the slope map
5171	!!
5172	!! DESCRIPTION : (definitions, functional, design, flags):
5173	!!
5174	!! RECENT CHANGE(S): None
5175	!!
5176	!! MAIN OUTPUT VARIABLE(S): ::reinf_slope
5177	!!
5178	!! REFERENCE(S) : None
5179	!!
5180	!! FLOWCHART : None
5181	!! \n
5182	!_ ================================================================================================================================
5183
5184	SUBROUTINE slowproc_slope(nbpt, lalo, neighbours, resolution, contfrac, reinf_slope)
5185
5186	USE interpweight
5187
5188	IMPLICIT NONE
5189
5190	!
5191	!
5192	!
5193	! 0.1 INPUT
5194	!
5195	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs to be interpolated
5196	REAL(r_std), INTENT(in) :: lalo(nbpt,2) !! Vector of latitude and longitudes (beware of the order !)
5197	INTEGER(i_std), INTENT(in) :: neighbours(nbpt,NbNeighb) !! Vector of neighbours for each grid point
5198	!! (1=North and then clockwise)
5199	REAL(r_std), INTENT(in) :: resolution(nbpt,2) !! The size in km of each grid-box in X and Y
5200	REAL(r_std), INTENT (in) :: contfrac(nbpt) !! Fraction of continent in the grid
5201	!
5202	! 0.2 OUTPUT
5203	!
5204	REAL(r_std), INTENT(out) :: reinf_slope(nbpt) !! slope coef
5205	!
5206	! 0.3 LOCAL
5207	!
5208	!
5209	REAL(r_std) :: slope_noreinf !! Slope above which runoff is maximum
5210	CHARACTER(LEN=80) :: filename
5211	REAL(r_std) :: vmin, vmax !! min/max values to use for the
5212	!! renormalization
5213	REAL(r_std), DIMENSION(nbpt) :: aslope !! slope availability
5214
5215	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
5216	CHARACTER(LEN=80) :: lonname, latname !! lon, lat name in the input file
5217	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
5218	!! 'XYKindTime': Input values are kinds
5219	!! of something with a temporal
5220	!! evolution on the dx*dy matrix'
5221	LOGICAL :: nonegative !! whether negative values should be removed
5222	CHARACTER(LEN=50) :: maskingtype !! Type of masking
5223	!! 'nomask': no-mask is applied
5224	!! 'mbelow': take values below maskvals(1)
5225	!! 'mabove': take values above maskvals(1)
5226	!! 'msumrange': take values within 2 ranges;
5227	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
5228	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
5229	!! (normalized by maskvals(3))
5230	!! 'var': mask values are taken from a
5231	!! variable inside the file (>0)
5232	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
5233	!! `maskingtype')
5234	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
5235
5236	!_ ================================================================================================================================
5237
5238
5239	!Config Key = SLOPE_NOREINF
5240	!Config Desc = Slope over which surface runoff does not reinfiltrate
5241	!Config If =
5242	!Config Def = 0.5
5243	!Config Help = The slope above which there is no reinfiltration
5244	!Config Units = [%]
5245	!
5246	slope_noreinf = 0.5
5247	CALL getin_p('SLOPE_NOREINF',slope_noreinf)
5248	!
5249	!Config Key = TOPOGRAPHY_FILE
5250	!Config Desc = Name of file from which the topography map is to be read
5251	!Config Def = cartepente2d_15min.nc
5252	!Config If =
5253	!Config Help = The name of the file to be opened to read the orography
5254	!Config map is to be given here. Usualy SECHIBA runs with a 2'
5255	!Config map which is derived from the NGDC one.
5256	!Config Units = [FILE]
5257	!
5258	filename = 'cartepente2d_15min.nc'
5259	CALL getin_p('TOPOGRAPHY_FILE',filename)
5260
5261	IF (xios_interpolation) THEN
5262
5263	CALL xios_orchidee_recv_field('reinf_slope_interp',reinf_slope)
5264	CALL xios_orchidee_recv_field('frac_slope_interp',aslope)
5265
5266
5267	ELSE
5268
5269	variablename = 'pente'
5270	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_slope: Read and interpolate " &
5271	// TRIM(filename) // " for variable " // TRIM(variablename)
5272
5273	! For this case there are not types/categories. We have 'only' a continuos field
5274	! Assigning values to vmin, vmax
5275	vmin = 0.
5276	vmax = 9999.
5277
5278	!! Variables for interpweight
5279	! Type of calculation of cell fractions
5280	fractype = 'slopecalc'
5281	! Name of the longitude and latitude in the input file
5282	lonname = 'longitude'
5283	latname = 'latitude'
5284	! Should negative values be set to zero from input file?
5285	nonegative = .FALSE.
5286	! Type of mask to apply to the input data (see header for more details)
5287	maskingtype = 'mabove'
5288	! Values to use for the masking
5289	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
5290	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
5291	namemaskvar = ''
5292
5293	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5294	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5295	maskvals, namemaskvar, -1, fractype, slope_default, slope_noreinf, &
5296	reinf_slope, aslope)
5297	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_slope after interpweight_2Dcont'
5298
5299	ENDIF
5300
5301	! Write diagnostics
5302	CALL xios_orchidee_send_field("interp_avail_aslope",aslope)
5303	CALL xios_orchidee_send_field("interp_diag_reinf_slope",reinf_slope)
5304
5305	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_slope ended'
5306
5307	END SUBROUTINE slowproc_slope
5308
5309
5310	!! ================================================================================================================================
5311	!! SUBROUTINE : slowproc_xios_initialize_ninput
5312	!!
5313	!>\BRIEF Activates or not reading of ninput file
5314	!!
5315	!!
5316	!! DESCRIPTION : This subroutine activates or not the variables in the xml files related to the reading of input files.
5317	!! The subroutine is called from slowproc_xios_initialization only if xios_orchidee_ok is activated. Therefor
5318	!! the reading from run.def done in here are duplications and will be done again in slowproc_Ninput.
5319	!! MAIN OUTPUT VARIABLE(S):
5320	!!
5321	!! REFERENCE(S) : None.
5322	!!
5323	!! FLOWCHART : None.
5324	!! \n
5325	!_ ================================================================================================================================
5326
5327	SUBROUTINE slowproc_xios_initialize_ninput(Ninput_field, flag)
5328
5329	CHARACTER(LEN=*), INTENT(in) :: Ninput_field !! Name of the default field reading in the map
5330	LOGICAL, INTENT(in) :: flag !! Condition where the file will be read
5331	CHARACTER(LEN=80) :: filename
5332	CHARACTER(LEN=80) :: varname
5333	INTEGER :: ninput_update_loc
5334	INTEGER :: l
5335	CHARACTER(LEN=30) :: ninput_str
5336
5337	! Read from run.def file and variable name for the current field: Ninput_field_FILE, Ninput_field_VAR
5338	filename = TRIM(Ninput_field)//'.nc'
5339	CALL getin_p(TRIM(Ninput_field)//'_FILE',filename)
5340
5341	varname=Ninput_field
5342	CALL getin_p(TRIM(Ninput_field)//'_VAR',varname)
5343
5344	! Read from run.def the number of years set in the variable NINPUT_UPDATE
5345	ninput_update_loc=0
5346	WRITE(ninput_str,'(a)') '0Y'
5347	CALL getin_p('NINPUT_UPDATE', ninput_str)
5348	l=INDEX(TRIM(ninput_str),'Y')
5349	READ(ninput_str(1:(l-1)),"(I2.2)") ninput_update_loc
5350
5351	! Determine if reading with XIOS will be done in this executaion.
5352	! Activate files and fields in the xml files if reading will be done with
5353	! XIOS in this run. Otherwise deactivate the files.
5354	IF (flag .AND. (restname_in=='NONE' .OR. (ninput_update_loc>0)) .AND. &
5355	(TRIM(filename) .NE. 'NONE') .AND. (TRIM(filename) .NE. 'none')) THEN
5356	IF (xios_interpolation) THEN
5357	! Reading will be done with XIOS later
5358	IF (printlev>=1) WRITE(numout,*) 'Reading of ',TRIM(Ninput_field), &
5359	' will be done later with XIOS. File and variable name are ',filename, varname
5360	CALL xios_orchidee_set_file_attr(TRIM(Ninput_field)//'_file',enabled=.TRUE., name=filename(1:LEN_TRIM(filename)-3))
5361	CALL xios_orchidee_set_field_attr(TRIM(Ninput_field)//'_read',enabled=.TRUE., name=TRIM(varname))
5362	CALL xios_orchidee_set_field_attr('mask_'//TRIM(Ninput_field)//'_read',enabled=.TRUE., name=TRIM(varname))
5363	ELSE
5364	! Reading will be done with IOIPSL later
5365	! Deactivate file specification in xml files
5366	IF (printlev>=1) WRITE(numout,*) 'Reading of ',TRIM(Ninput_field), &
5367	' will be done with IOIPSL. File and variable name are ',filename, varname
5368	CALL xios_orchidee_set_file_attr(TRIM(Ninput_field)//'_file',enabled=.FALSE.)
5369	CALL xios_orchidee_set_field_attr(TRIM(Ninput_field)//'_interp',enabled=.FALSE.)
5370	END IF
5371	ELSE
5372	! No reading will be done, deactivate corresponding file declared in context_input_orchidee.xml
5373	IF (printlev>=1) WRITE(numout,*) 'No reading of ',TRIM(Ninput_field),' will be done'
5374	CALL xios_orchidee_set_file_attr(TRIM(Ninput_field)//'_file',enabled=.FALSE.)
5375	CALL xios_orchidee_set_field_attr(TRIM(Ninput_field)//'_interp',enabled=.FALSE.)
5376
5377	! Deactivate controle output diagnostic field not needed since no interpolation
5378	CALL xios_orchidee_set_field_attr("interp_diag_"//TRIM(Ninput_field),enabled=.FALSE.)
5379	END IF
5380
5381	END SUBROUTINE slowproc_xios_initialize_ninput
5382
5383
5384	!! ================================================================================================================================
5385	!! SUBROUTINE : slowproc_Ninput
5386	!!
5387	!>\BRIEF Reads in the maps containing nitrogen inputs
5388	!!
5389	!!
5390	!! DESCRIPTION : This subroutine reads in various maps containing information on the amount of nitrogen inputed
5391	!! to the system via manure, fertilizer, atmospheric deposition, and biological nitrogen fixation.
5392	!! The information is read in for a single year for all pixels present in the simulation, and
5393	!! interpolated to the resolution being used for the current run.
5394	!!
5395	!! RECENT CHANGE(S):
5396	!!
5397	!! MAIN OUTPUT VARIABLE(S): Ninput_vec
5398	!!
5399	!! REFERENCE(S) : None.
5400	!!
5401	!! FLOWCHART : None.
5402	!! \n
5403	!_ ================================================================================================================================
5404
5405
5406
5407	SUBROUTINE slowproc_Ninput(nbpt, lalo, neighbours, resolution, contfrac, &
5408	Ninput_field, Ninput_vec, Ninput_year)
5409
5410	!
5411	!! 0. Variable and parameter declaration
5412	!
5413
5414	!
5415	!! 0.1 Input variables
5416	!
5417	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs to be interpolated
5418	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo !! Vector of latitude and longitudes (beware of the order !)
5419	INTEGER(i_std), DIMENSION(nbpt,8), INTENT(in) :: neighbours !! Vector of neighbours for each grid point
5420	! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
5421	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution !! The size in km of each grid-box in X and Y
5422	REAL(r_std), DIMENSION(nbpt), INTENT(in) :: contfrac !! Fraction of continent in the grid
5423	CHARACTER(LEN=80), INTENT(in) :: Ninput_field !! Name of the default field reading in the map
5424	INTEGER(i_std), INTENT(in) :: Ninput_year !! year for N inputs update
5425
5426	!
5427	!! 0.2 Modified variables
5428	!
5429
5430	!
5431	!! 0.3 Output variables
5432	!
5433	REAL(r_std), DIMENSION(nbpt, nvm,12), INTENT(out) :: Ninput_vec !! Nitrogen input (kgN m-2 yr-1)
5434
5435	!! 0.4 Local variables
5436	!
5437	CHARACTER(LEN=80) :: filename
5438	CHARACTER(LEN=30) :: callsign
5439	INTEGER(i_std) :: iml, jml, lml, tml, fid, ib, ip, jp, vid, l, im
5440	INTEGER(i_std) :: idi, idi_last, nbvmax
5441	REAL(r_std) :: coslat
5442	REAL(r_std), DIMENSION(12) :: Ninput_val
5443	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
5444	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index
5445	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel
5446	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: Ninput_map
5447	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lat_lu, lon_lu
5448	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area
5449	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:) :: resol_lu
5450	REAL(r_std) :: Ninput_read(nbpt,12) !! Nitrogen input temporary variable
5451	INTEGER(i_std) :: nix, njx, iv, i
5452	!
5453	LOGICAL :: ok_interpol = .FALSE. !! optionnal return of aggregate_2d
5454	!
5455	INTEGER :: ALLOC_ERR
5456	CHARACTER(LEN=80) :: Ninput_field_read !! Name of the field reading in the map
5457	CHARACTER(LEN=80) :: Ninput_year_str !! Ninput year as a string variable
5458	LOGICAL :: latitude_exists, longitude_exists !! Test existence of variables in the input files
5459	!_ ================================================================================================================================
5460
5461
5462
5463	!Config Key = NINPUT File
5464	!Config Desc = Name of file from which the N-input map is to be read
5465	!Config Def = 'Ninput_fied'.nc
5466	!Config If =
5467	!Config Help = The name of the file to be opened to read the N-input map
5468	!Config Units = [FILE]
5469	!
5470	filename = TRIM(Ninput_field)//'.nc'
5471	CALL getin_p(TRIM(Ninput_field)//'_FILE',filename)
5472
5473	!Config Key = NINPUT var
5474	!Config Desc = Name of the variable in the file from which the N-input map is to be read
5475	!Config Def = 'Ninput_field'
5476	!Config If =
5477	!Config Help = The name of the variable to be read for the N-input map
5478	!Config Units = [FILE]
5479	!
5480	Ninput_field_read=Ninput_field
5481	CALL getin_p(TRIM(Ninput_field)//'_VAR',Ninput_field_read)
5482	!
5483	IF((TRIM(filename) .NE. 'NONE') .AND. (TRIM(filename) .NE. 'none')) THEN
5484
5485	IF(Ninput_suffix_year) THEN
5486	l=INDEX(TRIM(filename),'.nc')
5487	WRITE(Ninput_year_str,'(i4)') Ninput_year
5488	filename=TRIM(filename(1:(l-1)))//'_'//Ninput_year_str//'.nc'
5489	ENDIF
5490
5491	IF (xios_interpolation) THEN
5492
5493	! Read and interpolate with XIOS
5494	IF (TRIM(Ninput_field)=='Nammonium' .OR. TRIM(Ninput_field)=='Nnitrate') THEN
5495	! For these 2 fields, 12 time step exist in the file
5496	CALL xios_orchidee_recv_field(TRIM(Ninput_field)//'_interp',Ninput_read)
5497	ELSE
5498	! For the other fields, only 1 time step exist in the file
5499	CALL xios_orchidee_recv_field(TRIM(Ninput_field)//'_interp',Ninput_read(:,1))
5500	DO i=2,12
5501	Ninput_read(:,i) = Ninput_read(:,1)
5502	END DO
5503	END IF
5504
5505	ELSE
5506
5507	! Read with IOIPSL and interpolate with aggregate
5508	IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
5509	CALL bcast(iml)
5510	CALL bcast(jml)
5511	CALL bcast(lml)
5512	CALL bcast(tml)
5513
5514	ALLOCATE(lat_lu(jml), STAT=ALLOC_ERR)
5515	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable lat_lu','','')
5516
5517	ALLOCATE(lon_lu(iml), STAT=ALLOC_ERR)
5518	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable lon_lu','','')
5519
5520	ALLOCATE(Ninput_map(iml,jml,tml), STAT=ALLOC_ERR)
5521	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable Ninput_map','','')
5522
5523	ALLOCATE(resol_lu(iml,jml,2), STAT=ALLOC_ERR)
5524	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_ninput','Problem in allocation of variable resol_lu','','')
5525
5526	WRITE(numout,*) 'Reading the Ninput file'
5527
5528	IF (is_root_prc) THEN
5529	CALL flinquery_var(fid, 'longitude', longitude_exists)
5530	IF(longitude_exists)THEN
5531	CALL flinget(fid, 'longitude', iml, 0, 0, 0, 1, 1, lon_lu)
5532	ELSE
5533	CALL flinget(fid, 'lon', iml, 0, 0, 0, 1, 1, lon_lu)
5534	ENDIF
5535	CALL flinquery_var(fid, 'latitude', latitude_exists)
5536	IF(latitude_exists)THEN
5537	CALL flinget(fid, 'latitude', jml, 0, 0, 0, 1, 1, lat_lu)
5538	ELSE
5539	CALL flinget(fid, 'lat', jml, 0, 0, 0, 1, 1, lat_lu)
5540	ENDIF
5541	CALL flinget(fid, Ninput_field_read, iml, jml, 0, tml, 1, tml, Ninput_map)
5542	!
5543	CALL flinclo(fid)
5544	ENDIF
5545	CALL bcast(lon_lu)
5546	CALL bcast(lat_lu)
5547	CALL bcast(Ninput_map)
5548
5549
5550	ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
5551	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lon_rel','','')
5552
5553	ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
5554	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable lat_rel','','')
5555
5556	DO ip=1,iml
5557	lat_rel(ip,:) = lat_lu(:)
5558	ENDDO
5559	DO jp=1,jml
5560	lon_rel(:,jp) = lon_lu(:)
5561	ENDDO
5562	!
5563	!
5564	! Mask of permitted variables.
5565	!
5566	ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
5567	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_slope','Problem in allocation of variable mask','','')
5568
5569	mask(:,:) = zero
5570	DO ip=1,iml
5571	DO jp=1,jml
5572	IF (ANY(Ninput_map(ip,jp,:) .GE. 0.)) THEN
5573	mask(ip,jp) = un
5574	ENDIF
5575	!
5576	! Resolution in longitude
5577	!
5578	coslat = MAX( COS( lat_rel(ip,jp) * pi/180. ), mincos )
5579	IF ( ip .EQ. 1 ) THEN
5580	resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip,jp) ) * pi/180. * R_Earth * coslat
5581	ELSEIF ( ip .EQ. iml ) THEN
5582	resol_lu(ip,jp,1) = ABS( lon_rel(ip,jp) - lon_rel(ip-1,jp) ) * pi/180. * R_Earth * coslat
5583	ELSE
5584	resol_lu(ip,jp,1) = ABS( lon_rel(ip+1,jp) - lon_rel(ip-1,jp) )/2. * pi/180. * R_Earth * coslat
5585	ENDIF
5586	!
5587	! Resolution in latitude
5588	!
5589	IF ( jp .EQ. 1 ) THEN
5590	resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp) - lat_rel(ip,jp+1) ) * pi/180. * R_Earth
5591	ELSEIF ( jp .EQ. jml ) THEN
5592	resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp) ) * pi/180. * R_Earth
5593	ELSE
5594	resol_lu(ip,jp,2) = ABS( lat_rel(ip,jp-1) - lat_rel(ip,jp+1) )/2. * pi/180. * R_Earth
5595	ENDIF
5596	!
5597	ENDDO
5598	ENDDO
5599	!
5600	!
5601	! The number of maximum vegetation map points in the GCM grid is estimated.
5602	! Some lmargin is taken.
5603	!
5604	IF (is_root_prc) THEN
5605	nix=INT(MAXVAL(resolution_g(:,1))/MAXVAL(resol_lu(:,:,1)))+2
5606	njx=INT(MAXVAL(resolution_g(:,2))/MAXVAL(resol_lu(:,:,2)))+2
5607	nbvmax = nix*njx
5608	ENDIF
5609	CALL bcast(nbvmax)
5610	!
5611	callsign="Ninput map"
5612	ok_interpol = .FALSE.
5613	DO WHILE ( .NOT. ok_interpol )
5614	!
5615	WRITE(numout,*) "Projection arrays for ",callsign," : "
5616	WRITE(numout,*) "nbvmax = ",nbvmax
5617
5618	ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
5619	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_Ninput','Problem in allocation of variable sub_index','','')
5620	sub_index(:,:,:)=0
5621
5622	ALLOCATE(sub_area(nbpt,nbvmax), STAT=ALLOC_ERR)
5623	IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'slowproc_Ninput','Problem in allocation of variable sub_area','','')
5624	sub_area(:,:)=zero
5625
5626	CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
5627	& iml, jml, lon_rel, lat_rel, mask, callsign, &
5628	& nbvmax, sub_index, sub_area, ok_interpol)
5629
5630	IF (.NOT. ok_interpol ) THEN
5631	IF (printlev_loc>=3) WRITE(numout,) 'nbvmax will be increased from ',nbvmax,' to ', nbvmax2
5632	DEALLOCATE(sub_area)
5633	DEALLOCATE(sub_index)
5634	nbvmax = nbvmax * 2
5635	END IF
5636	END DO
5637	!
5638	!
5639	DO ib = 1, nbpt
5640	Ninput_val(:) = zero
5641
5642	! Initialize last index to the highest possible
5643	idi_last=nbvmax
5644	DO idi=1, nbvmax
5645	! Leave the do loop if all sub areas are treated, sub_area <= 0
5646	IF ( sub_area(ib,idi) <= zero ) THEN
5647	! Set last index to the last one used
5648	idi_last=idi-1
5649	! Exit do loop
5650	EXIT
5651	END IF
5652
5653	ip = sub_index(ib,idi,1)
5654	jp = sub_index(ib,idi,2)
5655
5656	IF(tml == 12) THEN
5657	Ninput_val(:) = Ninput_val(:) + Ninput_map(ip,jp,:) * sub_area(ib,idi)
5658	ELSE
5659	Ninput_val(:) = Ninput_val(:) + Ninput_map(ip,jp,1) * sub_area(ib,idi)
5660	ENDIF
5661	ENDDO
5662
5663	IF ( idi_last >= 1 ) THEN
5664	Ninput_read(ib,:) = Ninput_val(:) / SUM(sub_area(ib,1:idi_last))
5665	ELSE
5666	CALL ipslerr_p(2,'slowproc_ninput', '', '',&
5667	& 'No information for a point') ! Warning error
5668	Ninput_read(ib,:) = 0.
5669	ENDIF
5670	ENDDO
5671	!
5672
5673	DEALLOCATE(Ninput_map)
5674	DEALLOCATE(sub_index)
5675	DEALLOCATE(sub_area)
5676	DEALLOCATE(mask)
5677	DEALLOCATE(lon_lu)
5678	DEALLOCATE(lat_lu)
5679	DEALLOCATE(lon_rel)
5680	DEALLOCATE(lat_rel)
5681
5682	END IF ! xios_interpolation
5683
5684	! Output the variables read for control only
5685	IF (TRIM(Ninput_field)=='Nammonium' .OR. TRIM(Ninput_field)=='Nnitrate') THEN
5686	! For these 2 fields, 12 time step exist in the file
5687	CALL xios_orchidee_send_field("interp_diag_"//TRIM(Ninput_field),Ninput_read)
5688	ELSE
5689	CALL xios_orchidee_send_field("interp_diag_"//TRIM(Ninput_field),Ninput_read(:,1))
5690	END IF
5691
5692	!
5693	! Initialize Ninput_vec
5694	Ninput_vec(:,:,:) = 0.
5695	SELECT CASE (Ninput_field)
5696	CASE ("Nammonium")
5697	DO iv = 1,nvm
5698	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5699	ENDDO
5700	CASE ("Nnitrate")
5701	DO iv = 1,nvm
5702	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5703	ENDDO
5704	CASE ("Nfert")
5705	DO iv = 2,nvm
5706	! Exclude bare soil. It is not fertilized
5707	IF ( .NOT. natural(iv) ) THEN
5708	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5709	ENDIF
5710	ENDDO
5711	CASE ("Nfert_cropland")
5712	DO iv = 2,nvm
5713	! Exclude bare soil. It is not fertilized
5714	IF ( .NOT. natural(iv) ) THEN
5715	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5716	ENDIF
5717	ENDDO
5718	CASE ("Nmanure_cropland")
5719	DO iv = 2,nvm
5720	! Exclude bare soil. It is not fertilized
5721	IF ( .NOT. natural(iv) ) THEN
5722	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5723	ENDIF
5724	ENDDO
5725	CASE ("Nfert_pasture")
5726	DO iv = 2,nvm
5727	! Exclude bare soil. It is not fertilized
5728	IF ( natural(iv) .AND. (.NOT.(is_tree(iv))) ) THEN
5729	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5730	ENDIF
5731	ENDDO
5732	CASE ("Nmanure_pasture")
5733	DO iv = 2,nvm
5734	! Exclude bare soil. It is not fertilized
5735	IF ( natural(iv) .AND. (.NOT.(is_tree(iv))) ) THEN
5736	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5737	ENDIF
5738	ENDDO
5739	CASE ("Nbnf")
5740	DO iv = 2,nvm
5741	! Exclude bare soil. No plants = no biological N fixation
5742	Ninput_vec(:,iv,:) = Ninput_read(:,:)
5743	ENDDO
5744	CASE default
5745	WRITE (numout,*) 'This kind of Ninput_field choice is not possible. '
5746	CALL ipslerr_p(3,'slowproc_ninput', '', '',&
5747	& 'This kind of Ninput_field choice is not possible.') ! Fatal error
5748	END SELECT
5749	!
5750	WRITE(numout,*) 'Interpolation Done in slowproc_Ninput for ',TRIM(Ninput_field)
5751	!
5752	!
5753	ELSE
5754	Ninput_vec(:,:,:)=zero
5755	ENDIF
5756
5757	END SUBROUTINE slowproc_Ninput
5758
5759	!! ================================================================================================================================
5760	!! SUBROUTINE : slowproc_woodharvest
5761	!!
5762	!>\BRIEF
5763	!!
5764	!! DESCRIPTION :
5765	!!
5766	!! RECENT CHANGE(S): None
5767	!!
5768	!! MAIN OUTPUT VARIABLE(S): ::
5769	!!
5770	!! REFERENCE(S) : None
5771	!!
5772	!! FLOWCHART : None
5773	!! \n
5774	!_ ================================================================================================================================
5775
5776	SUBROUTINE slowproc_woodharvest(nbpt, lalo, neighbours, resolution, contfrac, woodharvest)
5777
5778	USE interpweight
5779
5780	IMPLICIT NONE
5781
5782	!
5783	!
5784	!
5785	! 0.1 INPUT
5786	!
5787	INTEGER(i_std), INTENT(in) :: nbpt !! Number of points for which the data needs to be interpolated
5788	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo !! Vector of latitude and longitudes (beware of the order !)
5789	INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours !! Vector of neighbours for each grid point
5790	!! (1=North and then clockwise)
5791	REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution !! The size in km of each grid-box in X and Y
5792	REAL(r_std), DIMENSION(nbpt), INTENT(in) :: contfrac !! Fraction of continent in the grid
5793	!
5794	! 0.2 OUTPUT
5795	!
5796	REAL(r_std), DIMENSION(nbpt), INTENT(out) :: woodharvest !! Wood harvest
5797	!
5798	! 0.3 LOCAL
5799	!
5800	CHARACTER(LEN=80) :: filename
5801	REAL(r_std) :: vmin, vmax
5802	REAL(r_std), DIMENSION(nbpt) :: aoutvar !! availability of input data to
5803	!! interpolate output variable
5804	!! (on the nbpt space)
5805	CHARACTER(LEN=80) :: variablename !! Variable to interpolate
5806	CHARACTER(LEN=80) :: lonname, latname !! lon, lat name in the input file
5807	CHARACTER(LEN=50) :: fractype !! method of calculation of fraction
5808	!! 'XYKindTime': Input values are kinds
5809	!! of something with a temporal
5810	!! evolution on the dx*dy matrix'
5811	LOGICAL :: nonegative !! whether negative values should be removed
5812	CHARACTER(LEN=50) :: maskingtype !! Type of masking
5813	!! 'nomask': no-mask is applied
5814	!! 'mbelow': take values below maskvals(1)
5815	!! 'mabove': take values above maskvals(1)
5816	!! 'msumrange': take values within 2 ranges;
5817	!! maskvals(2) <= SUM(vals(k)) <= maskvals(1)
5818	!! maskvals(1) < SUM(vals(k)) <= maskvals(3)
5819	!! (normalized by maskvals(3))
5820	!! 'var': mask values are taken from a
5821	!! variable inside the file (>0)
5822	REAL(r_std), DIMENSION(3) :: maskvals !! values to use to mask (according to
5823	!! `maskingtype')
5824	CHARACTER(LEN=250) :: namemaskvar !! name of the variable to use to mask
5825	REAL(r_std), DIMENSION(1) :: variabletypevals !!
5826	! REAL(r_std), DIMENSION(nbp_mpi) :: woodharvest_mpi !! Wood harvest where all thredds OMP are gatherd
5827	!_ ================================================================================================================================
5828
5829
5830	!Config Key = WOODHARVEST_FILE
5831	!Config Desc = Name of file from which the wood harvest will be read
5832	!Config Def = woodharvest.nc
5833	!Config If = DO_WOOD_HARVEST
5834	!Config Help =
5835	!Config Units = [FILE]
5836	filename = 'woodharvest.nc'
5837	CALL getin_p('WOODHARVEST_FILE',filename)
5838	variablename = 'woodharvest'
5839
5840
5841	IF (xios_interpolation) THEN
5842	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readwoodharvest: Use XIOS to read and interpolate " &
5843	// TRIM(filename) // " for variable " // TRIM(variablename)
5844
5845	CALL xios_orchidee_recv_field('woodharvest_interp',woodharvest)
5846
5847	aoutvar = 1.0
5848	ELSE
5849
5850	IF (printlev_loc >= 1) WRITE(numout,*) "slowproc_readwoodharvest: Read and interpolate " &
5851	// TRIM(filename) // " for variable " // TRIM(variablename)
5852
5853	! For this case there are not types/categories. We have 'only' a continuos field
5854	! Assigning values to vmin, vmax
5855	vmin = 0.
5856	vmax = 9999.
5857
5858	!! Variables for interpweight
5859	! Type of calculation of cell fractions
5860	fractype = 'default'
5861	! Name of the longitude and latitude in the input file
5862	lonname = 'longitude'
5863	latname = 'latitude'
5864	! Should negative values be set to zero from input file?
5865	nonegative = .TRUE.
5866	! Type of mask to apply to the input data (see header for more details)
5867	maskingtype = 'nomask'
5868	! Values to use for the masking
5869	maskvals = (/ min_sechiba, undef_sechiba, undef_sechiba /)
5870	! Name of the variable with the values for the mask in the input file (only if maskkingtype='var') (here not used)
5871	namemaskvar = ''
5872
5873	variabletypevals=-un
5874	CALL interpweight_2Dcont(nbpt, 0, 0, lalo, resolution, neighbours, &
5875	contfrac, filename, variablename, lonname, latname, vmin, vmax, nonegative, maskingtype, &
5876	maskvals, namemaskvar, -1, fractype, 0., 0., woodharvest, aoutvar)
5877	IF (printlev_loc >= 5) WRITE(numout,*)' slowproc_wodharvest after interpweight_2Dcont'
5878
5879	END IF
5880
5881	! Write diagnostics
5882	CALL xios_orchidee_send_field("interp_diag_woodharvest",woodharvest)
5883
5884	IF (printlev_loc >= 3) WRITE(numout,*) ' slowproc_woodharvest ended'
5885	END SUBROUTINE slowproc_woodharvest
5886
5887
5888	!! ================================================================================================================================
5889	!! SUBROUTINE : get_soilcorr_zobler
5890	!!
5891	!>\BRIEF The "get_soilcorr" routine defines the table of correspondence
5892	!! between the Zobler types and the three texture types known by SECHIBA and STOMATE :
5893	!! silt, sand and clay.
5894	!!
5895	!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
5896	!! The data from this file is then interpolated to the grid of the model. \n
5897	!! The aim is to get fractions for sand loam and clay in each grid box.\n
5898	!! This information is used for soil hydrology and respiration.
5899	!!
5900	!!
5901	!! RECENT CHANGE(S): None
5902	!!
5903	!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
5904	!!
5905	!! REFERENCE(S) :
5906	!! - Zobler L., 1986, A World Soil File for global climate modelling. NASA Technical memorandum 87802. NASA
5907	!! Goddard Institute for Space Studies, New York, U.S.A.
5908	!!
5909	!! FLOWCHART : None
5910	!! \n
5911	!_ ================================================================================================================================
5912
5913	SUBROUTINE get_soilcorr_zobler (nzobler,textfrac_table)
5914
5915	IMPLICIT NONE
5916
5917	!! 0. Variables and parameters declaration
5918
5919	INTEGER(i_std),PARAMETER :: nbtypes_zobler = 7 !! Number of Zobler types (unitless)
5920
5921	!! 0.1 Input variables
5922
5923	INTEGER(i_std),INTENT(in) :: nzobler !! Size of the array (unitless)
5924
5925	!! 0.2 Output variables
5926
5927	REAL(r_std),DIMENSION(nzobler,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
5928	!! and granulometric composition (0-1, unitless)
5929
5930	!! 0.4 Local variables
5931
5932	INTEGER(i_std) :: ib !! Indice (unitless)
5933
5934	!_ ================================================================================================================================
5935
5936	!-
5937	! 0. Check consistency
5938	!-
5939	IF (nzobler /= nbtypes_zobler) THEN
5940	CALL ipslerr_p(3,'get_soilcorr', 'nzobler /= nbtypes_zobler',&
5941	& 'We do not have the correct number of classes', &
5942	& ' in the code for the file.') ! Fatal error
5943	ENDIF
5944
5945	!-
5946	! 1. Textural fraction for : silt sand clay
5947	!-
5948	textfrac_table(1,:) = (/ 0.12, 0.82, 0.06 /)
5949	textfrac_table(2,:) = (/ 0.32, 0.58, 0.10 /)
5950	textfrac_table(3,:) = (/ 0.39, 0.43, 0.18 /)
5951	textfrac_table(4,:) = (/ 0.15, 0.58, 0.27 /)
5952	textfrac_table(5,:) = (/ 0.34, 0.32, 0.34 /)
5953	textfrac_table(6,:) = (/ 0.00, 1.00, 0.00 /)
5954	textfrac_table(7,:) = (/ 0.39, 0.43, 0.18 /)
5955
5956
5957	!-
5958	! 2. Check the mapping for the Zobler types which are going into the ORCHIDEE textures classes
5959	!-
5960	DO ib=1,nzobler ! Loop over # classes soil
5961
5962	IF (ABS(SUM(textfrac_table(ib,:))-1.0) > EPSILON(un)) THEN ! The sum of the textural fractions should not exceed 1 !
5963	WRITE(numout,*) &
5964	& 'Error in the correspondence table', &
5965	& ' sum is not equal to 1 in', ib
5966	WRITE(numout,*) textfrac_table(ib,:)
5967	CALL ipslerr_p(3,'get_soilcorr', 'SUM(textfrac_table(ib,:)) /= 1.0',&
5968	& '', 'Error in the correspondence table') ! Fatal error
5969	ENDIF
5970
5971	ENDDO ! Loop over # classes soil
5972
5973
5974	END SUBROUTINE get_soilcorr_zobler
5975
5976	!! ================================================================================================================================
5977	!! SUBROUTINE : get_soilcorr_usda
5978	!!
5979	!>\BRIEF The "get_soilcorr_usda" routine defines the table of correspondence
5980	!! between the 12 USDA textural classes and their granulometric composition,
5981	!! as % of silt, sand and clay. This is used to further defien clayfraction.
5982	!!
5983	!! DESCRIPTION : get_soilcorr is needed if you use soils_param.nc .\n
5984	!! The data from this file is then interpolated to the grid of the model. \n
5985	!! The aim is to get fractions for sand loam and clay in each grid box.\n
5986	!! This information is used for soil hydrology and respiration.
5987	!! The default map in this case is derived from Reynolds et al 2000, \n
5988	!! at the 1/12deg resolution, with indices that are consistent with the \n
5989	!! textures tabulated below
5990	!!
5991	!! RECENT CHANGE(S): Created by A. Ducharne on July 02, 2014
5992	!!
5993	!! MAIN OUTPUT VARIABLE(S) : ::texfrac_table
5994	!!
5995	!! REFERENCE(S) :
5996	!!
5997	!! FLOWCHART : None
5998	!! \n
5999	!_ ================================================================================================================================
6000
6001	SUBROUTINE get_soilcorr_usda (nusda,textfrac_table)
6002
6003	IMPLICIT NONE
6004
6005	!! 0. Variables and parameters declaration
6006
6007	!! 0.1 Input variables
6008
6009	INTEGER(i_std),INTENT(in) :: nusda !! Size of the array (unitless)
6010
6011	!! 0.2 Output variables
6012
6013	REAL(r_std),DIMENSION(nusda,ntext),INTENT(out) :: textfrac_table !! Table of correspondence between soil texture class
6014	!! and granulometric composition (0-1, unitless)
6015
6016	!! 0.4 Local variables
6017
6018	INTEGER(i_std),PARAMETER :: nbtypes_usda = 13 !! Number of USDA texture classes (unitless)
6019	INTEGER(i_std) :: n !! Index (unitless)
6020
6021	!_ ================================================================================================================================
6022
6023	!-
6024	! 0. Check consistency
6025	!-
6026	IF (nusda /= nbtypes_usda) THEN
6027	CALL ipslerr_p(3,'get_soilcorr', 'nusda /= nbtypes_usda',&
6028	& 'We do not have the correct number of classes', &
6029	& ' in the code for the file.') ! Fatal error
6030	ENDIF
6031
6032	!! Parameters for soil type distribution :
6033	!! Sand, Loamy Sand, Sandy Loam, Silt Loam, Silt, Loam, Sandy Clay Loam, Silty Clay Loam, Clay Loam, Sandy Clay, Silty Clay, Clay
6034	! The order comes from constantes_soil.f90
6035	! The corresponding granulometric composition comes from Carsel & Parrish, 1988
6036
6037	!-
6038	! 1. Textural fractions for : sand, clay
6039	!-
6040	textfrac_table(1,2:3) = (/ 0.93, 0.03 /) ! Sand
6041	textfrac_table(2,2:3) = (/ 0.81, 0.06 /) ! Loamy Sand
6042	textfrac_table(3,2:3) = (/ 0.63, 0.11 /) ! Sandy Loam
6043	textfrac_table(4,2:3) = (/ 0.17, 0.19 /) ! Silt Loam
6044	textfrac_table(5,2:3) = (/ 0.06, 0.10 /) ! Silt
6045	textfrac_table(6,2:3) = (/ 0.40, 0.20 /) ! Loam
6046	textfrac_table(7,2:3) = (/ 0.54, 0.27 /) ! Sandy Clay Loam
6047	textfrac_table(8,2:3) = (/ 0.08, 0.33 /) ! Silty Clay Loam
6048	textfrac_table(9,2:3) = (/ 0.30, 0.33 /) ! Clay Loam
6049	textfrac_table(10,2:3) = (/ 0.48, 0.41 /) ! Sandy Clay
6050	textfrac_table(11,2:3) = (/ 0.06, 0.46 /) ! Silty Clay
6051	textfrac_table(12,2:3) = (/ 0.15, 0.55 /) ! Clay
6052	textfrac_table(13,2:3) = (/ 0.15, 0.55 /) ! Clay
6053
6054	! Fraction of silt
6055
6056	DO n=1,nusda
6057	textfrac_table(n,1) = 1. - textfrac_table(n,2) - textfrac_table(n,3)
6058	END DO
6059
6060	END SUBROUTINE get_soilcorr_usda
6061
6062	!! ================================================================================================================================
6063	!! FUNCTION : tempfunc
6064	!!
6065	!>\BRIEF ! This function interpolates value between ztempmin and ztempmax
6066	!! used for lai detection.
6067	!!
6068	!! DESCRIPTION : This subroutine calculates a scalar between 0 and 1 with the following equation :\n
6069	!! \latexonly
6070	!! \input{constantes_veg_tempfunc.tex}
6071	!! \endlatexonly
6072	!!
6073	!! RECENT CHANGE(S): None
6074	!!
6075	!! RETURN VALUE : tempfunc_result
6076	!!
6077	!! REFERENCE(S) : None
6078	!!
6079	!! FLOWCHART : None
6080	!! \n
6081	!_ ================================================================================================================================
6082
6083	FUNCTION tempfunc (temp_in) RESULT (tempfunc_result)
6084
6085
6086	!! 0. Variables and parameters declaration
6087
6088	REAL(r_std),PARAMETER :: ztempmin=273._r_std !! Temperature for laimin (K)
6089	REAL(r_std),PARAMETER :: ztempmax=293._r_std !! Temperature for laimax (K)
6090	REAL(r_std) :: zfacteur !! Interpolation factor (K^{-2})
6091
6092	!! 0.1 Input variables
6093
6094	REAL(r_std),INTENT(in) :: temp_in !! Temperature (K)
6095
6096	!! 0.2 Result
6097
6098	REAL(r_std) :: tempfunc_result !! (unitless)
6099
6100	!_ ================================================================================================================================
6101
6102	!! 1. Define a coefficient
6103	zfacteur = un/(ztempmax-ztempmin)**2
6104
6105	!! 2. Computes tempfunc
6106	IF (temp_in > ztempmax) THEN
6107	tempfunc_result = un
6108	ELSEIF (temp_in < ztempmin) THEN
6109	tempfunc_result = zero
6110	ELSE
6111	tempfunc_result = un-zfacteur(ztempmax-temp_in)*2
6112	ENDIF !(temp_in > ztempmax)
6113
6114
6115	END FUNCTION tempfunc
6116
6117	END MODULE slowproc

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

Download in other formats: