Context Navigation

source: branches/publications/ORCHIDEE_CAN_r3069/src_stomate/stomate_io.f90 @ 7475

Last change on this file since 7475 was 2945, checked in by sebastiaan.luyssaert, 9 years ago
DEV: tested 1 year global. This code contains the latest version for anthropogenic tree species channges, several bug fixes to forest management as well as the code for the fully integrated multi-layer energy budget. This implies that the multi-layer energy budget makes use Pinty's albedo scheme, the rognostic canopy structure as well as a vertical profile for stomatal conductance. This is an intermediate version because species change code is not complete as some management changes have not been implemented yet. Further the multi-layer albedo code needs more work in terms of calculating average fluxes at the pixel rather than the PFT level
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 166.0 KB

Line
1	! =================================================================================================================================
2	! MODULE : stomate_io
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2011)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This module reads and writes STOMATE variables in restart files.
10	!!
11	!!\n DESCRIPTION: Not all variables saved in the start files are absolutely necessary.
12	!! However, Sechiba's and Stomate's PFTs are not necessarily identical,
13	!! and for that case this information needs to be saved.
14	!!
15	!! RECENT CHANGE(S): None
16	!!
17	!! REFERENCE(S) : None
18	!!
19	!! SVN :
20	!! $HeadURL$
21	!! $Date$
22	!! $Revision$
23	!! \n
24	!_ ================================================================================================================================
25
26	MODULE stomate_io
27
28	USE stomate_data
29	USE constantes
30	USE structures
31	USE constantes_soil
32	USE mod_orchidee_para
33	USE ioipsl_para
34	USE interpol_help
35	USE function_library, ONLY : wood_to_qmheight, biomass_to_lai
36	USE grid
37
38	IMPLICIT NONE
39
40	PRIVATE
41	PUBLIC readrestart, writerestart, readbc, get_reftemp_clear
42
43	LOGICAL, SAVE :: firstcall = .TRUE. !! first call?
44	!$OMP THREADPRIVATE(firstcall)
45
46	REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE :: trefe !! reference temperature (K)
47	!$OMP THREADPRIVATE(trefe)
48
49
50	CONTAINS
51
52	!! ================================================================================================================================
53	!! SUBROUTINE : readrestart
54	!!
55	!>\BRIEF read start file
56	!!
57	!! DESCRIPTION : None
58	!!
59	!! RECENT CHANGE(S): None
60	!!
61	!! MAIN OUTPUT VARIABLE(S):
62	!!
63	!! REFERENCE(S) : None
64	!!
65	!! FLOWCHART : None
66	!! \n
67	!_ ================================================================================================================================
68
69	SUBROUTINE readrestart (npts, index, lalo, resolution, neighbours, contfrac, &
70	day_counter, dt_days, date, ind, &
71	adapted, regenerate, moiavail_daily, gdd_init_date, &
72	litterhum_daily, t2m_daily, t2m_min_daily, tsurf_daily, &
73	tsoil_daily, soilhum_daily, precip_daily, gpp_daily, &
74	npp_daily, turnover_daily, moiavail_month, moiavail_week, &
75	moiavail_growingseason, t2m_longterm, tlong_ref, t2m_month, &
76	t2m_week, tsoil_month, soilhum_month, fireindex, &
77	firelitter, maxmoiavail_lastyear, maxmoiavail_thisyear, minmoiavail_lastyear, &
78	minmoiavail_thisyear, maxgppweek_lastyear, maxgppweek_thisyear, gdd0_lastyear, &
79	gdd0_thisyear, precip_lastyear, precip_thisyear, gdd_m5_dormance, &
80	gdd_from_growthinit, gdd_midwinter, ncd_dormance, ngd_minus5, &
81	PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
82	maxfpc_lastyear, maxfpc_thisyear, turnover_longterm, gpp_week, &
83	biomass, resp_maint_part, leaf_age, leaf_frac, &
84	senescence, senescence_days, when_growthinit, age, &
85	resp_hetero, resp_maint, resp_growth, co2_fire, &
86	co2_to_bm_dgvm, veget_lastlight, everywhere, need_adjacent, &
87	RIP_time, time_lowgpp, time_hum_min, hum_min_dormance, &
88	litterpart, litter, dead_leaves, carbon, &
89	black_carbon, lignin_struc, lignin_wood, turnover_time, &
90	prod_s, prod_m, prod_l, flux_s, flux_m, flux_l, &
91	cflux_prod_s, cflux_prod_m, cflux_prod_l, bm_to_litter, &
92	carb_mass_total, &
93	age_stand, rotation_n, last_cut, &
94	forest_managed, forest_managed_lastyear, global_years, &
95	ok_equilibrium, nbp_accu, nbp_flux, MatrixV, &
96	VectorU, previous_stock, current_stock, rue_longterm, &
97	fpc_max, circ_class_n, circ_class_biomass, &
98	KF, mai, &
99	pai, previous_wood_volume, mai_count, coppice_dens, &
100	vir_moiavail_growingseason, lai_per_level, laieff_fit, &
101	temp_growth, wstress_season, wstress_month, vir_wstress_fac, &
102	c_buried, k_latosa_adapt, species_change_map, fm_change_map, &
103	lpft_replant)
104
105	IMPLICIT NONE
106
107	!! 0. Parameters and variables declaration
108
109	!! 0.1 Input variables
110
111	INTEGER(i_std), INTENT(in) :: npts !! Domain size
112	INTEGER(i_std), DIMENSION(npts), INTENT(in) :: index !! Indices of the points on the map
113	REAL(r_std), DIMENSION(npts,2), INTENT(in) :: lalo !! Geogr. coordinates
114	!! (latitude,longitude) (degrees)
115	REAL(r_std), DIMENSION(npts,2), INTENT(in) :: resolution !! size in x an y of the grid (m)
116	INTEGER(i_std),DIMENSION (npts,8), INTENT(in) :: neighbours !! Neighbouring land grid cell
117	REAL(r_std),DIMENSION (npts), INTENT(in) :: contfrac !! Fraction of land in each grid box
118
119	!! 0.2 Output variables
120
121	REAL(r_std), INTENT(out) :: day_counter !! counts time until next STOMATE time step
122	REAL(r_std), INTENT(out) :: dt_days !! time step of STOMATE in days
123	INTEGER(i_std), INTENT(out) :: date !! date (d)
124	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: ind !! density of individuals
125	!! @tex $(m^{-2})$ @endtex
126	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: adapted !! Winter too cold? between 0 and 1
127	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: regenerate !! Winter sufficiently cold? between 0 and 1
128	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: moiavail_daily !! daily moisture availability
129	REAL(r_std), DIMENSION(npts,4), INTENT(out) :: gdd_init_date !! date for beginning of gdd count
130	REAL(r_std), DIMENSION(npts), INTENT(out) :: litterhum_daily !! daily litter humidity
131	REAL(r_std), DIMENSION(npts), INTENT(out) :: t2m_daily !! daily 2 meter temperatures (K)
132	REAL(r_std), DIMENSION(npts), INTENT(out) :: t2m_min_daily !! daily minimum 2 meter temperatures (K)
133	REAL(r_std), DIMENSION(npts), INTENT(out) :: tsurf_daily !! daily surface temperatures (K)
134	REAL(r_std), DIMENSION(npts,nbdl), INTENT(out) :: tsoil_daily !! daily soil temperatures (K)
135	REAL(r_std), DIMENSION(npts,nbdl), INTENT(out) :: soilhum_daily !! daily soil humidity
136	REAL(r_std), DIMENSION(npts), INTENT(out) :: precip_daily !! daily precipitations (mm/day) (for phenology)
137	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: gpp_daily !! daily gross primary productivity
138	!! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
139	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: npp_daily !! daily net primary productivity
140	!! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
141	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_daily !! daily turnover rates
142	!! @tex $(gC m^{-2} dt_slow^{-1})$ @endtex
143	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: moiavail_month !! "monthly" moisture availability
144	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: moiavail_week !! "weekly" moisture availability
145	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: moiavail_growingseason !! "growingseason" moisture availability
146	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: vir_moiavail_growingseason !! Virtual "growingseason" moisture availability
147	REAL(r_std), DIMENSION(npts), INTENT(out) :: t2m_longterm !! "long term" 2 meter temperatures (K)
148	REAL(r_std), DIMENSION(npts), INTENT(out) :: t2m_month !! "monthly" 2 meter temperatures (K)
149	REAL(r_std), DIMENSION(npts), INTENT(out) :: t2m_week !! "weekly" 2 meter temperatures (K)
150	REAL(r_std), DIMENSION(npts,nbdl), INTENT(out) :: tsoil_month !! "monthly" soil temperatures (K)
151	REAL(r_std), DIMENSION(npts,nbdl), INTENT(out) :: soilhum_month !! "monthly" soil humidity
152	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fireindex !! Probability of fire
153	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: firelitter !! Longer term total litter above
154	!! the ground
155	!! @tex $(gC m^{-2})$ @endtex
156	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxmoiavail_lastyear !! last year's maximum
157	!! moisture availability
158	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxmoiavail_thisyear !! this year's maximum
159	!! moisture availability
160	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: minmoiavail_lastyear !! last year's minimum
161	!! moisture availability
162	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: minmoiavail_thisyear !! this year's minimum
163	!! moisture availability
164	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxgppweek_lastyear !! last year's maximum weekly GPP
165	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxgppweek_thisyear !! this year's maximum weekly GPP
166	REAL(r_std), DIMENSION(npts), INTENT(out) :: gdd0_lastyear !! last year's annual GDD0
167	REAL(r_std), DIMENSION(npts), INTENT(out) :: gdd0_thisyear !! this year's annual GDD0
168	REAL(r_std), DIMENSION(npts), INTENT(out) :: precip_lastyear !! last year's annual precipitation
169	!! (mm/year)
170	REAL(r_std), DIMENSION(npts), INTENT(out) :: precip_thisyear !! this year's annual precipitation
171	!! (mm/year)
172	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: gdd_m5_dormance !! growing degree days, threshold
173	!! -5 deg C (for phenology)
174	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: gdd_from_growthinit !! growing degree days,
175	!! from begin of season
176	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: gdd_midwinter !! growing degree days since
177	!! midwinter (for phenology)
178	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: ncd_dormance !! number of chilling days since
179	!! leaves were lost (for phenology)
180	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: ngd_minus5 !! number of growing days, threshold
181	!! -5 deg C (for phenology)
182	LOGICAL, DIMENSION(npts,nvm), INTENT(out) :: PFTpresent !! PFT exists (equivalent to
183	!! fpc_max > 0 for natural PFTs)
184	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: npp_longterm !! "long term" net primary productivity
185	!! (gC/m**2/year)
186	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: lm_lastyearmax !! last year's maximum leaf mass,
187	!! for each PFT (gC/m**2)
188	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: lm_thisyearmax !! this year's maximum leaf mass,
189	!! for each PFT (gC/m**2)
190	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxfpc_lastyear !! last year's maximum fpc for each
191	!! natural PFT, on ground
192	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: maxfpc_thisyear !! this year's maximum fpc for each
193	!! PFT, on total ground (see stomate_season)
194	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: turnover_longterm !! "long term" turnover rate (gC/m**2/year)
195	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: gpp_week !! "weekly" GPP (gC/day/(m**2 covered)
196	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: biomass !! biomass (gC/m**2)
197	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: resp_maint_part !! maintenance resp (gC/m**2)
198	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(out) :: leaf_age !! leaf age (days)
199	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(out) :: leaf_frac !! fraction of leaves in leaf age class
200	REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(out) :: circ_class_n !! Number of trees in each circumference classes
201	REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(out):: circ_class_biomass !! Biomass components of the model tree within
202	!! each circumference classes (gC ind^-1)
203	LOGICAL, DIMENSION(npts,nvm), INTENT(out) :: senescence !! is the plant senescent ?
204	!! (only for deciduous trees -
205	!! carbohydrate reserve)
206	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: senescence_days !! Days since start of senescence (days)
207	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: when_growthinit !! how many days ago was the beginning
208	!! of the growing season
209	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: age !! mean age (years)
210	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_hetero !! heterotrophic respiration (gC/day/m**2)
211	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_maint !! maintenance respiration (gC/day/m**2)
212	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_growth !! growth respiration (gC/day/m**2)
213	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: co2_fire !! carbon emitted into the atmosphere
214	!! by fire (living and dead biomass)
215	!! (in gC/m**2/time step)
216	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: co2_to_bm_dgvm !! biomass uptaken
217	!! (gC/(m**2 of total ground)/day)
218	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: veget_lastlight !! vegetation fractions (on ground)
219	!! after last light competition
220	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: everywhere !! is the PFT everywhere in the
221	!! grid box or very localized
222	!! (after its introduction)
223	LOGICAL, DIMENSION(npts,nvm), INTENT(out) :: need_adjacent !! in order for this PFT to be introduced,
224	!! does it have to be present in an
225	!! adjacent grid box?
226	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: RIP_time !! How much time ago was the PFT eliminated
227	!! for the last time (years)
228	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: time_lowgpp !! Duration of dormance (days)
229	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: time_hum_min !! time elapsed since strongest moisture
230	!! availability (d)
231	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: hum_min_dormance !! minimum moisture during dormance
232	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out) :: litterpart !! fraction of litter above the ground
233	!! belonging to different PFTs separated
234	!! for natural and agricultural PFTs.
235	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(out) :: litter !! metabolic and structural litter,
236	!! natural and agricultural, above and
237	!! below ground (gC/m**2)
238	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out) :: dead_leaves !! dead leaves on ground, per PFT,
239	!! metabolic and structural,
240	!! in gC/(m**2 of ground)
241	REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(out) :: carbon !! carbon pool: active, slow, or passive,
242	!! (gC/m**2)
243	REAL(r_std), DIMENSION(npts), INTENT(out) :: black_carbon !! black carbon on the ground
244	!! (gC/(m**2 of total ground))
245	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(out) :: lignin_struc !! ratio Lignine/Carbon in structural litter,
246	!! above and below ground,
247	!! (gC/m**2)
248	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(out) :: lignin_wood !! ratio Lignine/Carbon in woody litter,
249	!! above and below ground,
250	!! (gC/m**2)
251	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out) :: turnover_time !!
252	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: rue_longterm !! longterm radiation use efficiency
253	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: fpc_max !!
254
255	INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out) :: age_stand !! Age of stand (years)
256	INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out) :: rotation_n !! Rotation number (number of rotation
257	!! since pft is managed)
258	INTEGER(i_std), DIMENSION(npts, nvm), INTENT(out) :: last_cut !! Years since last thinning (years)
259	INTEGER(i_std), DIMENSION (npts,nvm), INTENT(out) :: forest_managed_lastyear !! forest management flag for the previous year
260	REAL(r_std), DIMENSION(npts,0:nshort), INTENT(out) :: prod_s !!
261	REAL(r_std), DIMENSION(npts,0:nmedium), INTENT(out) :: prod_m !!
262	REAL(r_std), DIMENSION(npts,0:nlong), INTENT(out) :: prod_l !!
263	REAL(r_std), DIMENSION(npts,nshort), INTENT(out) :: flux_s !!
264	REAL(r_std), DIMENSION(npts,nmedium), INTENT(out) :: flux_m !!
265	REAL(r_std), DIMENSION(npts,nlong), INTENT(out) :: flux_l !!
266	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod_s !!
267	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod_m !!
268	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod_l !!
269	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(out) :: bm_to_litter !!
270	REAL(r_std), DIMENSION(npts), INTENT(out) :: carb_mass_total !!
271	INTEGER(i_std), INTENT(out) :: global_years !!
272	LOGICAL, DIMENSION(npts), INTENT(out) :: ok_equilibrium !!
273	REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_accu !! Accumulated Net Biospheric
274	!! Production over the year
275	REAL(r_std), DIMENSION(npts), INTENT(out) :: nbp_flux !! Net Biospheric Production over the year
276	REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(out) :: MatrixV !!
277	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: VectorU !!
278	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: previous_stock !!
279	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(out) :: current_stock !!
280	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: KF !! Scaling factor to convert sapwood mass
281	!! into leaf mass (m)
282	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: k_latosa_adapt !! Leaf to sapwood area adapted for water
283	!! stress. Adaptation takes place at the
284	!! end of the year (m)
285	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: mai !! The mean annual increment
286	!! @tex $(m3 / m2 / year)$ @endtex
287	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: pai !! The period annual increment
288	!! @tex $(m3 / m2 / year)$ @endtex
289	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: previous_wood_volume !! The volume of the tree trunks
290	!! in a stand for the previous year.
291	!! @tex $(m3 / m2 )$ @endtex
292	INTEGER(i_std), DIMENSION(npts,nvm),INTENT(out) :: mai_count !! The number of times we've
293	!! calculated the volume increment
294	!! for a stand
295	REAL(r_std), DIMENSION(npts,nvm),INTENT(out) :: coppice_dens !! The density of a coppice at the first
296	!! cutting.
297	!! @tex $( 1 / m**2 )$ @endtex
298	REAL(r_std), DIMENSION(npts,nvm,nlevels_tot),INTENT(out) :: lai_per_level !! The amount of LAI in each physical
299	!! canopy level.
300	!! @tex $( m2 / m2 )$ @endtex
301	TYPE(laieff_type),DIMENSION (:,:,:),INTENT(out) :: laieff_fit !! Fitted parameters for the effective LAI
302	REAL(r_std),DIMENSION(npts),INTENT(out) :: temp_growth !! Growth temperature (Â°C)
303	!! Is equal to t2m_month
304	REAL(r_std), DIMENSION(:,:), INTENT(out) :: vir_wstress_fac !! Virtual water stress factor, based on hum_rel_daily
305	!! (unitless, 0-1)
306	REAL(r_std), DIMENSION(:,:), INTENT(out) :: wstress_season !! Water stress factor, based on hum_rel_daily
307	!! (unitless, 0-1)
308	REAL(r_std), DIMENSION(:,:), INTENT(out) :: wstress_month !! Water stress factor, based on hum_rel_daily
309	!! (unitless, 0-1)
310	REAL(r_std), DIMENSION(:,:), INTENT(out) :: c_buried !! Carbon that is buried when land cover changes
311	!! to a nobio type.
312	!! @tex $( gC )$ @endtex
313	INTEGER(i_std), DIMENSION(:,:), INTENT(out) :: species_change_map !! A map which gives the PFT number that each
314	!! PFT will be replanted as in case of a clearcut.
315	!! (1-nvm,unitless)
316	INTEGER(i_std), DIMENSION(:,:), INTENT(out) :: fm_change_map !! A map which gives the desired FM strategy when
317	!! the PFT will be replanted after a clearcut.
318	!! (1-nvm,unitless)
319	LOGICAL, DIMENSION(:,:), INTENT(out) :: lpft_replant !! Indicates if this PFT has either died this year
320	!! or been clearcut/coppiced. If it has, it is not
321	!! replanted until the end of the year.
322
323	!! 0.3 Modified variables
324
325	REAL(r_std), DIMENSION(npts), INTENT(inout) :: tlong_ref !! "long term" reference 2 meter temperatures (K)
326	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(inout) :: forest_managed !! forest management flag
327
328	!! 0.4 Local variables
329
330	REAL(r_std) :: date_real !! date, real
331	REAL(r_std), DIMENSION(npts,nvm) :: PFTpresent_real !! PFT exists (equivalent to
332	!! fpc_max > 0 for natural PFTs), real
333	REAL(r_std), DIMENSION(npts,nvm) :: senescence_real !! is the plant senescent ?
334	!! (only for deciduous trees -
335	!! carbohydrate reserve), real
336	REAL(r_std), DIMENSION(npts,nvm) :: need_adjacent_real !! in order for this PFT to be introduced,
337	!! does it have to be present in an
338	!! adjacent grid box? - real
339	CHARACTER(LEN=80) :: var_name !! To store variables names for I/O
340	CHARACTER(LEN=10) :: part_str !! string suffix indicating an index
341	CHARACTER(LEN=10) :: part_str2 !! string suffix indicating an index
342	CHARACTER(LEN=10) :: circ_str !! string suffix indicating an index
343	CHARACTER(LEN=3), DIMENSION(nlitt) :: litter_str !! string suffix indicating litter type
344	CHARACTER(LEN=2), DIMENSION(nlevs) :: level_str !! string suffix indicating level
345	REAL(r_std), DIMENSION(1) :: xtmp !! temporary storage
346	INTEGER(i_std) :: i,j,k,l,m,p,deb,&
347	idia,ifm,icut !! index
348	REAL(r_std), DIMENSION(npts) :: tref !! reference temperature (K)
349
350	CHARACTER(LEN=2), DIMENSION(nelements) :: element_str !! string suffix indicating element
351	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: circ_ij !! circumference of idividual trees
352	INTEGER(i_std) :: ntrees !! first or second part of self-thinning lines
353	REAL(r_std), DIMENSION(npts,nvm) :: temp_real !! temporary real to allow restget
354	!! to work on multi-dimensional integers
355	REAL(r_std) :: p_max, excedent !! Where is the exponential distribution
356	!! truncated
357	REAL(r_std), DIMENSION(20) :: nb_trees_i !! Number of trees in each twentith quantile
358	REAL(r_std) :: lambda !! lambda of the exponential distribution
359	!! of initial diameters
360	REAL(r_std) :: min_circ_init !! Min initial circumference
361	!! of the exponential distribution
362	REAL(r_std) :: max_circ_init !! Max initial circumference
363	!! of the exponential distribution
364	REAL(r_std), DIMENSION(1) :: temp_global_years !!
365	CHARACTER(LEN=7), DIMENSION(nbpools) :: pools_str !!
366	REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real !!
367	CHARACTER(LEN=80) :: cut_name !! To store variables names for I/O
368	CHARACTER(LEN=80) :: fm_name !! To store variables names for I/O
369	REAL(r_std),DIMENSION(npts,nvm,nlevels_tot,nparams_laieff) :: temp_array !! To store structure values for I/O
370	INTEGER :: n,ilev,ipts,ivm !! Indices
371	REAL(r_std), DIMENSION(npts,nvm) :: r_replant !! Getting logical values from the restart
372	!! is not possible, so this is a temporary
373	!! array where 1.0 is TRUE.
374	!_ ================================================================================================================================
375
376	IF (bavard >= 3) WRITE(numout,*) 'Entering readrestart'
377	!-
378	! 0 When the vegetation is dynamic,
379	! the long-term reference temperature is prognostic.
380	! In this case, it is read from the restart file.
381	! If the corresponding field does not exist in the restart file,
382	! read it from another file in order to initialize it correctly.
383	!-
384	CALL get_reftemp(npts, lalo, neighbours, resolution, contfrac, tref )
385	!-
386	! 1 string definitions
387	!-
388	DO l=1,nlitt
389	IF (l == imetabolic) THEN
390	litter_str(l) = 'met'
391	ELSEIF (l == istructural) THEN
392	litter_str(l) = 'str'
393	ELSEIF (l == iwoody) THEN
394	litter_str(l) = 'wod'
395	ELSE
396	CALL ipslerr_p (3,'stomate_io', &
397	'Wrire restart - Define litter str','','')
398	ENDIF
399	ENDDO
400	!-
401	DO l=1,nlevs
402	IF (l == iabove) THEN
403	level_str(l) = 'ab'
404	ELSEIF (l == ibelow) THEN
405	level_str(l) = 'be'
406	ELSE
407	CALL ipslerr_p (3,'stomate_io',&
408	'Wrire restart - Define level str','','')
409	ENDIF
410	ENDDO
411
412	pools_str(1:nbpools) =(/'str_ab ','str_be ','met_ab ',&
413	'met_be ','wood_ab','wood_be', &
414	'actif ','slow ','passif '/)
415
416	!-
417	DO l=1,nelements
418	IF (l == icarbon) THEN
419	element_str(l) = ''
420	!!$ ELSEIF (l == initrogen) THEN
421	!!$ element_str(l) = '_n'
422	ELSE
423	CALL ipslerr_p (3,'stomate_io', &
424	'Wrire restart - Define element str','','')
425	ENDIF
426	ENDDO
427	!-
428	! 2 run control
429	!-
430	! 2.1 day counter
431	!-
432	IF (is_root_prc) THEN
433	var_name = 'day_counter'
434	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
435	& .TRUE., xtmp)
436	day_counter = xtmp(1)
437	IF (day_counter == val_exp) day_counter = un
438	ENDIF
439	CALL bcast(day_counter)
440	!-
441	! 2.2 time step of STOMATE in days
442	!-
443	IF (is_root_prc) THEN
444	var_name = 'dt_days'
445	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
446	& .TRUE., xtmp)
447	dt_days = xtmp(1)
448	IF (dt_days == val_exp) dt_days = un
449	ENDIF
450	CALL bcast(dt_days)
451	!-
452	! 2.3 date
453	!-
454	IF (is_root_prc) THEN
455	var_name = 'date'
456	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
457	& .TRUE., xtmp)
458	date_real = xtmp(1)
459	IF (date_real == val_exp) date_real = zero
460	date = NINT(date_real)
461	ENDIF
462	CALL bcast(date)
463	!-
464	! 3 daily meteorological variables
465	!-
466	moiavail_daily(:,:) = val_exp
467	var_name = 'moiavail_daily'
468	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
469	& .TRUE., moiavail_daily, 'gather', nbp_glo, index_g)
470	IF (ALL(moiavail_daily(:,:) == val_exp)) moiavail_daily(:,:) = zero
471	!-
472	gdd_init_date(:,:) = val_exp
473	var_name = 'gdd_init_date'
474	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 4 , 1, itime, &
475	& .TRUE., gdd_init_date, 'gather', nbp_glo, index_g)
476	IF (ALL(gdd_init_date(:,1) == val_exp)) gdd_init_date(:,1) = 365.
477	IF (ALL(gdd_init_date(:,3) == val_exp)) gdd_init_date(:,3) = zero
478	IF (ALL(gdd_init_date(:,4) == val_exp)) gdd_init_date(:,4) = zero
479	!-
480	litterhum_daily(:) = val_exp
481	var_name = 'litterhum_daily'
482	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
483	& .TRUE., litterhum_daily, 'gather', nbp_glo, index_g)
484	IF (ALL(litterhum_daily(:) == val_exp)) litterhum_daily(:) = zero
485	!-
486	t2m_daily(:) = val_exp
487	var_name = 't2m_daily'
488	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
489	& .TRUE., t2m_daily, 'gather', nbp_glo, index_g)
490	IF (ALL(t2m_daily(:) == val_exp)) t2m_daily(:) = zero
491	!-
492	t2m_min_daily(:) = val_exp
493	var_name = 't2m_min_daily'
494	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
495	& .TRUE., t2m_min_daily, 'gather', nbp_glo, index_g)
496	IF (ALL(t2m_min_daily(:) == val_exp)) t2m_min_daily(:) = large_value
497	!-
498	tsurf_daily(:) = val_exp
499	var_name = 'tsurf_daily'
500	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
501	& .TRUE., tsurf_daily, 'gather', nbp_glo, index_g)
502	IF (ALL(tsurf_daily(:) == val_exp)) tsurf_daily(:) = tref(:)
503	!-
504	tsoil_daily(:,:) = val_exp
505	var_name = 'tsoil_daily'
506	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
507	& .TRUE., tsoil_daily, 'gather', nbp_glo, index_g)
508	IF (ALL(tsoil_daily(:,:) == val_exp)) tsoil_daily(:,:) = zero
509	!-
510	soilhum_daily(:,:) = val_exp
511	var_name = 'soilhum_daily'
512	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
513	& .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
514	IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
515	!-
516	precip_daily(:) = val_exp
517	var_name = 'precip_daily'
518	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
519	& .TRUE., precip_daily, 'gather', nbp_glo, index_g)
520	IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
521	!-
522	! 4 productivities
523	!-
524	gpp_daily(:,:) = val_exp
525	var_name = 'gpp_daily'
526	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
527	& .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
528	IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
529	!-
530	npp_daily(:,:) = val_exp
531	var_name = 'npp_daily'
532	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
533	& .TRUE., npp_daily, 'gather', nbp_glo, index_g)
534	IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
535	!-
536	turnover_daily(:,:,:,:) = val_exp
537	DO l = 1,nelements
538	DO k = 1,nparts
539	WRITE(part_str,'(I2)') k
540	IF (k < 10) part_str(1:1) = '0'
541	var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
542	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
543	& .TRUE., turnover_daily(:,:,k,l), 'gather', nbp_glo, index_g)
544	IF (ALL(turnover_daily(:,:,k,l) == val_exp)) &
545	& turnover_daily(:,:,k,l) = zero
546	ENDDO
547	END DO
548	!-
549	! 5 monthly meteorological variables
550	!-
551	moiavail_month(:,:) = val_exp
552	var_name = 'moiavail_month'
553	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
554	& .TRUE., moiavail_month, 'gather', nbp_glo, index_g)
555	IF (ALL(moiavail_month(:,:) == val_exp)) moiavail_month(:,:) = zero
556	!-
557	moiavail_week(:,:) = val_exp
558	var_name = 'moiavail_week'
559	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
560	& .TRUE., moiavail_week, 'gather', nbp_glo, index_g)
561	IF (ALL(moiavail_week(:,:) == val_exp)) moiavail_week(:,:) = zero
562	!-
563	moiavail_growingseason(:,:) = val_exp
564	var_name = 'moiavail_gs'
565	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
566	& .TRUE., moiavail_growingseason, 'gather', nbp_glo, index_g)
567	IF (ALL(moiavail_growingseason(:,:) == val_exp)) moiavail_growingseason(:,:) = zero
568	!-
569	vir_moiavail_growingseason(:,:) = val_exp
570	var_name = 'vir_moiavail_gs'
571	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
572	& .TRUE., vir_moiavail_growingseason, 'gather', nbp_glo, index_g)
573	IF (ALL(vir_moiavail_growingseason(:,:) == val_exp)) vir_moiavail_growingseason(:,:) = zero
574	!-
575	t2m_longterm(:) = val_exp
576	var_name = 't2m_longterm'
577	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
578	& .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
579	IF (ALL(t2m_longterm(:) == val_exp)) t2m_longterm(:) = tref(:)
580	!-
581	! the long-term reference temperature is a prognostic variable
582	! only in case the vegetation is dynamic
583	!-
584	IF (control%ok_dgvm) THEN
585	tlong_ref(:) = val_exp
586	var_name = 'tlong_ref'
587	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
588	& .TRUE., tlong_ref, 'gather', nbp_glo, index_g)
589	IF (ALL(tlong_ref(:) == val_exp)) tlong_ref(:) = tref(:)
590	ENDIF
591	!-
592	t2m_month(:) = val_exp
593	var_name = 't2m_month'
594	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
595	& .TRUE., t2m_month, 'gather', nbp_glo, index_g)
596	IF (ALL(t2m_month(:) == val_exp)) t2m_month(:) = tref(:)
597	!-
598	t2m_week(:) = val_exp
599	var_name = 't2m_week'
600	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
601	& .TRUE., t2m_week, 'gather', nbp_glo, index_g)
602	IF (ALL(t2m_week(:) == val_exp)) t2m_week(:) = tref(:)
603	!-
604	tsoil_month(:,:) = val_exp
605	var_name = 'tsoil_month'
606	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
607	& .TRUE., tsoil_month, 'gather', nbp_glo, index_g)
608
609	IF (ALL(tsoil_month(:,:) == val_exp)) THEN
610	DO l=1,nbdl
611	tsoil_month(:,l) = tref(:)
612	ENDDO
613	ENDIF
614	!-
615	soilhum_month(:,:) = val_exp
616	var_name = 'soilhum_month'
617	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
618	& .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
619	IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
620	!-
621	temp_growth(:) = val_exp
622	var_name = 'temp_growth'
623	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
624	& .TRUE., temp_growth, 'gather', nbp_glo, index_g)
625	IF (ALL(temp_growth(:) == val_exp)) temp_growth(:) = zero
626	!-
627	wstress_season(:,:) = val_exp
628	var_name = 'wstress_season'
629	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
630	& .TRUE., wstress_season, 'gather', nbp_glo, index_g)
631	IF (ALL(wstress_season(:,:) == val_exp)) wstress_season(:,:) = un
632	!-
633	wstress_month(:,:) = val_exp
634	var_name = 'wstress_month'
635	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
636	& .TRUE., wstress_month, 'gather', nbp_glo, index_g)
637	IF (ALL(wstress_month(:,:) == val_exp)) wstress_month(:,:) = un
638	!-
639	vir_wstress_fac(:,:) = val_exp
640	var_name = 'vir_wstress_fac'
641	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
642	& .TRUE., vir_wstress_fac, 'gather', nbp_glo, index_g)
643	IF (ALL(vir_wstress_fac(:,:) == val_exp)) vir_wstress_fac(:,:) = un
644
645	!-
646	c_buried(:,:) = val_exp
647	var_name = 'c_buried'
648	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nnobio, 1, itime, &
649	& .TRUE., c_buried, 'gather', nbp_glo, index_g)
650	IF (ALL(c_buried(:,:) == val_exp)) c_buried(:,:) = un
651
652	!-
653	! 6 fire probability
654	!-
655	fireindex(:,:) = val_exp
656	var_name = 'fireindex'
657	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
658	& .TRUE., fireindex, 'gather', nbp_glo, index_g)
659	IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
660	!-
661	firelitter(:,:) = val_exp
662	var_name = 'firelitter'
663	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
664	& .TRUE., firelitter, 'gather', nbp_glo, index_g)
665	IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
666	!-
667	! 7 maximum and minimum moisture availabilities for tropic phenology
668	!-
669	maxmoiavail_lastyear(:,:) = val_exp
670	var_name = 'maxmoistr_last'
671	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
672	& .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
673	IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
674	& maxmoiavail_lastyear(:,:) = zero
675	!-
676	maxmoiavail_thisyear(:,:) = val_exp
677	var_name = 'maxmoistr_this'
678	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
679	& .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
680	IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
681	& maxmoiavail_thisyear(:,:) = zero
682	!-
683	minmoiavail_lastyear(:,:) = val_exp
684	var_name = 'minmoistr_last'
685	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
686	& .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
687	IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
688	& minmoiavail_lastyear(:,:) = un
689	!-
690	minmoiavail_thisyear(:,:) = val_exp
691	var_name = 'minmoistr_this'
692	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
693	& .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
694	IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
695	& minmoiavail_thisyear(:,:) = un
696	!-
697	! 8 maximum "weekly" GPP
698	!-
699	maxgppweek_lastyear(:,:) = val_exp
700	var_name = 'maxgppweek_lastyear'
701	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
702	& .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
703	IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
704	& maxgppweek_lastyear(:,:) = zero
705	!-
706	maxgppweek_thisyear(:,:) = val_exp
707	var_name = 'maxgppweek_thisyear'
708	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
709	& .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
710	IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
711	& maxgppweek_thisyear(:,:) = zero
712	!-
713	! 9 annual GDD0
714	!-
715	gdd0_thisyear(:) = val_exp
716	var_name = 'gdd0_thisyear'
717	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
718	& .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
719	IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
720	!-
721	gdd0_lastyear(:) = val_exp
722	var_name = 'gdd0_lastyear'
723	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
724	& .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
725	IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
726	!-
727	! 10 annual precipitation
728	!-
729	precip_thisyear(:) = val_exp
730	var_name = 'precip_thisyear'
731	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
732	& .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
733	IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
734	!-
735	precip_lastyear(:) = val_exp
736	var_name = 'precip_lastyear'
737	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
738	& .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
739	IF (ALL(precip_lastyear(:) == val_exp)) &
740	& precip_lastyear(:) = precip_crit
741	!-
742	! 11 derived "biometeorological" variables
743	!-
744	gdd_m5_dormance(:,:) = val_exp
745	var_name = 'gdd_m5_dormance'
746	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
747	& .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
748	IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
749	& gdd_m5_dormance(:,:) = undef
750	!-
751	gdd_from_growthinit(:,:) = val_exp
752	var_name = 'gdd_from_growthinit'
753	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
754	& .TRUE., gdd_from_growthinit, 'gather', nbp_glo, index_g)
755	IF (ALL(gdd_from_growthinit(:,:) == val_exp)) &
756	& gdd_from_growthinit(:,:) = zero
757	!-
758	gdd_midwinter(:,:) = val_exp
759	var_name = 'gdd_midwinter'
760	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
761	& .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
762	IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
763	!-
764	ncd_dormance(:,:) = val_exp
765	var_name = 'ncd_dormance'
766	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
767	& .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
768	IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
769	!-
770	ngd_minus5(:,:) = val_exp
771	var_name = 'ngd_minus5'
772	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
773	& .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
774	IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
775	!-
776	time_lowgpp(:,:) = val_exp
777	var_name = 'time_lowgpp'
778	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
779	& .TRUE., time_lowgpp, 'gather', nbp_glo, index_g)
780	IF (ALL(time_lowgpp(:,:) == val_exp)) time_lowgpp(:,:) = zero
781	!-
782	time_hum_min(:,:) = val_exp
783	var_name = 'time_hum_min'
784	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
785	& .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
786	IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
787	!-
788	hum_min_dormance(:,:) = val_exp
789	var_name = 'hum_min_dormance'
790	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
791	& .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
792	IF (ALL(hum_min_dormance(:,:) == val_exp)) &
793	& hum_min_dormance(:,:) = undef
794	!-
795	! 12 Plant status
796	!-
797	PFTpresent_real(:,:) = val_exp
798	var_name = 'PFTpresent'
799	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
800	& .TRUE., PFTpresent_real, 'gather', nbp_glo, index_g)
801	IF (ALL(PFTpresent_real(:,:) == val_exp)) PFTpresent_real(:,:) = zero
802	WHERE (PFTpresent_real(:,:) >= .5)
803	PFTpresent = .TRUE.
804	ELSEWHERE
805	PFTpresent = .FALSE.
806	ENDWHERE
807	!-
808
809	!+++++++++ CHECK MJM +++++++++++++++
810	! why is this done here?
811	!!$ IF ( control%forest_management ) THEN
812	!!$
813	!!$ IF ( .NOT. ALLOCATED(circ_ij)) ALLOCATE(circ_ij(MAXVAL(nmaxtrees)))
814	!!$
815	!!$ !! initializing circ_ij and setting m to the smallest cir_ij greater than zero
816	!!$ p_max = 100./MAXVAL(nmaxtrees)
817	!!$ circ_ij(:) = zero
818	!!$ nb_trees_i(:) = 0
819	!!$
820	!!$ !! lambda of the exponential distribution of initial diameters
821	!!$ !! (Dhote 2003 : lambda = SQRT(2)/Dg and Dginit = 1 cm)
822	!!$ lambda = 2._r_std**0.5_r_std/pi
823	!!$
824	!!$ !! The distribution is truncated when P(X>max_circ_init)<100/maxval(nmaxtrees)
825	!!$ min_circ_init = pi
826	!!$ max_circ_init = 1./lambda*LOG(1/p_max)
827	!!$
828	!!$ DO p = 1,20
829	!!$ nb_trees_i(p) = NINT(MAXVAL(nmaxtrees)(EXP(-lambdamax_circ_init(p-1)/20)-EXP(-lambdamax_circ_init*p/20)))
830	!!$ ENDDO
831	!!$ excedent = REAL(MAXVAL(nmaxtrees),r_std)-SUM(nb_trees_i)
832	!!$ nb_trees_i(:) = nb_trees_i(:) + FLOOR(excedent/20)
833	!!$ nb_trees_i(1) = nb_trees_i(1) + NINT(excedent) - 20*FLOOR(excedent/20)
834	!!$
835	!!$ DO p = 1,20
836	!!$ IF (nb_trees_i(p) > 0) THEN
837	!!$ deb = 0
838	!!$ IF (p > 1) deb = SUM(nb_trees_i(1:(p-1)))
839	!!$ DO k = 1,NINT(nb_trees_i(p))
840	!!$ circ_ij(deb+k) = min_circ_init + REAL(p-1)/20max_circ_init + kmax_circ_init/(20*nb_trees_i(p))
841	!!$ ENDDO
842	!!$ ENDIF
843	!!$ ENDDO
844	!!$ circ_ij(:) = circ_ij(:)*0.01 !changed to meters
845	!!$ ntrees = COUNT(MASK = circ_ij .GT. zero)
846	!!$
847	!!$ END IF ! control%forest_management
848	!++++++++++++++++++++
849
850	!-
851	ind(:,:) = val_exp
852	var_name = 'ind'
853	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
854	& .TRUE., ind, 'gather', nbp_glo, index_g)
855	IF (ALL(ind(:,:) == val_exp)) THEN
856	ind(:,:) = zero
857	!+++++ CHECK +++++
858	! this makes it so managed forests don't go through prescribe, which seems incorrect
859	! maybe it was needed for the old allocation scheme?
860	! IF ( control%forest_management ) THEN
861	! DO j = 2,nvm
862	! WHERE ( forest_managed(:,j) > 0 ) ind(:,j) = REAL(ntrees)/10000.
863	! ENDDO
864	! END IF
865	!+++++++++++++++++
866	ENDIF
867	!-
868	adapted(:,:) = val_exp
869	var_name = 'adapted'
870	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
871	& .TRUE., adapted, 'gather', nbp_glo, index_g)
872	IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
873	!-
874	regenerate(:,:) = val_exp
875	var_name = 'regenerate'
876	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
877	& .TRUE., regenerate, 'gather', nbp_glo, index_g)
878	IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
879	!-
880	npp_longterm(:,:) = val_exp
881	var_name = 'npp_longterm'
882	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
883	& .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
884	IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
885	!-
886	lm_lastyearmax(:,:) = val_exp
887	var_name = 'lm_lastyearmax'
888	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
889	& .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
890	IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
891	!-
892	lm_thisyearmax(:,:) = val_exp
893	var_name = 'lm_thisyearmax'
894	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
895	& .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
896	IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
897	!-
898	maxfpc_lastyear(:,:) = val_exp
899	var_name = 'maxfpc_lastyear'
900	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
901	& .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
902	IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
903	!-
904	maxfpc_thisyear(:,:) = val_exp
905	var_name = 'maxfpc_thisyear'
906	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
907	& .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
908	IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
909	!-
910	turnover_time(:,:,:) = val_exp
911	DO k = 1,nparts
912	WRITE(part_str,'(I2)') k
913	IF ( k < 10 ) part_str(1:1) = '0'
914	var_name = 'turnover_time_'//part_str(1:LEN_TRIM(part_str))
915	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
916	& .TRUE., turnover_time(:,:,k), 'gather', nbp_glo, index_g)
917	IF ( ALL( turnover_time(:,:,k) == val_exp)) turnover_time(:,:,k) = 100.
918	ENDDO
919	!-
920	turnover_longterm(:,:,:,:) = val_exp
921	DO l = 1,nelements
922	DO k = 1,nparts
923	WRITE(part_str,'(I2)') k
924	IF ( k < 10 ) part_str(1:1) = '0'
925	var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
926	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
927	& .TRUE., turnover_longterm(:,:,k,l), 'gather', nbp_glo, index_g)
928	IF (ALL(turnover_longterm(:,:,k,l) == val_exp)) &
929	& turnover_longterm(:,:,k,l) = zero
930	ENDDO
931	END DO
932	!-
933	gpp_week(:,:) = val_exp
934	var_name = 'gpp_week'
935	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
936	& .TRUE., gpp_week, 'gather', nbp_glo, index_g)
937	IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
938	!-
939	biomass(:,:,:,:) = val_exp
940	DO l = 1,nelements
941	DO k = 1,nparts
942	WRITE(part_str,'(I2)') k
943	IF ( k < 10 ) part_str(1:1) = '0'
944	var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
945	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
946	& .TRUE., biomass(:,:,k,l), 'gather', nbp_glo, index_g)
947	IF (ALL(biomass(:,:,k,l) == val_exp)) biomass(:,:,k,l) = zero
948	ENDDO
949	END DO
950	!-
951	resp_maint_part(:,:,:) = val_exp
952	DO k=1,nparts
953	WRITE(part_str,'(I2)') k
954	IF ( k < 10 ) part_str(1:1) = '0'
955	var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
956	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
957	& .TRUE., resp_maint_part(:,:,k), 'gather', nbp_glo, index_g)
958	IF (ALL(resp_maint_part(:,:,k) == val_exp)) resp_maint_part(:,:,k) = zero
959	ENDDO
960	!-
961	leaf_age(:,:,:) = val_exp
962	DO m=1,nleafages
963	WRITE (part_str,'(I2)') m
964	IF ( m < 10 ) part_str(1:1) = '0'
965	var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
966	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
967	& .TRUE., leaf_age(:,:,m), 'gather', nbp_glo, index_g)
968	IF (ALL(leaf_age(:,:,m) == val_exp)) leaf_age(:,:,m) = zero
969	ENDDO
970	!-
971	leaf_frac(:,:,:) = val_exp
972	DO m=1,nleafages
973	WRITE(part_str,'(I2)') m
974	IF ( m < 10 ) part_str(1:1) = '0'
975	var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
976	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
977	& .TRUE., leaf_frac(:,:,m), 'gather', nbp_glo, index_g)
978	IF (ALL(leaf_frac(:,:,m) == val_exp)) leaf_frac(:,:,m) = zero
979	ENDDO
980	!-
981	circ_class_n(:,:,:) = val_exp
982	DO m=1,ncirc
983	WRITE(part_str,'(I2)') m
984	IF ( m < 10 ) part_str(1:1) = '0'
985	var_name = 'circ_class_n_'//part_str(1:LEN_TRIM(part_str))
986	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
987	& .TRUE., circ_class_n(:,:,m), 'gather', nbp_glo, index_g)
988	IF (ALL(circ_class_n(:,:,m) == val_exp)) circ_class_n(:,:,m) = zero
989	ENDDO
990	!-
991	circ_class_biomass(:,:,:,:,:) = val_exp
992	DO m = 1,nelements
993	DO l = 1,nparts
994	DO k = 1,ncirc
995	WRITE(part_str,'(I2)') l
996	IF ( l < 10 ) part_str(1:1) = '0'
997	WRITE(circ_str, '(I2.2)') k
998	var_name = 'cc_bio_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(m))//'_'//TRIM(circ_str)
999	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1000	& .TRUE., circ_class_biomass(:,:,k,l,m), 'gather', nbp_glo, index_g)
1001	IF (ALL(circ_class_biomass(:,:,k,l,m) == val_exp)) circ_class_biomass(:,:,k,l,m) = zero
1002	ENDDO
1003	ENDDO
1004	ENDDO
1005	!-
1006	lai_per_level(:,:,:) = val_exp
1007	DO m=1,nlevels_tot
1008	WRITE(part_str,'(I2)') m
1009	IF ( m < 10 ) part_str(1:1) = '0'
1010	var_name = 'lai_per_level_'//part_str(1:LEN_TRIM(part_str))
1011	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1012	& .TRUE., lai_per_level(:,:,m), 'gather', nbp_glo, index_g)
1013	IF (ALL(lai_per_level(:,:,m) == val_exp)) lai_per_level(:,:,m) = zero
1014	ENDDO
1015	!
1016	! This is ugly, since the restart routines were not developed to deal with structures.
1017	! But all I have to do is copy some things to arrays.
1018	temp_array(:,:,:,:) = val_exp
1019	DO m=1,nlevels_tot
1020	WRITE(part_str,'(I2)') m
1021	IF ( m < 10 ) part_str(1:1) = '0'
1022	DO n=1,nparams_laieff
1023	WRITE(part_str2,'(I2)') n
1024	IF ( n < 10 ) part_str2(1:1) = '0'
1025
1026	var_name = 'laieff_fit__'//part_str(1:LEN_TRIM(part_str)) // '_' &
1027	// part_str2(1:LEN_TRIM(part_str2))
1028	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1029	.TRUE., temp_array(:,:,m,n), 'gather', nbp_glo, index_g)
1030	IF (ALL(temp_array(:,:,m,n) == val_exp)) temp_array(:,:,m,n) = zero
1031	ENDDO
1032	ENDDO
1033	DO ipts=1,npts
1034	DO ivm=1,nvm
1035	DO ilev=1,nlevels_tot
1036	laieff_fit(ipts,ivm,ilev)%a=temp_array(ipts,ivm,ilev,1)
1037	laieff_fit(ipts,ivm,ilev)%b=temp_array(ipts,ivm,ilev,2)
1038	laieff_fit(ipts,ivm,ilev)%c=temp_array(ipts,ivm,ilev,3)
1039	laieff_fit(ipts,ivm,ilev)%d=temp_array(ipts,ivm,ilev,4)
1040	laieff_fit(ipts,ivm,ilev)%e=temp_array(ipts,ivm,ilev,5)
1041	ENDDO
1042	ENDDO
1043	ENDDO
1044	!-
1045	senescence_real(:,:) = val_exp
1046	var_name = 'senescence'
1047	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1048	& .TRUE., senescence_real, 'gather', nbp_glo, index_g)
1049	IF (ALL(senescence_real(:,:) == val_exp)) senescence_real(:,:) = zero
1050	WHERE ( senescence_real(:,:) >= .5 )
1051	senescence = .TRUE.
1052	ELSEWHERE
1053	senescence = .FALSE.
1054	ENDWHERE
1055	!-
1056	senescence_days(:,:) = val_exp
1057	var_name = 'senescence_days'
1058	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1059	& .TRUE., senescence_days, 'gather', nbp_glo, index_g)
1060	IF (ALL(senescence_days(:,:) == val_exp)) &
1061	& senescence_days(:,:) = zero
1062	!-
1063	when_growthinit(:,:) = val_exp
1064	var_name = 'when_growthinit'
1065	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1066	& .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
1067	! Assume the last growing season started 8 months ago. This way deciduous
1068	! pft can have leaves in year one although the phenology in the first year
1069	! of a cold start may be off by up to 60 days or so.
1070	IF (ALL(when_growthinit(:,:) == val_exp)) &
1071	& when_growthinit(:,:) = 240
1072	!-
1073	age(:,:) = val_exp
1074	var_name = 'age'
1075	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1076	& .TRUE., age, 'gather', nbp_glo, index_g)
1077	IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
1078	!-
1079	KF(:,:) = val_exp
1080	var_name = 'KF'
1081	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1082	& .TRUE., KF, 'gather', nbp_glo, index_g)
1083	! I don't want to set it equal to zero, since this is a problem if these
1084	! values are not here! Better it blows up later on
1085	!IF (ALL(KF(:,:) == val_exp)) KF(:,:) = zero
1086
1087	k_latosa_adapt(:,:) = val_exp
1088	var_name = 'k_latosa_adapt'
1089	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1090	& .TRUE., k_latosa_adapt, 'gather', nbp_glo, index_g)
1091	DO ivm = 1,nvm
1092	IF (ALL(k_latosa_adapt(:,ivm) == val_exp)) k_latosa_adapt(:,ivm) = k_latosa_min(ivm)
1093	ENDDO
1094
1095	!-
1096	! 13 CO2
1097	!-
1098	resp_hetero(:,:) = val_exp
1099	var_name = 'resp_hetero'
1100	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1101	& .TRUE., resp_hetero, 'gather', nbp_glo, index_g)
1102	IF (ALL(resp_hetero(:,:) == val_exp)) resp_hetero(:,:) = zero
1103	!-
1104	resp_maint(:,:) = val_exp
1105	var_name = 'resp_maint'
1106	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1107	& .TRUE., resp_maint, 'gather', nbp_glo, index_g)
1108	IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
1109	!-
1110	resp_growth(:,:) = val_exp
1111	var_name = 'resp_growth'
1112	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1113	& .TRUE., resp_growth, 'gather', nbp_glo, index_g)
1114	IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
1115	!-
1116	co2_fire(:,:) = val_exp
1117	var_name = 'co2_fire'
1118	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1119	& .TRUE., co2_fire, 'gather', nbp_glo, index_g)
1120	IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
1121	!-
1122	co2_to_bm_dgvm(:,:) = val_exp
1123	var_name = 'co2_to_bm_dgvm'
1124	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1125	& .TRUE., co2_to_bm_dgvm, 'gather', nbp_glo, index_g)
1126	IF (ALL(co2_to_bm_dgvm(:,:) == val_exp)) co2_to_bm_dgvm(:,:) = zero
1127	!-
1128	! 14 vegetation distribution after last light competition
1129	!-
1130	veget_lastlight(:,:) = val_exp
1131	var_name = 'veget_lastlight'
1132	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1133	& .TRUE., veget_lastlight, 'gather', nbp_glo, index_g)
1134	IF (ALL(veget_lastlight(:,:) == val_exp)) veget_lastlight(:,:) = zero
1135	!-
1136	! 15 establishment criteria
1137	!-
1138	everywhere(:,:) = val_exp
1139	var_name = 'everywhere'
1140	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1141	& .TRUE., everywhere, 'gather', nbp_glo, index_g)
1142	IF (ALL(everywhere(:,:) == val_exp)) everywhere(:,:) = zero
1143	!-
1144	need_adjacent_real(:,:) = val_exp
1145	var_name = 'need_adjacent'
1146	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1147	& .TRUE., need_adjacent_real, 'gather', nbp_glo, index_g)
1148	IF (ALL(need_adjacent_real(:,:) == val_exp)) &
1149	& need_adjacent_real(:,:) = zero
1150	WHERE ( need_adjacent_real(:,:) >= .5 )
1151	need_adjacent = .TRUE.
1152	ELSEWHERE
1153	need_adjacent = .FALSE.
1154	ENDWHERE
1155	!-
1156	RIP_time(:,:) = val_exp
1157	var_name = 'RIP_time'
1158	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1159	& .TRUE., RIP_time, 'gather', nbp_glo, index_g)
1160	IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
1161	!-
1162	! 16 black carbon
1163	!-
1164	black_carbon(:) = val_exp
1165	var_name = 'black_carbon'
1166	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1167	& .TRUE., black_carbon, 'gather', nbp_glo, index_g)
1168	IF (ALL(black_carbon(:) == val_exp)) black_carbon(:) = zero
1169	!-
1170	! 17 litter
1171	!-
1172	litterpart(:,:,:) = val_exp
1173	DO l=1,nlitt
1174	var_name = 'litterpart_'//litter_str(l)
1175	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1176	& .TRUE., litterpart(:,:,l), 'gather', nbp_glo, index_g)
1177	IF (ALL(litterpart(:,:,l) == val_exp)) litterpart(:,:,l) = zero
1178	ENDDO
1179	!-
1180	litter(:,:,:,:,:) = val_exp
1181	DO k = 1,nelements
1182	DO l = 1,nlevs
1183	DO m = 1,nvm
1184	WRITE (part_str, '(I2)') m
1185	IF (m<10) part_str(1:1)='0'
1186	var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)//TRIM(element_str(k))
1187	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
1188	& .TRUE., litter(:,:,m,l,k), 'gather', nbp_glo, index_g)
1189	IF (ALL(litter(:,:,m,l,k) == val_exp)) litter(:,:,m,l,k) = zero
1190	ENDDO
1191	ENDDO
1192	END DO
1193	!-
1194	dead_leaves(:,:,:) = val_exp
1195	DO l=1,nlitt
1196	var_name = 'dead_leaves_'//litter_str(l)
1197	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1198	& .TRUE., dead_leaves(:,:,l), 'gather', nbp_glo, index_g)
1199	IF (ALL(dead_leaves(:,:,l) == val_exp)) dead_leaves(:,:,l) = zero
1200	ENDDO
1201	!-
1202	carbon(:,:,:) = val_exp
1203	DO m=1,nvm
1204	WRITE (part_str, '(I2)') m
1205	IF (m<10) part_str(1:1)='0'
1206	var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
1207	CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
1208	& .TRUE., carbon(:,:,m), 'gather', nbp_glo, index_g)
1209	IF (ALL(carbon(:,:,m) == val_exp)) carbon(:,:,m) = zero
1210	ENDDO
1211	!-
1212	lignin_struc(:,:,:) = val_exp
1213	DO l=1,nlevs
1214	var_name = 'lignin_struc_'//level_str(l)
1215	CALL restget_p &
1216	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1217	& .TRUE., lignin_struc(:,:,l), 'gather', nbp_glo, index_g)
1218	IF (ALL(lignin_struc(:,:,l) == val_exp)) lignin_struc(:,:,l) = zero
1219	ENDDO
1220	!-
1221	lignin_wood(:,:,:) = val_exp
1222	DO l=1,nlevs
1223	var_name = 'lignin_wood_'//level_str(l)
1224	CALL restget_p &
1225	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1226	& .TRUE., lignin_wood(:,:,l), 'gather', nbp_glo, index_g)
1227	IF (ALL(lignin_wood(:,:,l) == val_exp)) lignin_wood(:,:,l) = zero
1228	ENDDO
1229	!-
1230	! 18 land cover change
1231	!-
1232	prod_s(:,:) = val_exp
1233	var_name = 'prod_s'
1234	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nshort+1 , 1, itime, &
1235	& .TRUE., prod_s, 'gather', nbp_glo, index_g)
1236	IF (ALL(prod_s(:,:) == val_exp)) prod_s(:,:) = zero
1237
1238	prod_m(:,:) = val_exp
1239	var_name = 'prod_m'
1240	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nmedium+1, 1, itime, &
1241	& .TRUE., prod_m, 'gather', nbp_glo, index_g)
1242	IF (ALL(prod_m(:,:) == val_exp)) prod_m(:,:) = zero
1243
1244	prod_l(:,:) = val_exp
1245	var_name = 'prod_l'
1246	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlong+1 , 1, itime, &
1247	& .TRUE., prod_l, 'gather', nbp_glo, index_g)
1248	IF (ALL(prod_l(:,:) == val_exp)) prod_l(:,:) = zero
1249
1250	flux_s(:,:) = val_exp
1251	var_name = 'flux_s'
1252	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nshort , 1, itime, &
1253	& .TRUE., flux_s, 'gather', nbp_glo, index_g)
1254	IF (ALL(flux_s(:,:) == val_exp)) flux_s(:,:) = zero
1255
1256	flux_m(:,:) = val_exp
1257	var_name = 'flux_m'
1258	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nmedium , 1, itime, &
1259	& .TRUE., flux_m, 'gather', nbp_glo, index_g)
1260	IF (ALL(flux_m(:,:) == val_exp)) flux_m(:,:) = zero
1261
1262	flux_l(:,:) = val_exp
1263	var_name = 'flux_l'
1264	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlong , 1, itime, &
1265	& .TRUE., flux_l, 'gather', nbp_glo, index_g)
1266	IF (ALL(flux_l(:,:) == val_exp)) flux_l(:,:) = zero
1267
1268	cflux_prod_s(:) = val_exp
1269	var_name = 'cflux_prod_s'
1270	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1271	& .TRUE., cflux_prod_s, 'gather', nbp_glo, index_g)
1272	IF (ALL(cflux_prod_s(:) == val_exp)) cflux_prod_s(:) = zero
1273
1274	cflux_prod_m(:) = val_exp
1275	var_name = 'cflux_prod_m'
1276	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1277	& .TRUE., cflux_prod_m, 'gather', nbp_glo, index_g)
1278	IF (ALL(cflux_prod_m(:) == val_exp)) cflux_prod_m(:) = zero
1279
1280	cflux_prod_l(:) = val_exp
1281	var_name = 'cflux_prod_l'
1282	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1283	& .TRUE., cflux_prod_l, 'gather', nbp_glo, index_g)
1284	IF (ALL(cflux_prod_l(:) == val_exp)) cflux_prod_l(:) = zero
1285
1286	rue_longterm(:,:) = val_exp
1287	var_name = 'rue_longterm'
1288	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1289	& .TRUE., rue_longterm(:,:), 'gather', nbp_glo, index_g)
1290	IF (ALL(rue_longterm(:,:) == val_exp)) rue_longterm(:,:) = 1.
1291
1292	!!$ lai_target(:,:) = val_exp
1293	!!$ var_name = 'lai_target'
1294	!!$ CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1295	!!$ & .TRUE., lai_target(:,:), 'gather', nbp_glo, index_g)
1296	!!$ IF (ALL(lai_target(:,:) == val_exp)) lai_target(:,:) = zero
1297
1298	fpc_max(:,:) = val_exp
1299	var_name = 'fpc_max'
1300	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1301	& .TRUE., fpc_max(:,:), 'gather', nbp_glo, index_g)
1302	IF (ALL(fpc_max(:,:) == val_exp)) fpc_max(:,:) = .25
1303
1304	bm_to_litter(:,:,:,:) = val_exp
1305	DO l = 1,nelements
1306	DO k = 1,nparts
1307	WRITE(part_str,'(I2)') k
1308	IF ( k < 10 ) part_str(1:1) = '0'
1309	var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
1310	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1311	& .TRUE., bm_to_litter(:,:,k,l), 'gather', nbp_glo, index_g)
1312	IF (ALL(bm_to_litter(:,:,k,l) == val_exp)) bm_to_litter(:,:,k,l) = zero
1313	ENDDO
1314	END DO
1315
1316	carb_mass_total(:) = val_exp
1317	var_name = 'carb_mass_total'
1318	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1319	& .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
1320	IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
1321
1322	! The routines don't like to store integer variables. So instead
1323	! we create a real array. If the value of the real array is one,
1324	! we assign a value of TRUE to the logical array. Anything
1325	! else is .FALSE.
1326	r_replant(:,:) = val_exp
1327	var_name = 'sc_map'
1328	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1329	& .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
1330	DO ipts=1,npts
1331	DO ivm=1,nvm
1332	IF( r_replant(ipts,ivm) .LT. nvm*2)THEN
1333	species_change_map(ipts,ivm)=NINT(r_replant(ipts,ivm))
1334	ELSE
1335	species_change_map(ipts,ivm)=0
1336	ENDIF
1337	ENDDO
1338	ENDDO
1339
1340	r_replant(:,:) = val_exp
1341	var_name = 'fmc_map'
1342	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1343	& .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
1344	DO ipts=1,npts
1345	DO ivm=1,nvm
1346	IF( r_replant(ipts,ivm) .LT. nvm*2)THEN
1347	fm_change_map(ipts,ivm)=NINT(r_replant(ipts,ivm))
1348	ELSE
1349	fm_change_map(ipts,ivm)=0
1350	ENDIF
1351	ENDDO
1352	ENDDO
1353
1354	! The routines don't like to store logical variables. So instead
1355	! we create a real array. If the value of the real array is one,
1356	! we assign a value of TRUE to the logical array. Anything
1357	! else is .FALSE.
1358	r_replant(:,:) = val_exp
1359	var_name = 'lpft_replant'
1360	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1361	& .TRUE., r_replant(:,:), 'gather', nbp_glo, index_g)
1362	DO ipts=1,npts
1363	DO ivm=1,nvm
1364	IF(ABS(r_replant(ipts,ivm) - un) .LT. 0.001)THEN
1365	lpft_replant(ipts,ivm)=.TRUE.
1366	ENDIF
1367	ENDDO
1368	ENDDO
1369
1370	!-
1371	! 19. Spinup
1372	!-
1373	IF (spinup_analytic) THEN
1374
1375	IF (is_root_prc) THEN
1376	temp_global_years(1) = val_exp
1377	var_name = 'Global_years'
1378	CALL restget (rest_id_stomate, var_name, 1 ,1 , 1, itime, &
1379	& .TRUE., temp_global_years)
1380	IF(temp_global_years(1) == val_exp) temp_global_years(1) = zero
1381	global_years = INT(temp_global_years(1))
1382	ENDIF
1383	CALL bcast(global_years)
1384
1385	nbp_accu(:) = val_exp
1386	var_name = 'nbp_sum'
1387	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1388	& .TRUE., nbp_accu, 'gather', nbp_glo, index_g)
1389	IF (ALL(nbp_accu(:) == val_exp)) nbp_accu(:) = zero
1390
1391	nbp_flux(:) = val_exp
1392	var_name = 'nbp_flux'
1393	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
1394	& .TRUE., nbp_flux, 'gather', nbp_glo, index_g)
1395	IF (ALL(nbp_flux(:) == val_exp)) nbp_flux(:) = zero
1396
1397	!-
1398	ok_equilibrium_real(:) = val_exp
1399	var_name = 'ok_equilibrium'
1400	CALL restget_p (rest_id_stomate, var_name, nbp_glo , 1 , 1, itime, &
1401	& .TRUE., ok_equilibrium_real,'gather', nbp_glo, index_g)
1402	IF (ALL(ok_equilibrium_real(:) == val_exp)) ok_equilibrium_real(:) = zero
1403	WHERE(ok_equilibrium_real(:) >= 0.5)
1404	ok_equilibrium = .TRUE.
1405	ELSEWHERE
1406	ok_equilibrium = .FALSE.
1407	ENDWHERE
1408
1409	MatrixV(:,:,:,:) = val_exp
1410	DO k = 1,nbpools
1411	DO j = 1,nbpools
1412	WRITE(part_str,'(I2)') k
1413	IF (k < 10) part_str(1:1) = '0'
1414	var_name = 'MatrixV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
1415	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1416	& .TRUE., MatrixV(:,:,k,j), 'gather', nbp_glo, index_g)
1417	ENDDO
1418	ENDDO
1419	! If nothing is found in the restart file, we initialize each submatrix by identity
1420	IF (ALL(MatrixV(:,:,:,:) == val_exp)) THEN
1421	MatrixV(:,:,:,:) = zero
1422	DO l = 1,nbpools
1423	MatrixV(:,:,l,l) = un
1424	END DO
1425	END IF
1426
1427	VectorU(:,:,:) = val_exp
1428	DO k= 1,nbpools
1429	WRITE(part_str,'(I2)') k
1430	IF (k < 10) part_str(1:1) = '0'
1431	var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
1432	CALL restget_p &
1433	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1434	& .TRUE., VectorU(:,:,k), 'gather', nbp_glo, index_g)
1435	IF (ALL(VectorU(:,:,k) == val_exp)) VectorU(:,:,k) = zero
1436	ENDDO
1437
1438	previous_stock(:,:,:) = val_exp
1439	DO k= 1,nbpools
1440	WRITE(part_str,'(I2)') k
1441	IF (k < 10) part_str(1:1) = '0'
1442	var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
1443	CALL restget_p &
1444	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1445	& .TRUE., previous_stock(:,:,k), 'gather', nbp_glo, index_g)
1446	IF (ALL(previous_stock(:,:,k) == val_exp)) previous_stock(:,:,k) = undef_sechiba
1447	ENDDO
1448
1449	current_stock(:,:,:) = val_exp
1450	DO k= 1,nbpools
1451	WRITE(part_str,'(I2)') k
1452	IF (k < 10) part_str(1:1) = '0'
1453	var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
1454	CALL restget_p &
1455	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1456	& .TRUE., current_stock(:,:,k), 'gather', nbp_glo, index_g)
1457	IF (ALL(current_stock(:,:,k) == val_exp)) current_stock(:,:,k) = zero
1458	ENDDO
1459
1460	ENDIF ! spinup_matrix_method
1461
1462	!-
1463	! 20. Forest management. Notice that if we're using functional allocation, we are also
1464	! doing forestry in the sense that we have all the same information available.
1465	!-
1466	IF ( control%forest_management .OR. control%ok_functional_allocation ) THEN
1467
1468	temp_real(:,:) = val_exp
1469	var_name = 'age_stand'
1470	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1471	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1472	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1473	age_stand(:,:) = 0
1474	ELSE
1475	age_stand = NINT(temp_real)
1476	ENDIF
1477
1478	mai(:,:) = val_exp
1479	var_name = 'mai'
1480	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1481	& .TRUE., mai, 'gather', nbp_glo, index_g)
1482	IF ( ALL(mai(:,:) == val_exp) ) mai(:,:) = zero
1483
1484	pai(:,:) = val_exp
1485	var_name = 'pai'
1486	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1487	& .TRUE., pai, 'gather', nbp_glo, index_g)
1488	IF ( ALL(pai(:,:) == val_exp) ) pai(:,:) = zero
1489
1490	previous_wood_volume(:,:) = val_exp
1491	var_name = 'previous_wood_volume'
1492	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1493	& .TRUE., previous_wood_volume, 'gather', nbp_glo, index_g)
1494	IF ( ALL(previous_wood_volume(:,:) == val_exp) ) previous_wood_volume(:,:) = zero
1495
1496	temp_real(:,:) = val_exp
1497	var_name = 'mai_count'
1498	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1499	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1500	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1501	mai_count(:,:) = 0
1502	ELSE
1503	mai_count = NINT(temp_real)
1504	ENDIF
1505
1506	coppice_dens(:,:) = val_exp
1507	var_name = 'coppice_dens'
1508	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1509	& .TRUE., coppice_dens, 'gather', nbp_glo, index_g)
1510	IF ( ALL(coppice_dens(:,:) == val_exp) ) coppice_dens(:,:) = zero
1511
1512	!-
1513	temp_real(:,:) = val_exp
1514	var_name = 'fm_lyear'
1515	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1516	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1517	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1518	forest_managed_lastyear(:,:) = 0
1519	ELSE
1520	forest_managed_lastyear = NINT(temp_real)
1521	ENDIF
1522
1523	IF (.NOT.lchange_species) THEN
1524	! In the abscence of a lchange_species the model has to be
1525	! driven by a prescribed value for forest_managed. This
1526	! prescribed value can come from either a FMmap which is
1527	! read in or a value for ::FOREST_MANAGED_FORCED. In these
1528	! cases the values in the restart file are ignored.
1529	ELSE
1530	! We have a lchange_species which implies that we only want
1531	! to read the FMmap once at the start of the simulation
1532	! after which forest_managed becomes a prognostic variable
1533	! (as it may change after a clear cut) and therefore the
1534	! values from the maps are ignored and the value from the
1535	! restart is used except at the first time step.
1536	temp_real(:,:) = val_exp
1537	var_name = 'fm_current'
1538	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1539	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1540	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1541	! This is the first time step. The restart is still empty
1542	! so use the values from the FMmap as read in stomate.f90
1543	! Nothing should be done
1544	ELSE
1545	! As soon as there is something in the restart file these
1546	! values are used to overwrite the values that were read
1547	! from the FMmap.
1548	forest_managed = NINT(temp_real)
1549	ENDIF
1550
1551	END IF
1552
1553	!-
1554	!+++CHECK+++
1555	! The comment is true for height but not for av_height
1556	!!$ ! av_height is read just to show that it is in the restart file. It is not used
1557	!!$ ! and therefore it is not passed to stomate.f90. It is however written because to
1558	!!$ ! restart file because slowproc.f90 checks wether it has a value. If it has a value
1559	!!$ ! that value is used by sechiba. If not it implies that stomate.f90 was not used
1560	!!$ ! and then it uses a prescribed height.
1561	!!$ av_height(:,:) = val_exp
1562	!!$ var_name = 'av_height'
1563	!!$ CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1564	!!$ & .TRUE., av_height, 'gather', nbp_glo, index_g)
1565	!!$ IF ( ALL(av_height(:,:) == val_exp) ) av_height(:,:) = un
1566	!+++++++++++
1567	!-
1568	temp_real(:,:) = val_exp
1569	var_name = 'rotation_n'
1570	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1571	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1572	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1573	rotation_n(:,:) = 1
1574	ELSE
1575	rotation_n(:,:) = NINT(temp_real(:,:))
1576	ENDIF
1577	!-
1578	temp_real(:,:) = val_exp
1579	var_name = 'last_cut'
1580	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1581	& .TRUE., temp_real, 'gather', nbp_glo, index_g)
1582	IF ( ALL(temp_real(:,:) == val_exp) ) THEN
1583	last_cut(:,:) = 0
1584	ELSE
1585	last_cut(:,:) = NINT(temp_real(:,:))
1586	ENDIF
1587	!-
1588	!!$ lai_max_calc(:,:) = val_exp
1589	!!$ var_name = 'lai_max_calc'
1590	!!$ CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1591	!!$ & .TRUE., lai_max_calc, 'gather', nbp_glo, index_g)
1592	!!$ IF ( ALL(lai_max_calc(:,:) == val_exp) ) lai_max_calc(:,:) = un
1593	!!$ !-
1594	!!$ biomass_lastyear(:,:,:,:) = val_exp
1595	!!$ DO k = 1,nparts
1596	!!$ WRITE(part_str,'(I2)') k
1597	!!$ IF ( k < 10 ) part_str(1:1) = '0'
1598	!!$ var_name = 'bm_lyear_'//part_str(1:LEN_TRIM(part_str))
1599	!!$ CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1600	!!$ & .TRUE., biomass_lastyear(:,:,k,icarbon), 'gather', nbp_glo, index_g)
1601	!!$ IF ( ALL(biomass_lastyear(:,:,k,icarbon) == val_exp) ) biomass_lastyear(:,:,k,icarbon) = zero
1602	!!$ ENDDO
1603	!!$ !-
1604	!!$ lai_max_lastyear(:,:) = val_exp
1605	!!$ var_name = 'lai_max_lyear'
1606	!!$ CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1607	!!$ & .TRUE., lai_max_lastyear, 'gather', nbp_glo, index_g)
1608	!!$ IF ( ALL(lai_max_lastyear(:,:) == val_exp) ) lai_max_lastyear(:,:) = zero
1609
1610	END IF ! (control%forest_management)
1611
1612	IF (bavard >= 4) WRITE(numout,*) 'Leaving readrestart'
1613
1614	END SUBROUTINE readrestart
1615
1616
1617	!! ================================================================================================================================
1618	!! SUBROUTINE : writerestart
1619	!!
1620	!>\BRIEF writes start file
1621	!!
1622	!! DESCRIPTION : None
1623	!!
1624	!! RECENT CHANGE(S): None
1625	!!
1626	!! MAIN OUTPUT VARIABLE(S):
1627	!!
1628	!! REFERENCE(S) : None
1629	!!
1630	!! FLOWCHART : None
1631	!! \n
1632	!_ ================================================================================================================================
1633
1634	SUBROUTINE writerestart (npts, index, day_counter, dt_days, &
1635	date, ind, adapted, regenerate, &
1636	moiavail_daily, gdd_init_date, litterhum_daily, t2m_daily, &
1637	t2m_min_daily, tsurf_daily, tsoil_daily, soilhum_daily, &
1638	precip_daily, gpp_daily, npp_daily, turnover_daily, &
1639	moiavail_month, moiavail_week, moiavail_growingseason, t2m_longterm, &
1640	tlong_ref, t2m_month, t2m_week, tsoil_month, &
1641	soilhum_month, fireindex, firelitter, maxmoiavail_lastyear, &
1642	maxmoiavail_thisyear, minmoiavail_lastyear, minmoiavail_thisyear, maxgppweek_lastyear, &
1643	maxgppweek_thisyear, gdd0_lastyear, gdd0_thisyear, precip_lastyear, &
1644	precip_thisyear, gdd_m5_dormance, gdd_from_growthinit, gdd_midwinter, &
1645	ncd_dormance, ngd_minus5, PFTpresent, npp_longterm, &
1646	lm_lastyearmax, lm_thisyearmax, maxfpc_lastyear, maxfpc_thisyear, &
1647	turnover_longterm, gpp_week, biomass, resp_maint_part, &
1648	leaf_age, leaf_frac, senescence, senescence_days, &
1649	when_growthinit, age, resp_hetero, resp_maint, &
1650	resp_growth, co2_fire, co2_to_bm_dgvm, veget_lastlight, &
1651	everywhere, need_adjacent, RIP_time, time_lowgpp, &
1652	time_hum_min, hum_min_dormance, litterpart, litter, &
1653	dead_leaves, carbon, black_carbon, lignin_struc, &
1654	lignin_wood, turnover_time, prod_s, prod_m, prod_l, &
1655	flux_s, flux_m, flux_l, cflux_prod_s, cflux_prod_m, &
1656	cflux_prod_l, bm_to_litter, carb_mass_total, &
1657	age_stand, &
1658	rotation_n, last_cut, forest_managed, forest_managed_lastyear, &
1659	global_years, ok_equilibrium, nbp_accu, &
1660	nbp_flux, MatrixV, VectorU, previous_stock, &
1661	current_stock, rue_longterm, fpc_max, &
1662	circ_class_n, circ_class_biomass, KF, &
1663	mai, pai, previous_wood_volume, &
1664	mai_count, coppice_dens, vir_moiavail_growingseason, lai_per_level,&
1665	laieff_fit, temp_growth, wstress_season, wstress_month, &
1666	vir_wstress_fac, c_buried, k_latosa_adapt, species_change_map, &
1667	fm_change_map, lpft_replant)
1668
1669	IMPLICIT NONE
1670
1671	!! 0. Parameters and variables declaration
1672
1673	!! 0.1 Input variables
1674
1675	INTEGER(i_std), INTENT(in) :: npts !! Domain size
1676	INTEGER(i_std), DIMENSION(npts), INTENT(in) :: index !! Indices of the points on the map
1677	REAL(r_std), INTENT(in) :: day_counter !! counts time until next STOMATE time step
1678	REAL(r_std), INTENT(in) :: dt_days !! time step of STOMATE in days
1679	INTEGER(i_std), INTENT(in) :: date !! date (d)
1680	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ind !! density of individuals (1/m**2)
1681	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: adapted !! Winter too cold? between 0 and 1
1682	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: regenerate !! Winter sufficiently cold? between 0 and 1
1683	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily !! daily moisture availability
1684	REAL(r_std), DIMENSION(npts,4), INTENT(in) :: gdd_init_date !! date for beginning of gdd count
1685	REAL(r_std), DIMENSION(npts), INTENT(in) :: litterhum_daily !! daily litter humidity
1686	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily !! daily 2 meter temperatures (K)
1687	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_min_daily !! daily minimum 2 meter temperatures (K)
1688	REAL(r_std), DIMENSION(npts), INTENT(in) :: tsurf_daily !! daily surface temperatures (K)
1689	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_daily !! daily soil temperatures (K)
1690	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_daily !! daily soil humidity
1691	REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_daily !! daily precipitations (mm/day) (for phenology)
1692	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp_daily !! daily gross primary productivity (gC/m**2/day)
1693	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: npp_daily !! daily net primary productivity (gC/m**2/day)
1694	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_daily !! daily turnover rates (gC/m**2/day)
1695	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_month !! "monthly" moisture availability
1696	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_week !! "weekly" moisture availability
1697	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_growingseason !! "growing season" moisture availability
1698	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: vir_moiavail_growingseason !! Virtual "growing season" moisture availability
1699	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_longterm !! "long term" 2 meter temperatures (K)
1700	REAL(r_std), DIMENSION(npts), INTENT(in) :: tlong_ref !! "long term" reference 2 meter temperatures (K)
1701	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_month !! "monthly" 2 meter temperatures (K)
1702	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_week !! "weekly" 2 meter temperatures (K)
1703	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_month !! "monthly" soil temperatures (K)
1704	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_month !! "monthly" soil humidity
1705	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fireindex !! Probability of fire
1706	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: firelitter !! Longer term total litter above
1707	!! the ground, gC/m**2 of ground
1708	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxmoiavail_lastyear !! last year's maximum
1709	!! moisture availability
1710	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxmoiavail_thisyear !! this year's maximum
1711	!! moisture availability
1712	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: minmoiavail_lastyear !! last year's minimum
1713	!! moisture availability
1714	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: minmoiavail_thisyear !! this year's minimum
1715	!! moisture availability
1716	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxgppweek_lastyear !! last year's maximum weekly GPP
1717	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxgppweek_thisyear !! this year's maximum weekly GPP
1718	REAL(r_std), DIMENSION(npts), INTENT(in) :: gdd0_lastyear !! last year's annual GDD0
1719	REAL(r_std), DIMENSION(npts), INTENT(in) :: gdd0_thisyear !! this year's annual GDD0
1720	REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_lastyear !! last year's annual precipitation
1721	!! (mm/year)
1722	REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_thisyear !! this year's annual precipitation
1723	!! (mm/year)
1724	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gdd_m5_dormance !! growing degree days, threshold
1725	!! -5 deg C (for phenology)
1726	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gdd_from_growthinit !! growing degree days,
1727	!! from begin of season
1728	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gdd_midwinter !! growing degree days since
1729	!! midwinter (for phenology)
1730	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ncd_dormance !! number of chilling days since
1731	!! leaves were lost (for phenology)
1732	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: ngd_minus5 !! number of growing days, threshold
1733	!! -5 deg C (for phenology)
1734	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: PFTpresent !! PFT exists (equivalent to
1735	!! fpc_max > 0 for natural PFTs)
1736	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: npp_longterm !! "long term" net primary productivity
1737	!! (gC/m**2/year)
1738	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_lastyearmax !! last year's maximum leaf mass,
1739	!! for each PFT (gC/m**2)
1740	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: lm_thisyearmax !! this year's maximum leaf mass,
1741	!! for each PFT (gC/m**2)
1742	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_lastyear !! last year's maximum fpc for each
1743	!! natural PFT, on ground
1744	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: maxfpc_thisyear !! this year's maximum fpc for each
1745	!! PFT, on total ground (see stomate_season)
1746	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: turnover_longterm !! "long term" turnover rate (gC/m**2/year)
1747	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp_week !! "weekly" GPP (gC/day/(m**2 covered)
1748	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass !! biomass (gC/m**2)
1749	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: resp_maint_part !! maintenance resp (gC/m**2)
1750	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(in) :: leaf_age !! leaf age (days)
1751	REAL(r_std), DIMENSION(npts,nvm,nleafages), INTENT(in) :: leaf_frac !! fraction of leaves in leaf age class
1752	REAL(r_std), DIMENSION(npts,nvm,ncirc), INTENT(in) :: circ_class_n !! Number of trees in each circumference classes
1753	REAL(r_std), DIMENSION(npts,nvm,ncirc,nparts,nelements), INTENT(in):: circ_class_biomass !! Biomass components of the model tree within
1754	!! each circumference classes (gC ind-1)
1755	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: senescence !! is the plant senescent ?
1756	!! (only for deciduous trees -
1757	!! carbohydrate reserve)
1758	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: senescence_days !! Days since start of senescence
1759	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit !! how many days ago was the beginning
1760	!! of the growing season
1761	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: age !! mean age (years)
1762	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: resp_hetero !! heterotrophic respiration (gC/day/m**2)
1763	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: resp_maint !! maintenance respiration (gC/day/m**2)
1764	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: resp_growth !! growth respiration (gC/day/m**2)
1765	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: co2_fire !! carbon emitted into the atmosphere
1766	!! by fire (living and dead biomass)
1767	!! (in gC/m**2/time step)
1768	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: co2_to_bm_dgvm !! biomass uptaken
1769	!! (gC/(m**2 of total ground)/day)
1770	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_lastlight !! vegetation fractions (on ground)
1771	!! after last light competition
1772	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: everywhere !! is the PFT everywhere in the
1773	!! grid box or very localized
1774	!! (after its introduction)
1775	LOGICAL, DIMENSION(npts,nvm), INTENT(in) :: need_adjacent !! in order for this PFT to be introduced,
1776	!! does it have to be present in an
1777	!! adjacent grid box?
1778	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: RIP_time !! How much time ago was the PFT eliminated
1779	!! for the last time (y)
1780	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: time_lowgpp !! Duration of dormance (d)
1781	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: time_hum_min !! time elapsed since strongest moisture
1782	!! availability (d)
1783	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: hum_min_dormance !! minimum moisture during dormance
1784	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in) :: litterpart !! fraction of litter above the ground
1785	!! belonging to different PFTs separated
1786	!! for natural and agricultural PFTs.
1787	REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: litter !! metabolic and structural litter,
1788	!! natural and agricultural, above and
1789	!! below ground (gC/m**2)
1790	REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in) :: dead_leaves !! dead leaves on ground, per PFT,
1791	!! metabolic and structural,
1792	!! in gC/(m**2 of ground)
1793	REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in) :: carbon !! carbon pool: active, slow, or passive,
1794	!! (gC/m**2)
1795	REAL(r_std), DIMENSION(npts), INTENT(in) :: black_carbon !! black carbon on the ground
1796	!! (gC/(m**2 of total ground))
1797	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(in) :: lignin_struc !! ratio Lignine/Carbon in structural litter,
1798	!! above and below ground,
1799	!! (gC/m**2)
1800	REAL(r_std), DIMENSION(npts,nvm,nlevs), INTENT(in) :: lignin_wood !! ratio Lignine/Carbon in woody litter,
1801	!! above and below ground,
1802	!! (gC/m**2)
1803	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: turnover_time !!
1804	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: age_stand !! Age of stand (years)
1805	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: rotation_n !! Rotation number (number of rotation
1806	!! since pft is managed)
1807	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: last_cut !! Years since last thinning (years)
1808	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: forest_managed !! forest management flag
1809	INTEGER(i_std), DIMENSION(npts,nvm), INTENT(in) :: forest_managed_lastyear !! forest management flag for the previous year
1810	REAL(r_std), DIMENSION(npts,0:nshort), INTENT(in) :: prod_s !!
1811	REAL(r_std), DIMENSION(npts,0:nmedium), INTENT(in) :: prod_m !!
1812	REAL(r_std), DIMENSION(npts,0:nlong), INTENT(in) :: prod_l !!
1813	REAL(r_std), DIMENSION(npts,nshort), INTENT(in) :: flux_s !!
1814	REAL(r_std), DIMENSION(npts,nmedium), INTENT(in) :: flux_m !!
1815	REAL(r_std), DIMENSION(npts,nlong), INTENT(in) :: flux_l !!
1816	REAL(r_std), DIMENSION(npts), INTENT(in) :: cflux_prod_s !!
1817	REAL(r_std), DIMENSION(npts), INTENT(in) :: cflux_prod_m !!
1818	REAL(r_std), DIMENSION(npts), INTENT(in) :: cflux_prod_l !!
1819	REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: bm_to_litter !!
1820	REAL(r_std), DIMENSION(npts), INTENT(in) :: carb_mass_total !!
1821	INTEGER(i_std), INTENT(in) :: global_years !!
1822	LOGICAL, DIMENSION(npts), INTENT(in) :: ok_equilibrium !!
1823	REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_accu !! Accumulated Net Biospheric
1824	!! Production over the year
1825	REAL(r_std), DIMENSION(npts), INTENT(in) :: nbp_flux !! Net Biospheric Production over the year
1826	REAL(r_std), DIMENSION(npts,nvm,nbpools,nbpools), INTENT(in) :: MatrixV !!
1827	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: VectorU !!
1828	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: previous_stock !!
1829	REAL(r_std), DIMENSION(npts,nvm,nbpools), INTENT(in) :: current_stock !!
1830	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: rue_longterm !! Longterm radiation use efficiency
1831	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: fpc_max !! Leaf projective cover
1832	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: KF !! Scaling factor to convert sapwood mass
1833	!! into leaf mass (m)
1834	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: k_latosa_adapt !! Leaf to sapwood area adapted for water
1835	!! stress. Adaptation takes place at the
1836	!! end of the year (m)
1837	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: mai !! The mean annual increment
1838	!! @tex $(m3 / m2 / year)$ @endtex
1839	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: pai !! The period annual increment
1840	!! @tex $(m3 / m2 / year)$ @endtex
1841	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: previous_wood_volume !! The volume of the tree trunks
1842	!! in a stand for the previous year.
1843	!! @tex $(m3 / m2 )$ @endtex
1844	INTEGER(i_std), DIMENSION(npts,nvm),INTENT(in) :: mai_count !! The number of times we've
1845	!! calculated the volume increment
1846	!! for a stand
1847	REAL(r_std), DIMENSION(npts,nvm),INTENT(in) :: coppice_dens !! The density of a coppice at the first
1848	!! cutting.
1849	!! @tex $( 1 / m**2 )$ @endtex
1850	REAL(r_std), DIMENSION(npts,nvm,nlevels_tot), INTENT(in) :: lai_per_level !! The amount of LAI in each physical
1851	!! canopy level.
1852	!! @tex $( m2 / m2 )$ @endtex
1853	TYPE(laieff_type),DIMENSION (:,:,:),INTENT(in) :: laieff_fit !! Fitted parameters for the effective LAI
1854	REAL(r_std),DIMENSION(npts),INTENT(in) :: temp_growth !! Growth temperature (Â°C)
1855	!! Is equal to t2m_month
1856	REAL(r_std), DIMENSION(:,:), INTENT(in) :: vir_wstress_fac !! Virtual water stress factor, based on hum_rel_daily
1857	!! (unitless, 0-1)
1858	REAL(r_std), DIMENSION(:,:), INTENT(in) :: wstress_season !! Water stress factor, based on hum_rel_daily
1859	!! (unitless, 0-1)
1860	REAL(r_std), DIMENSION(:,:), INTENT(in) :: wstress_month !! Water stress factor, based on hum_rel_daily
1861	!! (unitless, 0-1)
1862	REAL(r_std), DIMENSION(:,:), INTENT(in) :: c_buried !! Carbon that is buried when land cover changes
1863	!! to a nobio type.
1864	!! @tex $( gC )$ @endtex
1865	INTEGER(i_std), DIMENSION(:,:), INTENT(in) :: species_change_map !! A map which gives the PFT number that each
1866	!! PFT will be replanted as in case of a clearcut.
1867	!! (1-nvm,unitless)
1868	INTEGER(i_std), DIMENSION(:,:), INTENT(in) :: fm_change_map !! A map which gives the desired FM strategy when
1869	!! the PFT will be replanted after a clearcut.
1870	!! (1-nvm,unitless)
1871	LOGICAL, DIMENSION(:,:), INTENT(in) :: lpft_replant !! Indicates if this PFT has either died this year
1872	!! or been clearcut/coppiced. If it has, it is not
1873	!! replanted until the end of the year.
1874
1875	!! 0.4 Local variables
1876
1877	REAL(r_std) :: date_real !! date, real
1878	REAL(r_std), DIMENSION(npts,nvm) :: PFTpresent_real !! PFT exists (equivalent to
1879	!! fpc_max > 0 for natural PFTs), real
1880	REAL(r_std), DIMENSION(npts,nvm) :: senescence_real !! is the plant senescent ?
1881	!! (only for deciduous trees -
1882	!! carbohydrate reserve), real
1883	REAL(r_std), DIMENSION(npts,nvm) :: need_adjacent_real !! in order for this PFT to be introduced,
1884	!! does it have to be present in an
1885	!! adjacent grid box? - real
1886	CHARACTER(LEN=80) :: var_name !! To store variables names for I/O
1887	CHARACTER(LEN=10) :: part_str !! string suffix indicating an index
1888	CHARACTER(LEN=10) :: part_str2 !! string suffix indicating an index
1889	CHARACTER(LEN=10) :: circ_str !! string suffix indicating an index
1890	CHARACTER(LEN=3), DIMENSION(nlitt) :: litter_str !! string suffix indicating litter type
1891	CHARACTER(LEN=2), DIMENSION(nlevs) :: level_str !! string suffix indicating level
1892	REAL(r_std), DIMENSION(1) :: xtmp !! temporary storage
1893	INTEGER(i_std) :: j,k,l,m,p,ibp !! index
1894	INTEGER(i_std) :: idia, icut, ifm !! index
1895	INTEGER(i_std) :: ipts, ivm !! index
1896	CHARACTER(LEN=2), DIMENSION(nelements) :: element_str !! string suffix indicating element
1897	REAL(r_std), DIMENSION(npts,nvm) :: temp_real !! temporary real to allow restget
1898	!! to work on multi-dimensional integers
1899	REAL(r_std), DIMENSION(1) :: temp_global_years !!
1900	CHARACTER(LEN=7), DIMENSION(nbpools) :: pools_str !!
1901	REAL(r_std), DIMENSION(npts) :: ok_equilibrium_real !!
1902	REAL(r_std), DIMENSION(npts,nvm) :: lai !! Leaf area index
1903	!! @tex $(m^{2}.m^{-2})$ @endtex
1904	CHARACTER(LEN=80) :: cut_name !! To store variables names for I/O
1905	CHARACTER(LEN=80) :: fm_name !! To store variables names for I/O
1906	REAL(r_std),DIMENSION(npts,nvm,nlevels_tot,nparams_laieff) :: temp_array !! To store structure values for I/O
1907	INTEGER :: n,ilev !! Indices
1908	REAL(r_std), DIMENSION(npts,nvm) :: r_replant !! Writing integer and logical values
1909	!! to the restart file is not possible,
1910	!! so we convert to real first.
1911	!! 1.0 is TRUE for a logical array.
1912	!_ ================================================================================================================================
1913
1914	IF (bavard >= 3) WRITE(numout,*) 'Entering writerestart'
1915	!-
1916	! 1 string definitions
1917	!-
1918	DO l=1,nlitt
1919	IF (l == imetabolic) THEN
1920	litter_str(l) = 'met'
1921	ELSEIF (l == istructural) THEN
1922	litter_str(l) = 'str'
1923	ELSEIF (l == iwoody) THEN
1924	litter_str(l) = 'wod'
1925	ELSE
1926	CALL ipslerr_p (3,'stomate_io', &
1927	'Write restart - Define litter str','','')
1928	ENDIF
1929	ENDDO
1930	!-
1931	DO l=1,nlevs
1932	IF (l == iabove) THEN
1933	level_str(l) = 'ab'
1934	ELSEIF (l == ibelow) THEN
1935	level_str(l) = 'be'
1936	ELSE
1937	CALL ipslerr_p (3,'stomate_io', &
1938	'Write restart - Define level str','','')
1939	ENDIF
1940	ENDDO
1941	!-
1942	DO l=1,nelements
1943	IF (l == icarbon) THEN
1944	element_str(l) = ''
1945	!!$ ELSEIF (l == initrogen) THEN
1946	!!$ element_str(l) = '_n'
1947	ELSE
1948	CALL ipslerr_p (3,'stomate_io', &
1949	'Write restart - Define element str','','')
1950	ENDIF
1951	ENDDO
1952	!-
1953	pools_str(1:nbpools) =(/'str_ab ','str_be ','met_ab ','met_be ','wood_ab','wood_be', &
1954	'actif ','slow ','passif '/)
1955	!-
1956	IF (is_root_prc) THEN
1957	CALL ioconf_setatt_p ('UNITS','-')
1958	CALL ioconf_setatt_p ('LONG_NAME',' ')
1959	ENDIF
1960	!-
1961	! 2 run control
1962	!-
1963	! 2.1 day counter
1964	!-
1965	IF (is_root_prc) THEN
1966	var_name = 'day_counter'
1967	xtmp(1) = day_counter
1968	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1969	ENDIF
1970	!-
1971	! 2.2 time step of STOMATE in days
1972	!-
1973	IF (is_root_prc) THEN
1974	var_name = 'dt_days'
1975	xtmp(1) = dt_days
1976	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1977	ENDIF
1978	!-
1979	! 2.3 date
1980	!-
1981	IF (is_root_prc) THEN
1982	var_name = 'date'
1983	date_real = REAL(date,r_std)
1984	xtmp(1) = date_real
1985	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1986	ENDIF
1987	!-
1988	! 3 daily meteorological variables
1989	!-
1990	var_name = 'moiavail_daily'
1991	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1992	& moiavail_daily, 'scatter', nbp_glo, index_g)
1993	!-
1994	var_name = 'gdd_init_date'
1995	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 4, 1, itime, &
1996	& gdd_init_date, 'scatter', nbp_glo, index_g)
1997	!-
1998	var_name = 'litterhum_daily'
1999	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2000	& litterhum_daily, 'scatter', nbp_glo, index_g)
2001	!-
2002	var_name = 't2m_daily'
2003	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2004	& t2m_daily, 'scatter', nbp_glo, index_g)
2005	!-
2006	var_name = 't2m_min_daily'
2007	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2008	& t2m_min_daily, 'scatter', nbp_glo, index_g)
2009	!-
2010	var_name = 'tsurf_daily'
2011	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2012	& tsurf_daily, 'scatter', nbp_glo, index_g)
2013	!-
2014	var_name = 'tsoil_daily'
2015	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
2016	& tsoil_daily, 'scatter', nbp_glo, index_g)
2017	!-
2018	var_name = 'soilhum_daily'
2019	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
2020	& soilhum_daily, 'scatter', nbp_glo, index_g)
2021	!-
2022	var_name = 'precip_daily'
2023	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2024	& precip_daily, 'scatter', nbp_glo, index_g)
2025	!-
2026	var_name = 'temp_growth'
2027	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2028	& temp_growth, 'scatter', nbp_glo, index_g)
2029	!-
2030	var_name = 'wstress_season'
2031	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2032	& wstress_season, 'scatter', nbp_glo, index_g)
2033	!-
2034	var_name = 'wstress_month'
2035	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2036	& wstress_month, 'scatter', nbp_glo, index_g)
2037	!-
2038	var_name = 'vir_wstress_fac'
2039	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2040	& vir_wstress_fac, 'scatter', nbp_glo, index_g)
2041	var_name = 'c_buried'
2042	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nnobio, 1, itime, &
2043	& c_buried, 'scatter', nbp_glo, index_g)
2044
2045	!-
2046	! 4 productivities
2047	!-
2048	var_name = 'gpp_daily'
2049	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2050	& gpp_daily, 'scatter', nbp_glo, index_g)
2051	!-
2052	var_name = 'npp_daily'
2053	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2054	& npp_daily, 'scatter', nbp_glo, index_g)
2055	!-
2056	DO l = 1,nelements
2057	DO k = 1,nparts
2058	WRITE(part_str,'(I2)') k
2059	IF (k < 10) part_str(1:1) = '0'
2060	var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
2061	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2062	& turnover_daily(:,:,k,l), 'scatter', nbp_glo, index_g)
2063	ENDDO
2064	END DO
2065	!-
2066	! 5 monthly meteorological variables
2067	!-
2068	var_name = 'moiavail_month'
2069	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2070	& moiavail_month, 'scatter', nbp_glo, index_g)
2071	!-
2072	var_name = 'moiavail_week'
2073	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2074	& moiavail_week, 'scatter', nbp_glo, index_g)
2075	!-
2076	var_name = 'moiavail_gs'
2077	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2078	& moiavail_growingseason, 'scatter', nbp_glo, index_g)
2079	!-
2080	var_name = 'vir_moiavail_gs'
2081	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2082	& vir_moiavail_growingseason, 'scatter', nbp_glo, index_g)
2083	!-
2084	var_name = 't2m_longterm'
2085	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2086	& t2m_longterm, 'scatter', nbp_glo, index_g)
2087	!-
2088	IF (control%ok_dgvm) THEN
2089	var_name = 'tlong_ref'
2090	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2091	& tlong_ref, 'scatter', nbp_glo, index_g)
2092	ENDIF
2093	!-
2094	var_name = 't2m_month'
2095	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2096	& t2m_month, 'scatter', nbp_glo, index_g)
2097	!-
2098	var_name = 't2m_week'
2099	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2100	& t2m_week, 'scatter', nbp_glo, index_g)
2101	!-
2102	var_name = 'tsoil_month'
2103	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
2104	& tsoil_month, 'scatter', nbp_glo, index_g)
2105	!-
2106	var_name = 'soilhum_month'
2107	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
2108	& soilhum_month, 'scatter', nbp_glo, index_g)
2109	!-
2110	! 6 fire probability
2111	!-
2112	var_name = 'fireindex'
2113	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2114	& fireindex, 'scatter', nbp_glo, index_g)
2115	!-
2116	var_name = 'firelitter'
2117	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2118	& firelitter, 'scatter', nbp_glo, index_g)
2119	!-
2120	! 7 maximum and minimum moisture availabilities for tropic phenology
2121	!-
2122	var_name = 'maxmoistr_last'
2123	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2124	& maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
2125	!-
2126	var_name = 'maxmoistr_this'
2127	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2128	& maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
2129	!-
2130	var_name = 'minmoistr_last'
2131	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2132	& minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
2133	!-
2134	var_name = 'minmoistr_this'
2135	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2136	& minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
2137	!-
2138	! 8 maximum "weekly" GPP
2139	!-
2140	var_name = 'maxgppweek_lastyear'
2141	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2142	& maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
2143	!-
2144	var_name = 'maxgppweek_thisyear'
2145	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2146	& maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
2147	!-
2148	! 9 annual GDD0
2149	!-
2150	var_name = 'gdd0_thisyear'
2151	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2152	& gdd0_thisyear, 'scatter', nbp_glo, index_g)
2153	!-
2154	var_name = 'gdd0_lastyear'
2155	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2156	& gdd0_lastyear, 'scatter', nbp_glo, index_g)
2157	!-
2158	! 10 annual precipitation
2159	!-
2160	var_name = 'precip_thisyear'
2161	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2162	& precip_thisyear, 'scatter', nbp_glo, index_g)
2163	!-
2164	var_name = 'precip_lastyear'
2165	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2166	& precip_lastyear, 'scatter', nbp_glo, index_g)
2167	!-
2168	! 11 derived "biometeorological" variables
2169	!-
2170	var_name = 'gdd_m5_dormance'
2171	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2172	& gdd_m5_dormance, 'scatter', nbp_glo, index_g)
2173	!-
2174	var_name = 'gdd_from_growthinit'
2175	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2176	& gdd_from_growthinit, 'scatter', nbp_glo, index_g)
2177	!-
2178	var_name = 'gdd_midwinter'
2179	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2180	& gdd_midwinter, 'scatter', nbp_glo, index_g)
2181	!-
2182	var_name = 'ncd_dormance'
2183	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2184	& ncd_dormance, 'scatter', nbp_glo, index_g)
2185	!-
2186	var_name = 'ngd_minus5'
2187	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2188	& ngd_minus5, 'scatter', nbp_glo, index_g)
2189	!-
2190	var_name = 'time_lowgpp'
2191	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2192	& time_lowgpp, 'scatter', nbp_glo, index_g)
2193	!-
2194	var_name = 'time_hum_min'
2195	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2196	& time_hum_min, 'scatter', nbp_glo, index_g)
2197	!-
2198	var_name = 'hum_min_dormance'
2199	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2200	& hum_min_dormance, 'scatter', nbp_glo, index_g)
2201	!-
2202	! 12 Plant status
2203	!-
2204	var_name = 'PFTpresent'
2205	WHERE ( PFTpresent(:,:) )
2206	PFTpresent_real = un
2207	ELSEWHERE
2208	PFTpresent_real = zero
2209	ENDWHERE
2210	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2211	& PFTpresent_real, 'scatter', nbp_glo, index_g)
2212	!-
2213	var_name = 'ind'
2214	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2215	& ind, 'scatter', nbp_glo, index_g)
2216	!-
2217	DO k = 1,nparts
2218	WRITE(part_str,'(I2)') k
2219	IF (k < 10) part_str(1:1) = '0'
2220	var_name = 'turnover_time_'//part_str(1:LEN_TRIM(part_str))
2221	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2222	& turnover_time(:,:,k), 'scatter', nbp_glo, index_g)
2223	ENDDO
2224
2225	!-
2226	var_name = 'adapted'
2227	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2228	& adapted, 'scatter', nbp_glo, index_g)
2229	!-
2230	var_name = 'regenerate'
2231	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2232	& regenerate, 'scatter', nbp_glo, index_g)
2233	!-
2234	var_name = 'npp_longterm'
2235	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2236	& npp_longterm, 'scatter', nbp_glo, index_g)
2237	!-
2238	var_name = 'lm_lastyearmax'
2239	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2240	& lm_lastyearmax, 'scatter', nbp_glo, index_g)
2241	!-
2242	var_name = 'lm_thisyearmax'
2243	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2244	& lm_thisyearmax, 'scatter', nbp_glo, index_g)
2245	!-
2246	var_name = 'maxfpc_lastyear'
2247	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2248	& maxfpc_lastyear, 'scatter', nbp_glo, index_g)
2249	!-
2250	var_name = 'maxfpc_thisyear'
2251	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2252	& maxfpc_thisyear, 'scatter', nbp_glo, index_g)
2253	!-
2254	DO l = 1,nelements
2255	DO k = 1,nparts
2256	WRITE(part_str,'(I2)') k
2257	IF (k < 10) part_str(1:1) = '0'
2258	var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
2259	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2260	& turnover_longterm(:,:,k,l), 'scatter', nbp_glo, index_g)
2261	ENDDO
2262	END DO
2263	!-
2264	var_name = 'gpp_week'
2265	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2266	& gpp_week, 'scatter', nbp_glo, index_g)
2267	!-
2268	DO l = 1,nelements
2269	DO k = 1,nparts
2270	WRITE(part_str,'(I2)') k
2271	IF (k < 10) part_str(1:1) = '0'
2272	var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
2273	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2274	& biomass(:,:,k,l), 'scatter', nbp_glo, index_g)
2275	ENDDO
2276	END DO
2277	!-
2278	DO ivm = 1,nvm
2279	DO ipts = 1,npts
2280	lai(ipts,ivm) = biomass_to_lai(biomass(ipts,ivm,ileaf,icarbon),ivm)
2281	ENDDO
2282	ENDDO
2283	var_name = 'lai'
2284	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2285	& lai, 'scatter', nbp_glo, index_g)
2286	!-
2287	DO k=1,nparts
2288	WRITE(part_str,'(I2)') k
2289	IF (k < 10) part_str(1:1) = '0'
2290	var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
2291	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2292	& resp_maint_part(:,:,k), 'scatter', nbp_glo, index_g)
2293	ENDDO
2294	!-
2295	DO m=1,nleafages
2296	WRITE(part_str,'(I2)') m
2297	IF (m < 10) part_str(1:1) = '0'
2298	var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
2299	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2300	& leaf_age(:,:,m), 'scatter', nbp_glo, index_g)
2301	ENDDO
2302	!-
2303	DO m=1,nleafages
2304	WRITE(part_str,'(I2)') m
2305	IF (m < 10) part_str(1:1) = '0'
2306	var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
2307	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2308	& leaf_frac(:,:,m), 'scatter', nbp_glo, index_g)
2309	ENDDO
2310	!-
2311	DO m=1,nlevels_tot
2312	WRITE(part_str,'(I2)') m
2313	IF (m < 10) part_str(1:1) = '0'
2314	var_name = 'lai_per_level_'//part_str(1:LEN_TRIM(part_str))
2315	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2316	& lai_per_level(:,:,m), 'scatter', nbp_glo, index_g)
2317	ENDDO
2318	!-
2319	DO ipts=1,npts
2320	DO ivm=1,nvm
2321	DO ilev=1,nlevels_tot
2322	temp_array(ipts,ivm,ilev,1)=laieff_fit(ipts,ivm,ilev)%a
2323	temp_array(ipts,ivm,ilev,2)=laieff_fit(ipts,ivm,ilev)%b
2324	temp_array(ipts,ivm,ilev,3)=laieff_fit(ipts,ivm,ilev)%c
2325	temp_array(ipts,ivm,ilev,4)=laieff_fit(ipts,ivm,ilev)%d
2326	temp_array(ipts,ivm,ilev,5)=laieff_fit(ipts,ivm,ilev)%e
2327	ENDDO
2328	ENDDO
2329	ENDDO
2330	DO m=1,nlevels_tot
2331	WRITE(part_str,'(I2)') m
2332	IF ( m < 10 ) part_str(1:1) = '0'
2333	DO n=1,nparams_laieff
2334	WRITE(part_str2,'(I2)') n
2335	IF ( n < 10 ) part_str2(1:1) = '0'
2336
2337	var_name = 'laieff_fit__'//part_str(1:LEN_TRIM(part_str)) // '_' &
2338	// part_str2(1:LEN_TRIM(part_str2))
2339	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2340	& temp_array(:,:,m,n), 'scatter', nbp_glo, index_g)
2341	ENDDO
2342	ENDDO
2343	!
2344	DO m=1,ncirc
2345	WRITE(part_str,'(I2)') m
2346	IF (m < 10) part_str(1:1) = '0'
2347	var_name = 'circ_class_n_'//part_str(1:LEN_TRIM(part_str))
2348	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2349	& circ_class_n(:,:,m), 'scatter', nbp_glo, index_g)
2350	ENDDO
2351	!-
2352	DO m = 1,nelements
2353	DO l = 1,nparts
2354	DO k = 1,ncirc
2355	WRITE(part_str,'(I2)') l
2356	IF ( l < 10 ) part_str(1:1) = '0'
2357	WRITE(circ_str, '(I2.2)') k
2358	var_name = 'cc_bio_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(m))//'_'//TRIM(circ_str)
2359	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
2360	& circ_class_biomass(:,:,k,l,m), 'scatter', nbp_glo, index_g)
2361	ENDDO
2362	ENDDO
2363	ENDDO
2364	!-
2365	var_name = 'senescence'
2366	WHERE ( senescence(:,:) )
2367
2368	senescence_real = un
2369
2370	ELSEWHERE
2371
2372	senescence_real = zero
2373
2374	ENDWHERE
2375
2376	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2377	& senescence_real, 'scatter', nbp_glo, index_g)
2378	!-
2379	var_name = 'senescence_days'
2380	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2381	& senescence_days, 'scatter', nbp_glo, index_g)
2382	!-
2383	var_name = 'when_growthinit'
2384	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2385	& when_growthinit, 'scatter', nbp_glo, index_g)
2386	!-
2387	var_name = 'age'
2388	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
2389	& age, 'scatter', nbp_glo, index_g)
2390	!-
2391	var_name = 'KF'
2392	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2393	& KF(:,:), 'scatter', nbp_glo, index_g)
2394	!-
2395	var_name = 'k_latosa_adapt'
2396	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2397	& k_latosa_adapt(:,:), 'scatter', nbp_glo, index_g)
2398	!-
2399	var_name = 'rue_longterm'
2400	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2401	& rue_longterm(:,:), 'scatter', nbp_glo, index_g)
2402	!-
2403	!!$ var_name = 'lai_target'
2404	!!$ CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2405	!!$ & lai_target(:,:), 'scatter', nbp_glo, index_g)
2406	!-
2407	var_name = 'fpc_max'
2408	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2409	& fpc_max(:,:), 'scatter', nbp_glo, index_g)
2410	!-
2411	! 13 CO2
2412	!-
2413	var_name = 'resp_hetero'
2414	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2415	& resp_hetero, 'scatter', nbp_glo, index_g)
2416	!-
2417	var_name = 'resp_maint'
2418	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2419	& resp_maint, 'scatter', nbp_glo, index_g)
2420	!-
2421	var_name = 'resp_growth'
2422	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2423	& resp_growth, 'scatter', nbp_glo, index_g)
2424	!-
2425	var_name = 'co2_fire'
2426	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2427	& co2_fire, 'scatter', nbp_glo, index_g)
2428	!-
2429	var_name = 'co2_to_bm_dgvm'
2430	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2431	& co2_to_bm_dgvm, 'scatter', nbp_glo, index_g)
2432	!-
2433	! 14 vegetation distribution after last light competition
2434	!-
2435	var_name = 'veget_lastlight'
2436	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2437	& veget_lastlight, 'scatter', nbp_glo, index_g)
2438	!-
2439	! 15 establishment criteria
2440	!-
2441	var_name = 'everywhere'
2442	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2443	& everywhere, 'scatter', nbp_glo, index_g)
2444	!-
2445	var_name = 'need_adjacent'
2446	WHERE (need_adjacent(:,:))
2447	need_adjacent_real = un
2448	ELSEWHERE
2449	need_adjacent_real = zero
2450	ENDWHERE
2451	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2452	& need_adjacent_real, 'scatter', nbp_glo, index_g)
2453	!-
2454	var_name = 'RIP_time'
2455	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2456	& RIP_time, 'scatter', nbp_glo, index_g)
2457	!-
2458	! 16 black carbon
2459	!-
2460	var_name = 'black_carbon'
2461	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2462	& black_carbon, 'scatter', nbp_glo, index_g)
2463	!-
2464	! 17 litter
2465	!-
2466	DO l=1,nlitt
2467	var_name = 'litterpart_'//litter_str(l)
2468	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2469	& litterpart(:,:,l), 'scatter', nbp_glo, index_g)
2470	ENDDO
2471	!-
2472	DO k = 1,nelements
2473	DO l = 1,nlevs
2474	DO m = 1,nvm
2475	WRITE (part_str, '(I2)') m
2476	IF (m<10) part_str(1:1)='0'
2477	var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)//TRIM(element_str(k))
2478	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
2479	& litter(:,:,m,l,k), 'scatter', nbp_glo, index_g)
2480	ENDDO
2481	ENDDO
2482	END DO
2483	!-
2484	DO l=1,nlitt
2485	var_name = 'dead_leaves_'//litter_str(l)
2486	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2487	& dead_leaves(:,:,l), 'scatter', nbp_glo, index_g)
2488	ENDDO
2489	!-
2490	DO m=1,nvm
2491	WRITE (part_str, '(I2)') m
2492	IF (m<10) part_str(1:1)='0'
2493	var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
2494	CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
2495	& carbon(:,:,m), 'scatter', nbp_glo, index_g)
2496	ENDDO
2497	!-
2498	DO l=1,nlevs
2499	var_name = 'lignin_struc_'//level_str(l)
2500	CALL restput_p &
2501	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2502	& lignin_struc(:,:,l), 'scatter', nbp_glo, index_g)
2503	ENDDO
2504	!-
2505	DO l=1,nlevs
2506	var_name = 'lignin_wood_'//level_str(l)
2507	CALL restput_p &
2508	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2509	& lignin_wood(:,:,l), 'scatter', nbp_glo, index_g)
2510	ENDDO
2511	!-
2512	! 18 land cover change
2513	!-
2514	var_name = 'prod_s'
2515	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nshort+1, 1, itime, &
2516	& prod_s, 'scatter', nbp_glo, index_g)
2517	var_name = 'prod_m'
2518	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nmedium+1, 1, itime, &
2519	& prod_m, 'scatter', nbp_glo, index_g)
2520	var_name = 'prod_l'
2521	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlong+1, 1, itime, &
2522	& prod_l, 'scatter', nbp_glo, index_g)
2523	var_name = 'flux_s'
2524	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nshort, 1, itime, &
2525	& flux_s, 'scatter', nbp_glo, index_g)
2526	var_name = 'flux_m'
2527	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nmedium, 1, itime, &
2528	& flux_m, 'scatter', nbp_glo, index_g)
2529	var_name = 'flux_l'
2530	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlong, 1, itime, &
2531	& flux_l, 'scatter', nbp_glo, index_g)
2532	var_name = 'cflux_prod_s'
2533	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2534	& cflux_prod_s, 'scatter', nbp_glo, index_g)
2535	var_name = 'cflux_prod_m'
2536	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2537	& cflux_prod_m, 'scatter', nbp_glo, index_g)
2538	var_name = 'cflux_prod_l'
2539	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2540	& cflux_prod_l, 'scatter', nbp_glo, index_g)
2541	DO l = 1,nelements
2542	DO k = 1,nparts
2543	WRITE(part_str,'(I2)') k
2544	IF (k < 10) part_str(1:1) = '0'
2545	var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))//TRIM(element_str(l))
2546	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2547	& bm_to_litter(:,:,k,l), 'scatter', nbp_glo, index_g)
2548	ENDDO
2549	END DO
2550
2551	var_name = 'carb_mass_total'
2552	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2553	& carb_mass_total, 'scatter', nbp_glo, index_g)
2554
2555	! For these next three variables, we have to convert to a real array first.
2556	r_replant(:,:)=REAL(species_change_map(:,:),r_std)
2557	var_name = 'sc_map'
2558	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2559	& r_replant, 'scatter', nbp_glo, index_g)
2560
2561	r_replant(:,:)=REAL(fm_change_map(:,:),r_std)
2562	var_name = 'fmc_map'
2563	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2564	& r_replant, 'scatter', nbp_glo, index_g)
2565
2566	DO ipts=1,npts
2567	DO ivm=1,nvm
2568	IF(lpft_replant(ipts,ivm))THEN
2569	r_replant(ipts,ivm)=un
2570	ELSE
2571	r_replant(ipts,ivm)=zero
2572	ENDIF
2573	END DO
2574	END DO
2575	var_name = 'lpft_replant'
2576	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2577	& r_replant, 'scatter', nbp_glo, index_g)
2578	!-
2579	! 19. Spinup
2580	!-
2581	IF (spinup_analytic) THEN
2582
2583	IF (is_root_prc) THEN
2584	temp_global_years(1) = REAL(global_years)
2585	var_name='Global_years'
2586	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, temp_global_years)
2587	ENDIF
2588
2589	var_name = 'nbp_sum'
2590	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2591	& nbp_accu, 'scatter', nbp_glo, index_g)
2592
2593	var_name = 'nbp_flux'
2594	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2595	& nbp_flux, 'scatter', nbp_glo, index_g)
2596
2597	var_name = 'ok_equilibrium'
2598	WHERE(ok_equilibrium(:))
2599	ok_equilibrium_real = un
2600	ELSEWHERE
2601	ok_equilibrium_real = zero
2602	ENDWHERE
2603	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
2604	& ok_equilibrium_real, 'scatter', nbp_glo, index_g)
2605
2606	DO k = 1,nbpools
2607	DO j = 1,nbpools
2608	WRITE(part_str,'(I2)') k
2609	IF (k < 10) part_str(1:1) = '0'
2610	var_name = 'MatrixV_'//part_str(1:LEN_TRIM(part_str))//'_'//TRIM(pools_str(j))
2611	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2612	& MatrixV(:,:,k,j), 'scatter', nbp_glo, index_g)
2613	ENDDO
2614	ENDDO
2615
2616	DO k = 1,nbpools
2617	WRITE(part_str,'(I2)') k
2618	IF (k < 10) part_str(1:1) = '0'
2619	var_name = 'Vector_U_'//part_str(1:LEN_TRIM(part_str))
2620	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2621	& VectorU(:,:,k), 'scatter', nbp_glo, index_g)
2622	ENDDO
2623
2624	DO k = 1,nbpools
2625	WRITE(part_str,'(I2)') k
2626	IF (k < 10) part_str(1:1) = '0'
2627	var_name = 'previous_stock_'//part_str(1:LEN_TRIM(part_str))
2628	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2629	& previous_stock(:,:,k), 'scatter', nbp_glo, index_g)
2630	ENDDO
2631
2632	DO k = 1,nbpools
2633	WRITE(part_str,'(I2)') k
2634	IF (k < 10) part_str(1:1) = '0'
2635	var_name = 'current_stock_'//part_str(1:LEN_TRIM(part_str))
2636	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2637	& current_stock(:,:,k), 'scatter', nbp_glo, index_g)
2638	ENDDO
2639
2640	ENDIF !(spinup_analytic)
2641
2642	!-
2643	! 20. Forest management
2644	!-
2645	IF ( control%forest_management .OR. control%ok_functional_allocation) THEN
2646
2647	!!$ var_name = 'lai_max_calc'
2648	!!$ CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2649	!!$ & lai_max_calc, 'scatter', nbp_glo, index_g)
2650	!!$
2651	!!$ DO k = 1,nparts
2652	!!$ WRITE(part_str,'(I2)') k
2653	!!$ IF (k < 10) part_str(1:1) = '0'
2654	!!$ var_name = 'bm_lyear_'//part_str(1:LEN_TRIM(part_str))
2655	!!$ CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2656	!!$ & biomass_lastyear(:,:,k,icarbon), 'scatter', nbp_glo, index_g)
2657	!!$ ENDDO
2658	!!$
2659	!!$ var_name = 'lai_max_lyear'
2660	!!$ CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2661	!!$ & lai_max_lastyear, 'scatter', nbp_glo, index_g)
2662
2663	var_name = 'mai'
2664	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2665	& mai, 'scatter', nbp_glo, index_g)
2666
2667	var_name = 'pai'
2668	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2669	& pai, 'scatter', nbp_glo, index_g)
2670
2671	var_name = 'coppice_dens'
2672	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2673	& coppice_dens, 'scatter', nbp_glo, index_g)
2674
2675	var_name = 'previous_wood_volume'
2676	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2677	& previous_wood_volume, 'scatter', nbp_glo, index_g)
2678
2679	var_name = 'age_stand'
2680	temp_real = REAL(age_stand,r_std)
2681	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2682	& temp_real, 'scatter', nbp_glo, index_g)
2683
2684	var_name = 'rotation_n'
2685	temp_real = REAL(rotation_n,r_std)
2686	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2687	& temp_real, 'scatter', nbp_glo, index_g)
2688
2689	var_name = 'last_cut'
2690	temp_real = REAL(last_cut,r_std)
2691	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2692	& temp_real, 'scatter', nbp_glo, index_g)
2693
2694	var_name = 'fm_lyear'
2695	temp_real = REAL(forest_managed_lastyear,r_std)
2696	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2697	& temp_real, 'scatter', nbp_glo, index_g)
2698
2699	var_name = 'fm_current'
2700	temp_real = REAL(forest_managed,r_std)
2701	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2702	& temp_real, 'scatter', nbp_glo, index_g)
2703
2704	var_name = 'mai_count'
2705	temp_real = REAL(mai_count,r_std)
2706	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
2707	& temp_real, 'scatter', nbp_glo, index_g)
2708
2709	END IF ! control%forest_management
2710
2711	IF (bavard >= 4) WRITE(numout,*) 'Leaving writerestart'
2712
2713	END SUBROUTINE writerestart
2714
2715	!! ================================================================================================================================
2716	!! SUBROUTINE : readbc
2717	!!
2718	!>\BRIEF
2719	!!
2720	!! DESCRIPTION : None
2721	!!
2722	!! RECENT CHANGE(S): None
2723	!!
2724	!! MAIN OUTPUT VARIABLE(S):
2725	!!
2726	!! REFERENCE(S) : None
2727	!!
2728	!! FLOWCHART : None
2729	!! \n
2730	!_ ================================================================================================================================
2731
2732	SUBROUTINE readbc (npts, lalo, neighbours, resolution, contfrac, tref)
2733
2734	IMPLICIT NONE
2735
2736	!! 0. Parameters and variables declaration
2737
2738	!! 0.1 Input variables
2739
2740	INTEGER(i_std), INTENT(in) :: npts !! Domain size
2741	REAL(r_std), DIMENSION(npts,2), INTENT(in) :: lalo !! Geogr. coordinates (latitude,longitude) (degrees)
2742	REAL(r_std), DIMENSION(npts,2), INTENT(in) :: resolution !! size in x an y of the grid (m)
2743	INTEGER(i_std),DIMENSION (npts,8), INTENT(in):: neighbours !! Neighbouring land grid cell
2744	REAL(r_std),DIMENSION (npts), INTENT(in) :: contfrac !! Fraction of land in each grid box
2745
2746
2747	!! 0.3 Modified variables
2748
2749	REAL(r_std), DIMENSION(npts), INTENT(inout) :: tref !! "long term" reference 2 meter temperatures (K)
2750
2751	!_ ================================================================================================================================
2752
2753	!! If the vegetation is static, then the long-term reference
2754	!! temperature is a boundary condition.
2755
2756	IF ( .NOT. control%ok_dgvm ) THEN
2757	CALL get_reftemp (npts, lalo, neighbours, resolution, contfrac, tref )
2758	ENDIF
2759
2760	END SUBROUTINE readbc
2761	!-
2762	!===
2763	!-
2764	SUBROUTINE get_reftemp_clear
2765	!---------------------------------------------------------------------
2766	firstcall=.TRUE.
2767	IF (ALLOCATED (trefe)) DEALLOCATE( trefe )
2768	!-------------------------------
2769	END SUBROUTINE get_reftemp_clear
2770	!-
2771	!===
2772	!-
2773	SUBROUTINE get_reftemp (npts, lalo, neighbours, resolution, contfrac, tref_out)
2774	!---------------------------------------------------------------------
2775	!- read the long-term reference temperature from a boundary condition
2776	!- file. If the vegetation is dynamic, this field is used to
2777	!- initialize correctly the (prognostic) long-term reference
2778	!- temperature (in the case it is not found in the restart file).
2779	!- If the vegetation is static, the field read here is a real boundary
2780	!- condition that is not modified by the model.
2781	!---------------------------------------------------------------------
2782	!-
2783	! 0 declarations
2784	!-
2785	! 0.1 input
2786	!-
2787	! Domain size
2788	INTEGER(i_std),INTENT(in) :: npts !! Geogr. coordinates (latitude,longitude) (degrees)
2789	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: lalo !! size in x an y of the grid (m)
2790	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: resolution !! Vector of latitude and longitudes (degrees)
2791	INTEGER(i_std), DIMENSION (npts,8), INTENT(in) :: neighbours !! Vector of neighbours for each grid point
2792	REAL(r_std), DIMENSION (npts), INTENT(in) :: contfrac !! Fraction of land in each grid cell (unitless)
2793
2794	!-
2795	! 0.2 output
2796	!-
2797	! reference temperature (K)
2798	REAL(r_std), DIMENSION(npts),INTENT(out) :: tref_out !! interpolated reference temperature
2799	!-
2800	! 0.3 local
2801	!-
2802	INTEGER(i_std) :: nbvmax !! nbvmax for interpolation (unitless). It is the
2803	CHARACTER(LEN=80) :: filename !! filename of temperature file
2804	INTEGER(i_std) :: iml, jml, lml, &
2805	& tml, fid, ib, ip, jp, fopt, ilf, lastjp, nbexp,ic !! Indices
2806	REAL(r_std) :: lev(1), date, dt !! Help variables to read in file data
2807	INTEGER(i_std) :: itau(1) !! Help variables to read in file data
2808	REAL(r_std) :: sgn !! Help variable to normalise temp.
2809	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel !! Help variable to read file data and allocate memory
2810	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon_rel !! Help variable to read file data and allocate memory
2811	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tref_file !! Help variable to read file data and allocate memory
2812	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area !! Help variable to read file data and allocate memory
2813	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index !! Help variable to read file data and allocate memory
2814	INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask !! Help variable to read file data and allocate memory
2815	CHARACTER(LEN=30) :: callsign !! Help variable to read file data and allocate memory
2816	LOGICAL :: ok_interpol = .FALSE. !! Optional return of aggregate_2d
2817	INTEGER :: ALLOC_ERR !! Help varialbe to count allocation error
2818	!_ ================================================================================================================================
2819	!-
2820	! If this is the first call, calculate the reference temperature
2821	! and keep it in memory
2822	!-
2823	IF (firstcall) THEN
2824	!---
2825	!-- 1.1 only do this once
2826	!---
2827	firstcall = .FALSE.
2828	!---
2829	!-- 1.2 allocate the field
2830	!-
2831	! Allocate memory for temperature
2832	ALLOC_ERR=-1
2833	ALLOCATE(trefe(npts), STAT=ALLOC_ERR)
2834	IF (ALLOC_ERR/=0) THEN
2835	WRITE(numout,*) "ERROR IN ALLOCATION of trefe : ",ALLOC_ERR
2836	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2837	ENDIF
2838	!-
2839	trefe(:) = zero
2840
2841	!-
2842	tref_out(:) = zero
2843
2844
2845	! -
2846	!---
2847	!-- 1.3 read and interpolate the temperature file
2848	!---
2849	!-- Needs to be a configurable variable
2850	!---
2851	!Config Key = REFTEMP_FILE
2852	!Config Desc = Name of file from which the reference temperature is read
2853	!Config If = OK_STOMATE
2854	!Config Def = reftemp.nc
2855	!Config Help = The name of the file to be opened to read
2856	!Config the reference surface temperature.
2857	!Config The data from this file is then interpolated
2858	!Config to the grid of of the model.
2859	!Config The aim is to get a reference temperature either
2860	!Config to initialize the corresponding prognostic model
2861	!Config variable correctly (ok_dgvm=TRUE) or to impose it
2862	!Config as boundary condition (ok_dgvm=FALSE)
2863	!Config Units = [FILE]
2864	!---
2865	filename = 'reftemp.nc'
2866	CALL getin_p('REFTEMP_FILE',filename)
2867	!---
2868	IF (is_root_prc) CALL flininfo(filename,iml, jml, lml, tml, fid)
2869	CALL bcast(iml)
2870	CALL bcast(jml)
2871	CALL bcast(lml)
2872	CALL bcast(tml)
2873	!---
2874	! Allocate memory for latitudes
2875	ALLOC_ERR=-1
2876	ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
2877	IF (ALLOC_ERR/=0) THEN
2878	WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
2879	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2880	ENDIF
2881	!-
2882	lat_rel(:,:) = zero
2883	!-
2884	! Allocate memory for longitude
2885	ALLOC_ERR=-1
2886	ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
2887	IF (ALLOC_ERR/=0) THEN
2888	WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
2889	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2890	ENDIF
2891	!-
2892	lon_rel(:,:) = zero
2893	!-
2894	! Allocate memory for mask
2895	ALLOC_ERR=-1
2896	ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
2897	IF (ALLOC_ERR/=0) THEN
2898	WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
2899	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2900	ENDIF
2901	!-
2902	mask(:,:) = zero
2903	!-
2904	! Allocate memory for temperature data
2905	ALLOC_ERR=-1
2906	ALLOCATE(tref_file(iml,jml), STAT=ALLOC_ERR)
2907	IF (ALLOC_ERR/=0) THEN
2908	WRITE(numout,*) "ERROR IN ALLOCATION of tref_file : ",ALLOC_ERR
2909	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2910	ENDIF
2911	!-
2912	tref_file(:,:) = zero
2913	!-
2914	IF (is_root_prc) CALL flinopen (filename, .FALSE., iml, jml, lml, &
2915	& lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
2916	CALL bcast(lon_rel)
2917	CALL bcast(lat_rel)
2918	CALL bcast(lev)
2919	CALL bcast(itau)
2920	CALL bcast(date)
2921	CALL bcast(dt)
2922	!-
2923	IF (is_root_prc) CALL flinget (fid, 'temperature', iml, jml, lml, tml, &
2924	& 1, 1, tref_file)
2925	CALL bcast(tref_file)
2926	!-
2927	IF (is_root_prc) CALL flinclo (fid)
2928	!-
2929	! Create mask with values of temperature
2930	mask(:,:) = zero
2931	DO ip=1,iml
2932	DO jp=1,jml
2933	IF (tref_file(ip,jp) > min_sechiba) THEN
2934	mask(ip,jp) = un
2935	ENDIF
2936	ENDDO
2937	ENDDO
2938	!---
2939	! Set nbvmax to 200 for interpolation
2940	! This number is the dimension of the variables in which we store
2941	! the list of points of the source grid which fit into one grid box of the target.
2942	nbvmax = 200
2943	!---
2944	callsign = 'Reference temperature'
2945	!---
2946	! Start with interpolation
2947	DO WHILE ( .NOT. ok_interpol )
2948	WRITE(numout,*) "Projection arrays for ",callsign," : "
2949	WRITE(numout,*) "nbvmax = ",nbvmax
2950	!---
2951	ALLOC_ERR=-1
2952	ALLOCATE(sub_area(npts,nbvmax), STAT=ALLOC_ERR)
2953	IF (ALLOC_ERR/=0) THEN
2954	WRITE(numout,*) "ERROR IN ALLOCATION of sub_area : ",ALLOC_ERR
2955	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2956	ENDIF
2957	sub_area(:,:)=zero
2958	ALLOC_ERR=-1
2959	ALLOCATE(sub_index(npts,nbvmax,2), STAT=ALLOC_ERR)
2960	IF (ALLOC_ERR/=0) THEN
2961	WRITE(numout,*) "ERROR IN ALLOCATION of sub_index : ",ALLOC_ERR
2962	CALL ipslerr_p (3,'stomate_io', 'get_reftemp','','')
2963	ENDIF
2964	sub_index(:,:,:)=0
2965	!-
2966	WRITE(numout,*) "Start interpolation in STOMATE_IO: get_reftemp"
2967	!-
2968	CALL aggregate_p(npts, lalo, neighbours, resolution, contfrac, &
2969	& iml, jml, lon_rel, lat_rel, mask, callsign, &
2970	& nbvmax, sub_index, sub_area, ok_interpol)
2971	!-
2972	IF ( .NOT. ok_interpol ) THEN
2973	DEALLOCATE(sub_area)
2974	DEALLOCATE(sub_index)
2975	ENDIF
2976	!-
2977	nbvmax = nbvmax * 2
2978	ENDDO
2979	!-
2980	! Check how many points are found
2981	!-
2982	nbexp = zero
2983	trefe(:) = zero
2984	!-
2985	DO ib=1,npts ! Loop over domain size
2986	!-
2987	fopt = COUNT(sub_area(ib,:) > zero)
2988	!-
2989	!! Compute the temperature parameters
2990	!-
2991	IF ( fopt .GT. 0) THEN ! If no points were interpolated
2992	!-
2993	sgn = zero
2994	!-
2995	DO ilf = 1,fopt ! If points were interpolated
2996	!-
2997	ip = sub_index(ib,ilf,1)
2998	jp = sub_index(ib,ilf,2)
2999	!-
3000	! Weighted values by interpolation area
3001	trefe(ib) = trefe(ib) + tref_file(ip,jp) * sub_area(ib,ilf)
3002	sgn = sgn + sub_area(ib,ilf)
3003	!-
3004	ENDDO
3005	!-
3006	! Normalize the surface
3007	IF ( sgn .LT. min_sechiba) THEN
3008	nbexp = nbexp + 1
3009	ELSE
3010	trefe(ib) = trefe(ib)/sgn
3011	ENDIF
3012	!-
3013	ELSE
3014	!-
3015	nbexp = nbexp + 1
3016	!-
3017	!
3018	!jot ++++++++++++++TEMP
3019	! Here we set all pixels that didn't have enough surrounding pixels
3020	! for the interpolation to the mean average 2m temperature. This
3021	! is not ideal.
3022	! The ideal case: here the pixels get the value 'undef' and in
3023	! a next step these pixels get the value from a surrounding pixel
3024	! that has an interpolated value.
3025	! We tried this, see the following loop. We used the 'neighbours'
3026	! variable calculated in grid.f90 to check if one of the eight
3027	! surrounding pixels has a temperature value.
3028	! However, this doesn't work. The dimensions of refe(neighbours(ib,ic)
3029	! aren't correct. Maybe something goes wrong with the
3030	! parallelisation? Needs to be checked.
3031	!jot ++++++++++++++TEMP
3032	!
3033	trefe(ib) = mstemp
3034	!jot trefe(ib) = undef
3035	!-
3036	ENDIF
3037	!-
3038	ENDDO
3039	!-
3040	!
3041	IF ( nbexp .GT. 0 ) THEN
3042	WRITE(numout,*) 'STOMATE_IO, get_reftemp : The interpolation of the temperature had ', nbexp
3043	WRITE(numout,*) 'STOMATE_IO, get_reftemp : points without data out of total', SIZE(trefe)
3044	WRITE(numout,*) 'STOMATE_IO, get_reftemp : interpolation points.'
3045	WRITE(numout,*) 'STOMATE_IO, get_reftemp : We will start now with replacing the pixel'
3046	WRITE(numout,*) 'STOMATE_IO, get_reftemp : by the value of the nearest neighbour'
3047	ENDIF
3048	!-
3049	! look for values that have the value undef to replace them by the value
3050	! of the nearest neighbour
3051	! -
3052	DO ib=1,npts ! Loop over domain size
3053	!-
3054	! check if this point is one without a temperature value
3055	!-
3056	IF (trefe(ib) .EQ. undef) THEN
3057	!-
3058	! in the module grid.f90 the variable neighbours is calculated
3059	! it tests the 8 neighbour pixels, a value of -1 means that this
3060	! is not a land point or outside of the domain, here we loop over
3061	! these eight pixels to see if we find a pixel with a temperature
3062	! value
3063	!-
3064	DO ic=1,8 ! number of neighbour pixels
3065	!-
3066	! check if there is a neighbour land pixel
3067	!-
3068	IF (neighbours(ib,ic) .GT. 0 ) THEN
3069	!-
3070	! now we have neighbouring land pixel but
3071	! check if his pixel contains a temperature
3072	! value and that this not an 'artifial' value
3073	!-
3074	IF (trefe(neighbours(ib,ic)) .NE. undef .AND. &
3075	trefe(neighbours(ib,ic)) .NE. mstemp ) THEN
3076	!-
3077	! set the temperature value
3078	!-
3079	trefe(ib) = trefe(neighbours(ib,ic))
3080	!-
3081	! cool - we replaced the pixel having no
3082	! temperature value with the temperature value
3083	! of a neighbouring land pixel, continue checking
3084	! the following pixels
3085	!-
3086	EXIT
3087	!-
3088	ENDIF
3089	!-
3090	! when we tested the last neighbouring pixel and
3091	! still haven't found a pixel with a temperatue value
3092	! then replace it with the global annual mean surface
3093	! temperature value
3094	!-
3095	ELSEIF (ic .EQ. 8) THEN ! if all neighbours are checked
3096	!-
3097	trefe(ib) = mstemp
3098	!-
3099	ENDIF
3100	!-
3101	!
3102	ENDDO ! neighbouring pixels
3103	!-
3104	ENDIF
3105	!-
3106	!
3107	ENDDO !domain size
3108	!-
3109	! transform into Kelvin
3110	!-
3111	trefe(:) = trefe(:) + ZeroCelsius
3112	!-
3113	! deallocate
3114	!-
3115	DEALLOCATE (lat_rel)
3116	DEALLOCATE (lon_rel)
3117	!
3118	ENDIF
3119	!-
3120	! output the reference temperaturei
3121	!-
3122	tref_out(:) = trefe(:)
3123	!-
3124	WRITE(numout,*) 'STOMATE_IO, get_reftemp : Done'
3125	!-
3126	!
3127	END SUBROUTINE get_reftemp
3128	!
3129	!-
3130	END MODULE stomate_io

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

Download in other formats: