Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_io.f90 @ 894

Last change on this file since 894 was 846, checked in by didier.solyga, 12 years ago
Formatted labels so a script can automatically generate the orchidee.default file.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 85.0 KB

Line
1	!< $HeadURL$
2	!< $Date$
3	!< $Author$
4	!< $Revision$
5	! IPSL (2006)
6	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
7	!
8	MODULE stomate_io
9	!---------------------------------------------------------------------
10	!- Not all variables saved in the start files are absolutely necessary.
11	!- However, Sechiba's and Stomate's PFTs are not necessarily identical,
12	!- and for that case this information needs to be saved.
13	!---------------------------------------------------------------------
14	USE ioipsl
15	USE stomate_data
16	USE constantes
17	USE parallel
18	!-
19	IMPLICIT NONE
20	!-
21	PRIVATE
22	PUBLIC readstart, writerestart, readbc,get_reftemp_clear
23	!-
24	! first call?
25	!-
26	LOGICAL,SAVE :: firstcall = .TRUE.
27	!-
28	! reference temperature (K)
29	!-
30	REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
31	!-
32	CONTAINS
33	!-
34	!===
35	!-
36	SUBROUTINE readstart &
37	& (npts, index, lalo, resolution, day_counter, dt_days, date, &
38	& ind, adapted, regenerate, moiavail_daily, litterhum_daily, &
39	& t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
40	& soilhum_daily, precip_daily, &
41	& gpp_daily, npp_daily, turnover_daily, &
42	& moiavail_month, moiavail_week, t2m_longterm, tlong_ref, &
43	& t2m_month, t2m_week, tsoil_month, soilhum_month, &
44	& fireindex, firelitter, &
45	& maxmoiavail_lastyear, maxmoiavail_thisyear, &
46	& minmoiavail_lastyear, minmoiavail_thisyear, &
47	& maxgppweek_lastyear, maxgppweek_thisyear, &
48	& gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
49	& gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
50	& PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
51	& maxfpc_lastyear, maxfpc_thisyear, &
52	& turnover_longterm, gpp_week, biomass, resp_maint_part, &
53	& leaf_age, leaf_frac, senescence, when_growthinit, age, &
54	& resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
55	& veget_lastlight, everywhere, need_adjacent, RIP_time, &
56	& time_lowgpp, time_hum_min, hum_min_dormance, &
57	& litterpart, litter, dead_leaves, &
58	& carbon, black_carbon, lignin_struc,turnover_time, &
59	& prod10,prod100,flux10, flux100, &
60	& convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total)
61	!---------------------------------------------------------------------
62	!- read start file
63	!---------------------------------------------------------------------
64	!-
65	! 0 declarations
66	!-
67	! 0.1 input
68	!-
69	! Domain size
70	INTEGER(i_std),INTENT(in) :: npts
71	! Indices of the points on the map
72	INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
73	! Geogr. coordinates (latitude,longitude) (degrees)
74	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo
75	! size in x an y of the grid (m)
76	REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution
77	!-
78	! 0.2 output
79	!-
80	! counts time until next STOMATE time step
81	REAL(r_std),INTENT(out) :: day_counter
82	! time step of STOMATE in days
83	REAL(r_std),INTENT(out) :: dt_days
84	! date (d)
85	INTEGER(i_std),INTENT(out) :: date
86	! density of individuals (1/m**2)
87	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ind
88	! Winter too cold? between 0 and 1
89	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: adapted
90	! Winter sufficiently cold? between 0 and 1
91	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: regenerate
92	! daily moisture availability
93	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_daily
94	! daily litter humidity
95	REAL(r_std),DIMENSION(npts),INTENT(out) :: litterhum_daily
96	! daily 2 meter temperatures (K)
97	REAL(r_std),DIMENSION(npts),INTENT(out) :: t2m_daily
98	! daily minimum 2 meter temperatures (K)
99	REAL(r_std),DIMENSION(npts),INTENT(out) :: t2m_min_daily
100	! daily surface temperatures (K)
101	REAL(r_std),DIMENSION(npts),INTENT(out) :: tsurf_daily
102	! daily soil temperatures (K)
103	REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_daily
104	! daily soil humidity
105	REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_daily
106	! daily precipitations (mm/day) (for phenology)
107	REAL(r_std),DIMENSION(npts),INTENT(out) :: precip_daily
108	! daily gross primary productivity (gC/m**2/day)
109	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_daily
110	! daily net primary productivity (gC/m**2/day)
111	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_daily
112	! daily turnover rates (gC/m**2/day)
113	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: turnover_daily
114	! "monthly" moisture availability
115	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_month
116	! "weekly" moisture availability
117	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: moiavail_week
118	! "long term" 2 meter temperatures (K)
119	REAL(r_std),DIMENSION(npts),INTENT(out) :: t2m_longterm
120	! "monthly" 2 meter temperatures (K)
121	REAL(r_std),DIMENSION(npts),INTENT(out) :: t2m_month
122	! "weekly" 2 meter temperatures (K)
123	REAL(r_std),DIMENSION(npts),INTENT(out) :: t2m_week
124	! "monthly" soil temperatures (K)
125	REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: tsoil_month
126	! "monthly" soil humidity
127	REAL(r_std),DIMENSION(npts,nbdl),INTENT(out) :: soilhum_month
128	! Probability of fire
129	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: fireindex
130	! Longer term total litter above the ground, gC/m**2 of ground
131	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: firelitter
132	! last year's maximum moisture availability
133	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_lastyear
134	! this year's maximum moisture availability
135	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxmoiavail_thisyear
136	! last year's minimum moisture availability
137	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_lastyear
138	! this year's minimum moisture availability
139	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: minmoiavail_thisyear
140	! last year's maximum weekly GPP
141	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_lastyear
142	! this year's maximum weekly GPP
143	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxgppweek_thisyear
144	! last year's annual GDD0
145	REAL(r_std),DIMENSION(npts),INTENT(out) :: gdd0_lastyear
146	! this year's annual GDD0
147	REAL(r_std),DIMENSION(npts),INTENT(out) :: gdd0_thisyear
148	! last year's annual precipitation (mm/year)
149	REAL(r_std),DIMENSION(npts),INTENT(out) :: precip_lastyear
150	! this year's annual precipitation (mm/year)
151	REAL(r_std),DIMENSION(npts),INTENT(out) :: precip_thisyear
152	! growing degree days, threshold -5 deg C (for phenology)
153	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_m5_dormance
154	! growing degree days since midwinter (for phenology)
155	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gdd_midwinter
156	! number of chilling days since leaves were lost (for phenology)
157	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ncd_dormance
158	! number of growing days, threshold -5 deg C (for phenology)
159	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: ngd_minus5
160	! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
161	LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: PFTpresent
162	! "long term" net primary productivity (gC/m**2/year)
163	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: npp_longterm
164	! last year's maximum leaf mass, for each PFT (gC/m**2)
165	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_lastyearmax
166	! this year's maximum leaf mass, for each PFT (gC/m**2)
167	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: lm_thisyearmax
168	! last year's maximum fpc for each natural PFT, on ground
169	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_lastyear
170	! this year's maximum fpc for each PFT,
171	! on total ground (see stomate_season)
172	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: maxfpc_thisyear
173	! "long term" turnover rate (gC/m**2/year)
174	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: turnover_longterm
175	! "weekly" GPP (gC/day/(m**2 covered)
176	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: gpp_week
177	! biomass (gC/m**2)
178	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: biomass
179	! maintenance resp (gC/m**2)
180	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: resp_maint_part
181	! leaf age (days)
182	REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_age
183	! fraction of leaves in leaf age class
184	REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(out) :: leaf_frac
185	! is the plant senescent ?
186	!(only for deciduous trees - carbohydrate reserve)
187	LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: senescence
188	! how many days ago was the beginning of the growing season
189	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: when_growthinit
190	! mean age (years)
191	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: age
192	! heterotrophic respiration (gC/day/m**2)
193	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_hetero
194	! maintenance respiration (gC/day/m**2)
195	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_maint
196	! growth respiration (gC/day/m**2)
197	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: resp_growth
198	! carbon emitted into the atmosphere by fire (living and dead biomass)
199	! (in gC/m**2/time step)
200	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_fire
201	! biomass uptaken (gC/(m**2 of total ground)/day)
202	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: co2_to_bm_dgvm
203	! vegetation fractions (on ground) after last light competition
204	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: veget_lastlight
205	! is the PFT everywhere in the grid box or very localized
206	! (after its introduction)
207	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: everywhere
208	! in order for this PFT to be introduced,
209	! does it have to be present in an adjacent grid box?
210	LOGICAL,DIMENSION(npts,nvm),INTENT(out) :: need_adjacent
211	! How much time ago was the PFT eliminated for the last time (y)
212	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: RIP_time
213	! duration of dormance (d)
214	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_lowgpp
215	! time elapsed since strongest moisture availability (d)
216	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: time_hum_min
217	! minimum moisture during dormance
218	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: hum_min_dormance
219	! fraction of litter above the ground belonging to different PFTs
220	! separated for natural and agricultural PFTs.
221	REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: litterpart
222	! metabolic and structural litter, natural and agricultural,
223	! above and below ground (gC/m**2)
224	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs),INTENT(out):: litter
225	! dead leaves on ground, per PFT, metabolic and structural,
226	! in gC/(m**2 of ground)
227	REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(out) :: dead_leaves
228	! carbon pool: active, slow, or passive, (gC/m**2)
229	REAL(r_std),DIMENSION(npts,ncarb,nvm),INTENT(out) :: carbon
230	! black carbon on the ground (gC/(m**2 of total ground))
231	REAL(r_std),DIMENSION(npts),INTENT(out) :: black_carbon
232	! ratio Lignine/Carbon in structural litter, above and below ground,(gC/m**2)
233	REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(out) :: lignin_struc
234	REAL(r_std),DIMENSION(npts,nvm),INTENT(out) :: turnover_time
235	!-
236	! 0.3 not necessarily output
237	!-
238	! "long term" reference 2 meter temperatures (K)
239	REAL(r_std),DIMENSION(npts),INTENT(inout) :: tlong_ref
240	!-
241	! 0.4 local
242	!-
243	! date, real
244	REAL(r_std) :: date_real
245	! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
246	REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
247	! is the plant senescent ?
248	! (only for deciduous trees - carbohydrate reserve), real
249	REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
250	! in order for this PFT to be introduced,
251	! does it have to be present in an adjacent grid box? - real
252	REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
253	! To store variables names for I/O
254	CHARACTER(LEN=80) :: var_name
255	! string suffix indicating an index
256	CHARACTER(LEN=10) :: part_str
257	! string suffix indicating litter type
258	CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
259	! string suffix indicating level
260	CHARACTER(LEN=2),DIMENSION(nlevs) :: level_str
261	! temporary storage
262	REAL(r_std),DIMENSION(1) :: xtmp
263	! index
264	INTEGER(i_std) :: j,k,l,m
265	! reference temperature (K)
266	REAL(r_std),DIMENSION(npts) :: tref
267
268	! land cover change variables
269	! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
270	! (10 or 100 + 1 : input from year of land cover change)
271	REAL(r_std),DIMENSION(npts,0:10),INTENT(out) :: prod10
272	REAL(r_std),DIMENSION(npts,0:100),INTENT(out) :: prod100
273	! annual release from the 10/100 year-turnover pool compartments
274	REAL(r_std),DIMENSION(npts,10),INTENT(out) :: flux10
275	REAL(r_std),DIMENSION(npts,100),INTENT(out) :: flux100
276	REAL(r_std), DIMENSION(npts), INTENT(out) :: convflux
277	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod10
278	REAL(r_std), DIMENSION(npts), INTENT(out) :: cflux_prod100
279	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(out) :: bm_to_litter
280	REAL(r_std),DIMENSION(npts),INTENT(out) :: carb_mass_total
281	!---------------------------------------------------------------------
282	IF (bavard >= 3) WRITE(numout,*) 'Entering readstart'
283	!-
284	! 0 When the vegetation is dynamic,
285	! the long-term reference temperature is prognostic.
286	! In this case, it is read from the restart file.
287	! If the corresponding field does not exist in the restart file,
288	! read it from another file in order to initialize it correctly.
289	!-
290	CALL get_reftemp( npts, lalo, resolution, tref )
291	!-
292	! 1 string definitions
293	!-
294	DO l=1,nlitt
295	IF (l == imetabolic) THEN
296	litter_str(l) = 'met'
297	ELSEIF (l == istructural) THEN
298	litter_str(l) = 'str'
299	ELSE
300	STOP 'Define litter_str'
301	ENDIF
302	ENDDO
303	!-
304	DO l=1,nlevs
305	IF (l == iabove) THEN
306	level_str(l) = 'ab'
307	ELSEIF (l == ibelow) THEN
308	level_str(l) = 'be'
309	ELSE
310	STOP 'Define level_str'
311	ENDIF
312	ENDDO
313	!-
314	! 2 run control
315	!-
316	! 2.1 day counter
317	!-
318	IF (is_root_prc) THEN
319	var_name = 'day_counter'
320	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
321	& .TRUE., xtmp)
322	day_counter = xtmp(1)
323	IF (day_counter == val_exp) day_counter = un
324	ENDIF
325	CALL bcast(day_counter)
326	!-
327	! 2.2 time step of STOMATE in days
328	!-
329	IF (is_root_prc) THEN
330	var_name = 'dt_days'
331	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
332	& .TRUE., xtmp)
333	dt_days = xtmp(1)
334	IF (dt_days == val_exp) dt_days = un
335	ENDIF
336	CALL bcast(dt_days)
337	!-
338	! 2.3 date
339	!-
340	IF (is_root_prc) THEN
341	var_name = 'date'
342	CALL restget (rest_id_stomate, var_name, 1 , 1 , 1, itime, &
343	& .TRUE., xtmp)
344	date_real = xtmp(1)
345	IF (date_real == val_exp) date_real = zero
346	date = NINT(date_real)
347	ENDIF
348	CALL bcast(date)
349	!-
350	! 3 daily meteorological variables
351	!-
352	moiavail_daily(:,:) = val_exp
353	var_name = 'moiavail_daily'
354	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
355	& .TRUE., moiavail_daily, 'gather', nbp_glo, index_g)
356	IF (ALL(moiavail_daily(:,:) == val_exp)) moiavail_daily(:,:) = zero
357	!-
358	litterhum_daily(:) = val_exp
359	var_name = 'litterhum_daily'
360	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
361	& .TRUE., litterhum_daily, 'gather', nbp_glo, index_g)
362	IF (ALL(litterhum_daily(:) == val_exp)) litterhum_daily(:) = zero
363	!-
364	t2m_daily(:) = val_exp
365	var_name = 't2m_daily'
366	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
367	& .TRUE., t2m_daily, 'gather', nbp_glo, index_g)
368	IF (ALL(t2m_daily(:) == val_exp)) t2m_daily(:) = zero
369	!-
370	t2m_min_daily(:) = val_exp
371	var_name = 't2m_min_daily'
372	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
373	& .TRUE., t2m_min_daily, 'gather', nbp_glo, index_g)
374	IF (ALL(t2m_min_daily(:) == val_exp)) t2m_min_daily(:) = large_value
375	!-
376	tsurf_daily(:) = val_exp
377	var_name = 'tsurf_daily'
378	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
379	& .TRUE., tsurf_daily, 'gather', nbp_glo, index_g)
380	IF (ALL(tsurf_daily(:) == val_exp)) tsurf_daily(:) = tref(:)
381	!-
382	tsoil_daily(:,:) = val_exp
383	var_name = 'tsoil_daily'
384	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
385	& .TRUE., tsoil_daily, 'gather', nbp_glo, index_g)
386	IF (ALL(tsoil_daily(:,:) == val_exp)) tsoil_daily(:,:) = zero
387	!-
388	soilhum_daily(:,:) = val_exp
389	var_name = 'soilhum_daily'
390	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
391	& .TRUE., soilhum_daily, 'gather', nbp_glo, index_g)
392	IF (ALL(soilhum_daily(:,:) == val_exp)) soilhum_daily(:,:) = zero
393	!-
394	precip_daily(:) = val_exp
395	var_name = 'precip_daily'
396	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
397	& .TRUE., precip_daily, 'gather', nbp_glo, index_g)
398	IF (ALL(precip_daily(:) == val_exp)) precip_daily(:) = zero
399	!-
400	! 4 productivities
401	!-
402	gpp_daily(:,:) = val_exp
403	var_name = 'gpp_daily'
404	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
405	& .TRUE., gpp_daily, 'gather', nbp_glo, index_g)
406	IF (ALL(gpp_daily(:,:) == val_exp)) gpp_daily(:,:) = zero
407	!-
408	npp_daily(:,:) = val_exp
409	var_name = 'npp_daily'
410	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
411	& .TRUE., npp_daily, 'gather', nbp_glo, index_g)
412	IF (ALL(npp_daily(:,:) == val_exp)) npp_daily(:,:) = zero
413	!-
414	turnover_daily(:,:,:) = val_exp
415	DO k=1,nparts
416	WRITE(part_str,'(I2)') k
417	IF (k < 10) part_str(1:1) = '0'
418	var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))
419	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
420	& .TRUE., turnover_daily(:,:,k), 'gather', nbp_glo, index_g)
421	IF (ALL(turnover_daily(:,:,k) == val_exp)) &
422	& turnover_daily(:,:,k) = zero
423	ENDDO
424	!-
425	! 5 monthly meteorological variables
426	!-
427	moiavail_month(:,:) = val_exp
428	var_name = 'moiavail_month'
429	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
430	& .TRUE., moiavail_month, 'gather', nbp_glo, index_g)
431	IF (ALL(moiavail_month(:,:) == val_exp)) moiavail_month(:,:) = zero
432	!-
433	moiavail_week(:,:) = val_exp
434	var_name = 'moiavail_week'
435	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
436	& .TRUE., moiavail_week, 'gather', nbp_glo, index_g)
437	IF (ALL(moiavail_week(:,:) == val_exp)) moiavail_week(:,:) = zero
438	!-
439	t2m_longterm(:) = val_exp
440	var_name = 't2m_longterm'
441	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
442	& .TRUE., t2m_longterm, 'gather', nbp_glo, index_g)
443	IF (ALL(t2m_longterm(:) == val_exp)) t2m_longterm(:) = tref(:)
444	!-
445	! the long-term reference temperature is a prognostic variable
446	! only in case the vegetation is dynamic
447	!-
448	IF (control%ok_dgvm) THEN
449	tlong_ref(:) = val_exp
450	var_name = 'tlong_ref'
451	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
452	& .TRUE., tlong_ref, 'gather', nbp_glo, index_g)
453	IF (ALL(tlong_ref(:) == val_exp)) tlong_ref(:) = tref(:)
454	ENDIF
455	!-
456	t2m_month(:) = val_exp
457	var_name = 't2m_month'
458	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
459	& .TRUE., t2m_month, 'gather', nbp_glo, index_g)
460	IF (ALL(t2m_month(:) == val_exp)) t2m_month(:) = tref(:)
461	!-
462	t2m_week(:) = val_exp
463	var_name = 't2m_week'
464	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
465	& .TRUE., t2m_week, 'gather', nbp_glo, index_g)
466	IF (ALL(t2m_week(:) == val_exp)) t2m_week(:) = tref(:)
467	!-
468	tsoil_month(:,:) = val_exp
469	var_name = 'tsoil_month'
470	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
471	& .TRUE., tsoil_month, 'gather', nbp_glo, index_g)
472
473	IF (ALL(tsoil_month(:,:) == val_exp)) THEN
474	DO l=1,nbdl
475	tsoil_month(:,l) = tref(:)
476	ENDDO
477	ENDIF
478	!-
479	soilhum_month(:,:) = val_exp
480	var_name = 'soilhum_month'
481	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
482	& .TRUE., soilhum_month, 'gather', nbp_glo, index_g)
483	IF (ALL(soilhum_month(:,:) == val_exp)) soilhum_month(:,:) = zero
484	!-
485	! 6 fire probability
486	!-
487	fireindex(:,:) = val_exp
488	var_name = 'fireindex'
489	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
490	& .TRUE., fireindex, 'gather', nbp_glo, index_g)
491	IF (ALL(fireindex(:,:) == val_exp)) fireindex(:,:) = zero
492	!-
493	firelitter(:,:) = val_exp
494	var_name = 'firelitter'
495	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
496	& .TRUE., firelitter, 'gather', nbp_glo, index_g)
497	IF (ALL(firelitter(:,:) == val_exp)) firelitter(:,:) = zero
498	!-
499	! 7 maximum and minimum moisture availabilities for tropic phenology
500	!-
501	maxmoiavail_lastyear(:,:) = val_exp
502	var_name = 'maxmoistr_last'
503	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
504	& .TRUE., maxmoiavail_lastyear, 'gather', nbp_glo, index_g)
505	IF (ALL(maxmoiavail_lastyear(:,:) == val_exp)) &
506	& maxmoiavail_lastyear(:,:) = zero
507	!-
508	maxmoiavail_thisyear(:,:) = val_exp
509	var_name = 'maxmoistr_this'
510	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
511	& .TRUE., maxmoiavail_thisyear, 'gather', nbp_glo, index_g)
512	IF (ALL(maxmoiavail_thisyear(:,:) == val_exp)) &
513	& maxmoiavail_thisyear(:,:) = zero
514	!-
515	minmoiavail_lastyear(:,:) = val_exp
516	var_name = 'minmoistr_last'
517	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
518	& .TRUE., minmoiavail_lastyear, 'gather', nbp_glo, index_g)
519	IF (ALL(minmoiavail_lastyear(:,:) == val_exp)) &
520	& minmoiavail_lastyear(:,:) = un
521	!-
522	minmoiavail_thisyear(:,:) = val_exp
523	var_name = 'minmoistr_this'
524	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
525	& .TRUE., minmoiavail_thisyear, 'gather', nbp_glo, index_g)
526	IF (ALL( minmoiavail_thisyear(:,:) == val_exp)) &
527	& minmoiavail_thisyear(:,:) = un
528	!-
529	! 8 maximum "weekly" GPP
530	!-
531	maxgppweek_lastyear(:,:) = val_exp
532	var_name = 'maxgppweek_lastyear'
533	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
534	& .TRUE., maxgppweek_lastyear, 'gather', nbp_glo, index_g)
535	IF (ALL(maxgppweek_lastyear(:,:) == val_exp)) &
536	& maxgppweek_lastyear(:,:) = zero
537	!-
538	maxgppweek_thisyear(:,:) = val_exp
539	var_name = 'maxgppweek_thisyear'
540	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
541	& .TRUE., maxgppweek_thisyear, 'gather', nbp_glo, index_g)
542	IF (ALL(maxgppweek_thisyear(:,:) == val_exp)) &
543	& maxgppweek_thisyear(:,:) = zero
544	!-
545	! 9 annual GDD0
546	!-
547	gdd0_thisyear(:) = val_exp
548	var_name = 'gdd0_thisyear'
549	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
550	& .TRUE., gdd0_thisyear, 'gather', nbp_glo, index_g)
551	IF (ALL(gdd0_thisyear(:) == val_exp)) gdd0_thisyear(:) = zero
552	!-
553	gdd0_lastyear(:) = val_exp
554	var_name = 'gdd0_lastyear'
555	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
556	& .TRUE., gdd0_lastyear, 'gather', nbp_glo, index_g)
557	IF (ALL(gdd0_lastyear(:) == val_exp)) gdd0_lastyear(:) = gdd_crit_estab
558	!-
559	! 10 annual precipitation
560	!-
561	precip_thisyear(:) = val_exp
562	var_name = 'precip_thisyear'
563	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
564	& .TRUE., precip_thisyear, 'gather', nbp_glo, index_g)
565	IF (ALL(precip_thisyear(:) == val_exp)) precip_thisyear(:) = zero
566	!-
567	precip_lastyear(:) = val_exp
568	var_name = 'precip_lastyear'
569	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
570	& .TRUE., precip_lastyear, 'gather', nbp_glo, index_g)
571	IF (ALL(precip_lastyear(:) == val_exp)) &
572	& precip_lastyear(:) = precip_crit
573	!-
574	! 11 derived "biometeorological" variables
575	!-
576	gdd_m5_dormance(:,:) = val_exp
577	var_name = 'gdd_m5_dormance'
578	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
579	& .TRUE., gdd_m5_dormance, 'gather', nbp_glo, index_g)
580	IF (ALL(gdd_m5_dormance(:,:) == val_exp)) &
581	& gdd_m5_dormance(:,:) = undef
582	!-
583	gdd_midwinter(:,:) = val_exp
584	var_name = 'gdd_midwinter'
585	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
586	& .TRUE., gdd_midwinter, 'gather', nbp_glo, index_g)
587	IF (ALL(gdd_midwinter(:,:) == val_exp)) gdd_midwinter(:,:) = undef
588	!-
589	ncd_dormance(:,:) = val_exp
590	var_name = 'ncd_dormance'
591	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
592	& .TRUE., ncd_dormance, 'gather', nbp_glo, index_g)
593	IF (ALL(ncd_dormance(:,:) == val_exp)) ncd_dormance(:,:) = undef
594	!-
595	ngd_minus5(:,:) = val_exp
596	var_name = 'ngd_minus5'
597	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
598	& .TRUE., ngd_minus5, 'gather', nbp_glo, index_g)
599	IF (ALL(ngd_minus5(:,:) == val_exp)) ngd_minus5(:,:) = zero
600	!-
601	time_lowgpp(:,:) = val_exp
602	var_name = 'time_lowgpp'
603	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
604	& .TRUE., time_lowgpp, 'gather', nbp_glo, index_g)
605	IF (ALL(time_lowgpp(:,:) == val_exp)) time_lowgpp(:,:) = zero
606	!-
607	time_hum_min(:,:) = val_exp
608	var_name = 'time_hum_min'
609	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
610	& .TRUE., time_hum_min, 'gather', nbp_glo, index_g)
611	IF (ALL(time_hum_min(:,:) == val_exp)) time_hum_min(:,:) = undef
612	!-
613	hum_min_dormance(:,:) = val_exp
614	var_name = 'hum_min_dormance'
615	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
616	& .TRUE., hum_min_dormance, 'gather', nbp_glo, index_g)
617	IF (ALL(hum_min_dormance(:,:) == val_exp)) &
618	& hum_min_dormance(:,:) = undef
619	!-
620	! 12 Plant status
621	!-
622	PFTpresent_real(:,:) = val_exp
623	var_name = 'PFTpresent'
624	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
625	& .TRUE., PFTpresent_real, 'gather', nbp_glo, index_g)
626	IF (ALL(PFTpresent_real(:,:) == val_exp)) PFTpresent_real(:,:) = zero
627	WHERE (PFTpresent_real(:,:) >= .5)
628	PFTpresent = .TRUE.
629	ELSEWHERE
630	PFTpresent = .FALSE.
631	ENDWHERE
632	!-
633	ind(:,:) = val_exp
634	var_name = 'ind'
635	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
636	& .TRUE., ind, 'gather', nbp_glo, index_g)
637	IF (ALL(ind(:,:) == val_exp)) ind(:,:) = zero
638	!-
639	adapted(:,:) = val_exp
640	var_name = 'adapted'
641	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
642	& .TRUE., adapted, 'gather', nbp_glo, index_g)
643	IF (ALL(adapted(:,:) == val_exp)) adapted(:,:) = zero
644	!-
645	regenerate(:,:) = val_exp
646	var_name = 'regenerate'
647	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
648	& .TRUE., regenerate, 'gather', nbp_glo, index_g)
649	IF (ALL(regenerate(:,:) == val_exp)) regenerate(:,:) = zero
650	!-
651	npp_longterm(:,:) = val_exp
652	var_name = 'npp_longterm'
653	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
654	& .TRUE., npp_longterm, 'gather', nbp_glo, index_g)
655	IF (ALL(npp_longterm(:,:) == val_exp)) npp_longterm(:,:) = zero
656	!-
657	lm_lastyearmax(:,:) = val_exp
658	var_name = 'lm_lastyearmax'
659	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
660	& .TRUE., lm_lastyearmax, 'gather', nbp_glo, index_g)
661	IF (ALL(lm_lastyearmax(:,:) == val_exp)) lm_lastyearmax(:,:) = zero
662	!-
663	lm_thisyearmax(:,:) = val_exp
664	var_name = 'lm_thisyearmax'
665	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
666	& .TRUE., lm_thisyearmax, 'gather', nbp_glo, index_g)
667	IF (ALL(lm_thisyearmax(:,:) == val_exp)) lm_thisyearmax(:,:) = zero
668	!-
669	maxfpc_lastyear(:,:) = val_exp
670	var_name = 'maxfpc_lastyear'
671	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
672	& .TRUE., maxfpc_lastyear, 'gather', nbp_glo, index_g)
673	IF (ALL(maxfpc_lastyear(:,:) == val_exp)) maxfpc_lastyear(:,:) = zero
674	!-
675	maxfpc_thisyear(:,:) = val_exp
676	var_name = 'maxfpc_thisyear'
677	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
678	& .TRUE., maxfpc_thisyear, 'gather', nbp_glo, index_g)
679	IF (ALL(maxfpc_thisyear(:,:) == val_exp)) maxfpc_thisyear(:,:) = zero
680	!-
681	turnover_time(:,:) = val_exp
682	var_name = 'turnover_time'
683	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
684	& .TRUE., turnover_time, 'gather', nbp_glo, index_g)
685	IF ( ALL( turnover_time(:,:) == val_exp)) turnover_time(:,:) = 100.
686	!-
687	turnover_longterm(:,:,:) = val_exp
688	DO k=1,nparts
689	WRITE(part_str,'(I2)') k
690	IF ( k < 10 ) part_str(1:1) = '0'
691	var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))
692	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
693	& .TRUE., turnover_longterm(:,:,k), 'gather', nbp_glo, index_g)
694	IF (ALL(turnover_longterm(:,:,k) == val_exp)) &
695	& turnover_longterm(:,:,k) = zero
696	ENDDO
697	!-
698	gpp_week(:,:) = val_exp
699	var_name = 'gpp_week'
700	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
701	& .TRUE., gpp_week, 'gather', nbp_glo, index_g)
702	IF (ALL(gpp_week(:,:) == val_exp)) gpp_week(:,:) = zero
703	!-
704	biomass(:,:,:) = val_exp
705	DO k=1,nparts
706	WRITE(part_str,'(I2)') k
707	IF ( k < 10 ) part_str(1:1) = '0'
708	var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))
709	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
710	& .TRUE., biomass(:,:,k), 'gather', nbp_glo, index_g)
711	IF (ALL(biomass(:,:,k) == val_exp)) biomass(:,:,k) = zero
712	ENDDO
713	!-
714	resp_maint_part(:,:,:) = val_exp
715	DO k=1,nparts
716	WRITE(part_str,'(I2)') k
717	IF ( k < 10 ) part_str(1:1) = '0'
718	var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
719	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
720	& .TRUE., resp_maint_part(:,:,k), 'gather', nbp_glo, index_g)
721	IF (ALL(resp_maint_part(:,:,k) == val_exp)) resp_maint_part(:,:,k) = zero
722	ENDDO
723	!-
724	leaf_age(:,:,:) = val_exp
725	DO m=1,nleafages
726	WRITE (part_str,'(I2)') m
727	IF ( m < 10 ) part_str(1:1) = '0'
728	var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
729	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
730	& .TRUE., leaf_age(:,:,m), 'gather', nbp_glo, index_g)
731	IF (ALL(leaf_age(:,:,m) == val_exp)) leaf_age(:,:,m) = zero
732	ENDDO
733	!-
734	leaf_frac(:,:,:) = val_exp
735	DO m=1,nleafages
736	WRITE(part_str,'(I2)') m
737	IF ( m < 10 ) part_str(1:1) = '0'
738	var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
739	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
740	& .TRUE., leaf_frac(:,:,m), 'gather', nbp_glo, index_g)
741	IF (ALL(leaf_frac(:,:,m) == val_exp)) leaf_frac(:,:,m) = zero
742	ENDDO
743	!-
744	senescence_real(:,:) = val_exp
745	var_name = 'senescence'
746	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
747	& .TRUE., senescence_real, 'gather', nbp_glo, index_g)
748	IF (ALL(senescence_real(:,:) == val_exp)) senescence_real(:,:) = zero
749	WHERE ( senescence_real(:,:) >= .5 )
750	senescence = .TRUE.
751	ELSEWHERE
752	senescence = .FALSE.
753	ENDWHERE
754	!-
755	when_growthinit(:,:) = val_exp
756	var_name = 'when_growthinit'
757	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
758	& .TRUE., when_growthinit, 'gather', nbp_glo, index_g)
759	IF (ALL(when_growthinit(:,:) == val_exp)) &
760	& when_growthinit(:,:) = undef
761	!-
762	age(:,:) = val_exp
763	var_name = 'age'
764	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
765	& .TRUE., age, 'gather', nbp_glo, index_g)
766	IF (ALL(age(:,:) == val_exp)) age(:,:) = zero
767	!-
768	! 13 CO2
769	!-
770	resp_hetero(:,:) = val_exp
771	var_name = 'resp_hetero'
772	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
773	& .TRUE., resp_hetero, 'gather', nbp_glo, index_g)
774	IF (ALL(resp_hetero(:,:) == val_exp)) resp_hetero(:,:) = zero
775	!-
776	resp_maint(:,:) = val_exp
777	var_name = 'resp_maint'
778	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
779	& .TRUE., resp_maint, 'gather', nbp_glo, index_g)
780	IF (ALL(resp_maint(:,:) == val_exp)) resp_maint(:,:) = zero
781	!-
782	resp_growth(:,:) = val_exp
783	var_name = 'resp_growth'
784	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
785	& .TRUE., resp_growth, 'gather', nbp_glo, index_g)
786	IF (ALL(resp_growth(:,:) == val_exp)) resp_growth(:,:) = zero
787	!-
788	co2_fire(:,:) = val_exp
789	var_name = 'co2_fire'
790	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
791	& .TRUE., co2_fire, 'gather', nbp_glo, index_g)
792	IF (ALL(co2_fire(:,:) == val_exp)) co2_fire(:,:) = zero
793	!-
794	co2_to_bm_dgvm(:,:) = val_exp
795	var_name = 'co2_to_bm_dgvm'
796	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
797	& .TRUE., co2_to_bm_dgvm, 'gather', nbp_glo, index_g)
798	IF (ALL(co2_to_bm_dgvm(:,:) == val_exp)) co2_to_bm_dgvm(:,:) = zero
799	!-
800	! 14 vegetation distribution after last light competition
801	!-
802	veget_lastlight(:,:) = val_exp
803	var_name = 'veget_lastlight'
804	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
805	& .TRUE., veget_lastlight, 'gather', nbp_glo, index_g)
806	IF (ALL(veget_lastlight(:,:) == val_exp)) veget_lastlight(:,:) = zero
807	!-
808	! 15 establishment criteria
809	!-
810	everywhere(:,:) = val_exp
811	var_name = 'everywhere'
812	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
813	& .TRUE., everywhere, 'gather', nbp_glo, index_g)
814	IF (ALL(everywhere(:,:) == val_exp)) everywhere(:,:) = zero
815	!-
816	need_adjacent_real(:,:) = val_exp
817	var_name = 'need_adjacent'
818	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
819	& .TRUE., need_adjacent_real, 'gather', nbp_glo, index_g)
820	IF (ALL(need_adjacent_real(:,:) == val_exp)) &
821	& need_adjacent_real(:,:) = zero
822	WHERE ( need_adjacent_real(:,:) >= .5 )
823	need_adjacent = .TRUE.
824	ELSEWHERE
825	need_adjacent = .FALSE.
826	ENDWHERE
827	!-
828	RIP_time(:,:) = val_exp
829	var_name = 'RIP_time'
830	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
831	& .TRUE., RIP_time, 'gather', nbp_glo, index_g)
832	IF (ALL(RIP_time(:,:) == val_exp)) RIP_time(:,:) = large_value
833	!-
834	! 16 black carbon
835	!-
836	black_carbon(:) = val_exp
837	var_name = 'black_carbon'
838	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
839	& .TRUE., black_carbon, 'gather', nbp_glo, index_g)
840	IF (ALL(black_carbon(:) == val_exp)) black_carbon(:) = zero
841	!-
842	! 17 litter
843	!-
844	litterpart(:,:,:) = val_exp
845	DO l=1,nlitt
846	var_name = 'litterpart_'//litter_str(l)
847	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
848	& .TRUE., litterpart(:,:,l), 'gather', nbp_glo, index_g)
849	IF (ALL(litterpart(:,:,l) == val_exp)) litterpart(:,:,l) = zero
850	ENDDO
851	!-
852	litter(:,:,:,:) = val_exp
853	DO l=1,nlevs
854	DO m=1,nvm
855	WRITE (part_str, '(I2)') m
856	IF (m<10) part_str(1:1)='0'
857	var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)
858	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nlitt , 1, itime, &
859	& .TRUE., litter(:,:,m,l), 'gather', nbp_glo, index_g)
860	IF (ALL(litter(:,:,m,l) == val_exp)) litter(:,:,m,l) = zero
861	ENDDO
862	ENDDO
863	!-
864	dead_leaves(:,:,:) = val_exp
865	DO l=1,nlitt
866	var_name = 'dead_leaves_'//litter_str(l)
867	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
868	& .TRUE., dead_leaves(:,:,l), 'gather', nbp_glo, index_g)
869	IF (ALL(dead_leaves(:,:,l) == val_exp)) dead_leaves(:,:,l) = zero
870	ENDDO
871	!-
872	carbon(:,:,:) = val_exp
873	DO m=1,nvm
874	WRITE (part_str, '(I2)') m
875	IF (m<10) part_str(1:1)='0'
876	var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
877	CALL restget_p (rest_id_stomate, var_name, nbp_glo, ncarb , 1, itime, &
878	& .TRUE., carbon(:,:,m), 'gather', nbp_glo, index_g)
879	IF (ALL(carbon(:,:,m) == val_exp)) carbon(:,:,m) = zero
880	ENDDO
881	!-
882	lignin_struc(:,:,:) = val_exp
883	DO l=1,nlevs
884	var_name = 'lignin_struc_'//level_str(l)
885	CALL restget_p &
886	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
887	& .TRUE., lignin_struc(:,:,l), 'gather', nbp_glo, index_g)
888	IF (ALL(lignin_struc(:,:,l) == val_exp)) lignin_struc(:,:,l) = zero
889	ENDDO
890	!-
891	! 18 land cover change
892	!-
893	prod10(:,:) = val_exp
894	var_name = 'prod10'
895	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 11 , 1, itime, &
896	& .TRUE., prod10, 'gather', nbp_glo, index_g)
897	IF (ALL(prod10(:,:) == val_exp)) prod10(:,:) = zero
898
899	prod100(:,:) = val_exp
900	var_name = 'prod100'
901	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 101 , 1, itime, &
902	& .TRUE., prod100, 'gather', nbp_glo, index_g)
903	IF (ALL(prod100(:,:) == val_exp)) prod100(:,:) = zero
904
905
906	flux10(:,:) = val_exp
907	var_name = 'flux10'
908	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 10 , 1, itime, &
909	& .TRUE., flux10, 'gather', nbp_glo, index_g)
910	IF (ALL(flux10(:,:) == val_exp)) flux10(:,:) = zero
911
912	flux100(:,:) = val_exp
913	var_name = 'flux100'
914	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 100 , 1, itime, &
915	& .TRUE., flux100, 'gather', nbp_glo, index_g)
916	IF (ALL(flux100(:,:) == val_exp)) flux100(:,:) = zero
917
918	convflux(:) = val_exp
919	var_name = 'convflux'
920	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
921	& .TRUE., convflux, 'gather', nbp_glo, index_g)
922	IF (ALL(convflux(:) == val_exp)) convflux(:) = zero
923
924	cflux_prod10(:) = val_exp
925	var_name = 'cflux_prod10'
926	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
927	& .TRUE., cflux_prod10, 'gather', nbp_glo, index_g)
928	IF (ALL(cflux_prod10(:) == val_exp)) cflux_prod10(:) = zero
929
930	cflux_prod100(:) = val_exp
931	var_name = 'cflux_prod100'
932	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
933	& .TRUE., cflux_prod100, 'gather', nbp_glo, index_g)
934	IF (ALL(cflux_prod100(:) == val_exp)) cflux_prod100(:) = zero
935
936	bm_to_litter(:,:,:) = val_exp
937	DO k=1,nparts
938	WRITE(part_str,'(I2)') k
939	IF ( k < 10 ) part_str(1:1) = '0'
940	var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))
941	CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
942	& .TRUE., bm_to_litter(:,:,k), 'gather', nbp_glo, index_g)
943	IF (ALL(bm_to_litter(:,:,k) == val_exp)) bm_to_litter(:,:,k) = zero
944	ENDDO
945
946	carb_mass_total(:) = val_exp
947	var_name = 'carb_mass_total'
948	CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1 , 1, itime, &
949	& .TRUE., carb_mass_total, 'gather', nbp_glo, index_g)
950	IF (ALL(carb_mass_total(:) == val_exp)) carb_mass_total(:) = zero
951	!-
952
953	IF (bavard >= 4) WRITE(numout,*) 'Leaving readstart'
954	!-----------------------
955	END SUBROUTINE readstart
956	!-
957	!===
958	!-
959	SUBROUTINE writerestart &
960	& (npts, index, day_counter, dt_days, date, &
961	& ind, adapted, regenerate, moiavail_daily, litterhum_daily, &
962	& t2m_daily, t2m_min_daily, tsurf_daily, tsoil_daily, &
963	& soilhum_daily, precip_daily, gpp_daily, npp_daily, &
964	& turnover_daily, moiavail_month, moiavail_week, &
965	& t2m_longterm, tlong_ref, t2m_month, t2m_week, &
966	& tsoil_month, soilhum_month, fireindex, firelitter, &
967	& maxmoiavail_lastyear, maxmoiavail_thisyear, &
968	& minmoiavail_lastyear, minmoiavail_thisyear, &
969	& maxgppweek_lastyear, maxgppweek_thisyear, &
970	& gdd0_lastyear, gdd0_thisyear, precip_lastyear, precip_thisyear, &
971	& gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, &
972	& PFTpresent, npp_longterm, lm_lastyearmax, lm_thisyearmax, &
973	& maxfpc_lastyear, maxfpc_thisyear, &
974	& turnover_longterm, gpp_week, biomass, resp_maint_part, &
975	& leaf_age, leaf_frac, senescence, when_growthinit, age, &
976	& resp_hetero, resp_maint, resp_growth, co2_fire, co2_to_bm_dgvm, &
977	& veget_lastlight, everywhere, need_adjacent, RIP_time, &
978	& time_lowgpp, time_hum_min, hum_min_dormance, &
979	& litterpart, litter, dead_leaves, &
980	& carbon, black_carbon, lignin_struc, turnover_time, &
981	& prod10,prod100 ,flux10, flux100, &
982	& convflux, cflux_prod10, cflux_prod100, bm_to_litter, carb_mass_total)
983
984	!---------------------------------------------------------------------
985	!- write restart file
986	!---------------------------------------------------------------------
987	!-
988	! 0 declarations
989	!-
990	! 0.1 input
991	!-
992	! Domain size
993	INTEGER(i_std),INTENT(in) :: npts
994	! Indices of the points on the map
995	INTEGER(i_std),DIMENSION(npts),INTENT(in) :: index
996	! counts time until next STOMATE time step
997	REAL(r_std),INTENT(in) :: day_counter
998	! time step of STOMATE in days
999	REAL(r_std),INTENT(in) :: dt_days
1000	! date (d)
1001	INTEGER(i_std),INTENT(in) :: date
1002	! density of individuals (1/m**2)
1003	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ind
1004	! Winter too cold? between 0 and 1
1005	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: adapted
1006	! Winter sufficiently cold? between 0 and 1
1007	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: regenerate
1008	! daily moisture availability
1009	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_daily
1010	! daily litter humidity
1011	REAL(r_std),DIMENSION(npts),INTENT(in) :: litterhum_daily
1012	! daily 2 meter temperatures (K)
1013	REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_daily
1014	! daily minimum 2 meter temperatures (K)
1015	REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_min_daily
1016	! daily surface temperatures (K)
1017	REAL(r_std),DIMENSION(npts),INTENT(in) :: tsurf_daily
1018	! daily soil temperatures (K)
1019	REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_daily
1020	! daily soil humidity
1021	REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_daily
1022	! daily precipitations (mm/day) (for phenology)
1023	REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_daily
1024	! daily gross primary productivity (gC/m**2/day)
1025	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_daily
1026	! daily net primary productivity (gC/m**2/day)
1027	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_daily
1028	! daily turnover rates (gC/m**2/day)
1029	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: turnover_daily
1030	! "monthly" moisture availability
1031	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_month
1032	! "weekly" moisture availability
1033	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: moiavail_week
1034	! "long term" 2 meter temperatures (K)
1035	REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_longterm
1036	! "long term" reference 2 meter temperatures (K)
1037	REAL(r_std),DIMENSION(npts),INTENT(in) :: tlong_ref
1038	! "monthly" 2 meter temperatures (K)
1039	REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_month
1040	! "weekly" 2 meter temperatures (K)
1041	REAL(r_std),DIMENSION(npts),INTENT(in) :: t2m_week
1042	! "monthly" soil temperatures (K)
1043	REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: tsoil_month
1044	! "monthly" soil humidity
1045	REAL(r_std),DIMENSION(npts,nbdl),INTENT(in) :: soilhum_month
1046	! Probability of fire
1047	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: fireindex
1048	! Longer term total litter above the ground, gC/m**2 of ground
1049	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: firelitter
1050	! last year's maximum moisture availability
1051	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_lastyear
1052	! this year's maximum moisture availability
1053	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxmoiavail_thisyear
1054	! last year's minimum moisture availability
1055	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_lastyear
1056	! this year's minimum moisture availability
1057	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: minmoiavail_thisyear
1058	! last year's maximum weekly GPP
1059	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_lastyear
1060	! this year's maximum weekly GPP
1061	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxgppweek_thisyear
1062	! last year's annual GDD0
1063	REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_lastyear
1064	! this year's annual GDD0
1065	REAL(r_std),DIMENSION(npts),INTENT(in) :: gdd0_thisyear
1066	! last year's annual precipitation (mm/year)
1067	REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_lastyear
1068	! this year's annual precipitation (mm/year)
1069	REAL(r_std),DIMENSION(npts),INTENT(in) :: precip_thisyear
1070	! growing degree days, threshold -5 deg C (for phenology)
1071	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_m5_dormance
1072	! growing degree days since midwinter (for phenology)
1073	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gdd_midwinter
1074	! number of chilling days since leaves were lost (for phenology)
1075	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ncd_dormance
1076	! number of growing days, threshold -5 deg C (for phenology)
1077	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: ngd_minus5
1078	! PFT exists (equivalent to fpc_max > 0 for natural PFTs)
1079	LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: PFTpresent
1080	! "long term" net primary productivity (gC/m**2/year)
1081	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: npp_longterm
1082	! last year's maximum leaf mass, for each PFT (gC/m**2)
1083	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_lastyearmax
1084	! this year's maximum leaf mass, for each PFT (gC/m**2)
1085	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: lm_thisyearmax
1086	! last year's maximum fpc for each natural PFT, on ground
1087	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_lastyear
1088	! this year's maximum fpc for each PFT,
1089	! on total ground (see stomate_season)
1090	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: maxfpc_thisyear
1091	! "long term" turnover rate (gC/m**2/year)
1092	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: turnover_longterm
1093	! "weekly" GPP (gC/day/(m**2 covered)
1094	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: gpp_week
1095	! biomass (gC/m**2)
1096	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: biomass
1097	! maintenance respiration (gC/m**2)
1098	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: resp_maint_part
1099	! leaf age (days)
1100	REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_age
1101	! fraction of leaves in leaf age class
1102	REAL(r_std),DIMENSION(npts,nvm,nleafages),INTENT(in) :: leaf_frac
1103	! is the plant senescent ?
1104	! (only for deciduous trees - carbohydrate reserve)
1105	LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: senescence
1106	! how many days ago was the beginning of the growing season
1107	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: when_growthinit
1108	! mean age (years)
1109	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: age
1110	! heterotrophic respiration (gC/day/m**2)
1111	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_hetero
1112	! maintenance respiration (gC/day/m**2)
1113	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_maint
1114	! growth respiration (gC/day/m**2)
1115	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: resp_growth
1116	! carbon emitted into the atmosphere by fire (living and dead biomass)
1117	! (in gC/m**2/time step)
1118	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_fire
1119	! biomass uptaken (gC/(m**2 of total ground)/day)
1120	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: co2_to_bm_dgvm
1121	! vegetation fractions (on ground) after last light competition
1122	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: veget_lastlight
1123	! is the PFT everywhere in the grid box or very localized
1124	! (after its introduction)
1125	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: everywhere
1126	! in order for this PFT to be introduced,
1127	! does it have to be present in an adjacent grid box?
1128	LOGICAL,DIMENSION(npts,nvm),INTENT(in) :: need_adjacent
1129	! How much time ago was the PFT eliminated for the last time (y)
1130	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: RIP_time
1131	! duration of dormance (d)
1132	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_lowgpp
1133	! time elapsed since strongest moisture availability (d)
1134	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: time_hum_min
1135	! minimum moisture during dormance
1136	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: hum_min_dormance
1137	! fraction of litter above the ground belonging to different PFTs
1138	REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: litterpart
1139	! metabolic and structural litter, above and below ground (gC/m**2)
1140	REAL(r_std),DIMENSION(npts,nlitt,nvm,nlevs),INTENT(in) :: litter
1141	! dead leaves on ground, per PFT, metabolic and structural,
1142	! in gC/(m**2 of ground)
1143	REAL(r_std),DIMENSION(npts,nvm,nlitt),INTENT(in) :: dead_leaves
1144	! carbon pool: active, slow, or passive, (gC/m**2)
1145	REAL(r_std),DIMENSION(npts,ncarb,nvm),INTENT(in) :: carbon
1146	! black carbon on the ground (gC/(m**2 of total ground))
1147	REAL(r_std),DIMENSION(npts),INTENT(in) :: black_carbon
1148	! ratio Lignine/Carbon in structural litter, above and below ground, (gC/m**2)
1149	REAL(r_std),DIMENSION(npts,nvm,nlevs),INTENT(in) :: lignin_struc
1150	! turnover_time of leaves
1151	REAL(r_std),DIMENSION(npts,nvm),INTENT(in) :: turnover_time
1152	!-
1153	! 0.2 local
1154	!-
1155	! date, real
1156	REAL(r_std) :: date_real
1157	! PFT exists (equivalent to fpc_max > 0 for natural PFTs), real
1158	REAL(r_std),DIMENSION(npts,nvm) :: PFTpresent_real
1159	! is the plant senescent ?
1160	! (only for deciduous trees - carbohydrate reserve), real
1161	REAL(r_std),DIMENSION(npts,nvm) :: senescence_real
1162	! in order for this PFT to be introduced,
1163	! does it have to be present in an adjacent grid box? - real
1164	REAL(r_std),DIMENSION(npts,nvm) :: need_adjacent_real
1165	! To store variables names for I/O
1166	CHARACTER(LEN=80) :: var_name
1167	! string suffix indicating an index
1168	CHARACTER(LEN=10) :: part_str
1169	! string suffix indicating litter type
1170	CHARACTER(LEN=3),DIMENSION(nlitt) :: litter_str
1171	! string suffix indicating level
1172	CHARACTER(LEN=2),DIMENSION(nlevs) :: level_str
1173	! temporary storage
1174	REAL(r_std),DIMENSION(1) :: xtmp
1175	! index
1176	INTEGER(i_std) :: j,k,l,m
1177
1178	! land cover change variables
1179	! products remaining in the 10/100 year-turnover pool after the annual release for each compartment
1180	! (10 or 100 + 1 : input from year of land cover change)
1181	REAL(r_std),DIMENSION(npts,0:10),INTENT(in) :: prod10
1182	REAL(r_std),DIMENSION(npts,0:100),INTENT(in) :: prod100
1183	! annual release from the 10/100 year-turnover pool compartments
1184	REAL(r_std),DIMENSION(npts,10),INTENT(in) :: flux10
1185	REAL(r_std),DIMENSION(npts,100),INTENT(in) :: flux100
1186	REAL(r_std), DIMENSION(npts), INTENT(in) :: convflux
1187	REAL(r_std), DIMENSION(npts), INTENT(in) :: cflux_prod10
1188	REAL(r_std), DIMENSION(npts), INTENT(in) :: cflux_prod100
1189	REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in) :: bm_to_litter
1190	REAL(r_std),DIMENSION(npts),INTENT(in) :: carb_mass_total
1191	!---------------------------------------------------------------------
1192	IF (bavard >= 3) WRITE(numout,*) 'Entering writerestart'
1193	!-
1194	! 1 string definitions
1195	!-
1196	DO l=1,nlitt
1197	IF (l == imetabolic) THEN
1198	litter_str(l) = 'met'
1199	ELSEIF (l == istructural) THEN
1200	litter_str(l) = 'str'
1201	ELSE
1202	STOP 'Define litter_str'
1203	ENDIF
1204	ENDDO
1205	!-
1206	DO l=1,nlevs
1207	IF (l == iabove) THEN
1208	level_str(l) = 'ab'
1209	ELSEIF (l == ibelow) THEN
1210	level_str(l) = 'be'
1211	ELSE
1212	STOP 'Define level_str'
1213	ENDIF
1214	ENDDO
1215	!-
1216	IF (is_root_prc) THEN
1217	CALL ioconf_setatt ('UNITS','-')
1218	CALL ioconf_setatt ('LONG_NAME',' ')
1219	ENDIF
1220	!-
1221	! 2 run control
1222	!-
1223	! 2.1 day counter
1224	!-
1225	IF (is_root_prc) THEN
1226	var_name = 'day_counter'
1227	xtmp(1) = day_counter
1228	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1229	ENDIF
1230	!-
1231	! 2.2 time step of STOMATE in days
1232	!-
1233	IF (is_root_prc) THEN
1234	var_name = 'dt_days'
1235	xtmp(1) = dt_days
1236	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1237	ENDIF
1238	!-
1239	! 2.3 date
1240	!-
1241	IF (is_root_prc) THEN
1242	var_name = 'date'
1243	date_real = REAL(date,r_std)
1244	xtmp(1) = date_real
1245	CALL restput (rest_id_stomate, var_name, 1, 1, 1, itime, xtmp)
1246	ENDIF
1247	!-
1248	! 3 daily meteorological variables
1249	!-
1250	var_name = 'moiavail_daily'
1251	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1252	& moiavail_daily, 'scatter', nbp_glo, index_g)
1253	!-
1254	var_name = 'litterhum_daily'
1255	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1256	& litterhum_daily, 'scatter', nbp_glo, index_g)
1257	!-
1258	var_name = 't2m_daily'
1259	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1260	& t2m_daily, 'scatter', nbp_glo, index_g)
1261	!-
1262	var_name = 't2m_min_daily'
1263	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1264	& t2m_min_daily, 'scatter', nbp_glo, index_g)
1265	!-
1266	var_name = 'tsurf_daily'
1267	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1268	& tsurf_daily, 'scatter', nbp_glo, index_g)
1269	!-
1270	var_name = 'tsoil_daily'
1271	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
1272	& tsoil_daily, 'scatter', nbp_glo, index_g)
1273	!-
1274	var_name = 'soilhum_daily'
1275	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
1276	& soilhum_daily, 'scatter', nbp_glo, index_g)
1277	!-
1278	var_name = 'precip_daily'
1279	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1280	& precip_daily, 'scatter', nbp_glo, index_g)
1281	!-
1282	! 4 productivities
1283	!-
1284	var_name = 'gpp_daily'
1285	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1286	& gpp_daily, 'scatter', nbp_glo, index_g)
1287	!-
1288	var_name = 'npp_daily'
1289	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1290	& npp_daily, 'scatter', nbp_glo, index_g)
1291	!-
1292	DO k=1,nparts
1293	WRITE(part_str,'(I2)') k
1294	IF (k < 10) part_str(1:1) = '0'
1295	var_name = 'turnover_daily_'//part_str(1:LEN_TRIM(part_str))
1296	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1297	& turnover_daily(:,:,k), 'scatter', nbp_glo, index_g)
1298	ENDDO
1299	!-
1300	! 5 monthly meteorological variables
1301	!-
1302	var_name = 'moiavail_month'
1303	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1304	& moiavail_month, 'scatter', nbp_glo, index_g)
1305	!-
1306	var_name = 'moiavail_week'
1307	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1308	& moiavail_week, 'scatter', nbp_glo, index_g)
1309	!-
1310	var_name = 't2m_longterm'
1311	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1312	& t2m_longterm, 'scatter', nbp_glo, index_g)
1313	!-
1314	IF (control%ok_dgvm) THEN
1315	var_name = 'tlong_ref'
1316	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1317	& tlong_ref, 'scatter', nbp_glo, index_g)
1318	ENDIF
1319	!-
1320	var_name = 't2m_month'
1321	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1322	& t2m_month, 'scatter', nbp_glo, index_g)
1323	!-
1324	var_name = 't2m_week'
1325	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1326	& t2m_week, 'scatter', nbp_glo, index_g)
1327	!-
1328	var_name = 'tsoil_month'
1329	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
1330	& tsoil_month, 'scatter', nbp_glo, index_g)
1331	!-
1332	var_name = 'soilhum_month'
1333	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nbdl, 1, itime, &
1334	& soilhum_month, 'scatter', nbp_glo, index_g)
1335	!-
1336	! 6 fire probability
1337	!-
1338	var_name = 'fireindex'
1339	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1340	& fireindex, 'scatter', nbp_glo, index_g)
1341	!-
1342	var_name = 'firelitter'
1343	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1344	& firelitter, 'scatter', nbp_glo, index_g)
1345	!-
1346	! 7 maximum and minimum moisture availabilities for tropic phenology
1347	!-
1348	var_name = 'maxmoistr_last'
1349	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1350	& maxmoiavail_lastyear, 'scatter', nbp_glo, index_g)
1351	!-
1352	var_name = 'maxmoistr_this'
1353	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1354	& maxmoiavail_thisyear, 'scatter', nbp_glo, index_g)
1355	!-
1356	var_name = 'minmoistr_last'
1357	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1358	& minmoiavail_lastyear, 'scatter', nbp_glo, index_g)
1359	!-
1360	var_name = 'minmoistr_this'
1361	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1362	& minmoiavail_thisyear, 'scatter', nbp_glo, index_g)
1363	!-
1364	! 8 maximum "weekly" GPP
1365	!-
1366	var_name = 'maxgppweek_lastyear'
1367	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1368	& maxgppweek_lastyear, 'scatter', nbp_glo, index_g)
1369	!-
1370	var_name = 'maxgppweek_thisyear'
1371	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1372	& maxgppweek_thisyear, 'scatter', nbp_glo, index_g)
1373	!-
1374	! 9 annual GDD0
1375	!-
1376	var_name = 'gdd0_thisyear'
1377	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1378	& gdd0_thisyear, 'scatter', nbp_glo, index_g)
1379	!-
1380	var_name = 'gdd0_lastyear'
1381	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1382	& gdd0_lastyear, 'scatter', nbp_glo, index_g)
1383	!-
1384	! 10 annual precipitation
1385	!-
1386	var_name = 'precip_thisyear'
1387	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1388	& precip_thisyear, 'scatter', nbp_glo, index_g)
1389	!-
1390	var_name = 'precip_lastyear'
1391	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1392	& precip_lastyear, 'scatter', nbp_glo, index_g)
1393	!-
1394	! 11 derived "biometeorological" variables
1395	!-
1396	var_name = 'gdd_m5_dormance'
1397	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1398	& gdd_m5_dormance, 'scatter', nbp_glo, index_g)
1399	!-
1400	var_name = 'gdd_midwinter'
1401	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1402	& gdd_midwinter, 'scatter', nbp_glo, index_g)
1403	!-
1404	var_name = 'ncd_dormance'
1405	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1406	& ncd_dormance, 'scatter', nbp_glo, index_g)
1407	!-
1408	var_name = 'ngd_minus5'
1409	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1410	& ngd_minus5, 'scatter', nbp_glo, index_g)
1411	!-
1412	var_name = 'time_lowgpp'
1413	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1414	& time_lowgpp, 'scatter', nbp_glo, index_g)
1415	!-
1416	var_name = 'time_hum_min'
1417	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1418	& time_hum_min, 'scatter', nbp_glo, index_g)
1419	!-
1420	var_name = 'hum_min_dormance'
1421	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1422	& hum_min_dormance, 'scatter', nbp_glo, index_g)
1423	!-
1424	! 12 Plant status
1425	!-
1426	var_name = 'PFTpresent'
1427	WHERE ( PFTpresent(:,:) )
1428	PFTpresent_real = un
1429	ELSEWHERE
1430	PFTpresent_real = zero
1431	ENDWHERE
1432	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1433	& PFTpresent_real, 'scatter', nbp_glo, index_g)
1434	!-
1435	var_name = 'ind'
1436	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1437	& ind, 'scatter', nbp_glo, index_g)
1438	!-
1439	var_name = 'turnover_time'
1440	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1441	& turnover_time, 'scatter', nbp_glo, index_g)
1442	!-
1443	var_name = 'adapted'
1444	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1445	& adapted, 'scatter', nbp_glo, index_g)
1446	!-
1447	var_name = 'regenerate'
1448	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1449	& regenerate, 'scatter', nbp_glo, index_g)
1450	!-
1451	var_name = 'npp_longterm'
1452	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1453	& npp_longterm, 'scatter', nbp_glo, index_g)
1454	!-
1455	var_name = 'lm_lastyearmax'
1456	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1457	& lm_lastyearmax, 'scatter', nbp_glo, index_g)
1458	!-
1459	var_name = 'lm_thisyearmax'
1460	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1461	& lm_thisyearmax, 'scatter', nbp_glo, index_g)
1462	!-
1463	var_name = 'maxfpc_lastyear'
1464	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1465	& maxfpc_lastyear, 'scatter', nbp_glo, index_g)
1466	!-
1467	var_name = 'maxfpc_thisyear'
1468	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1469	& maxfpc_thisyear, 'scatter', nbp_glo, index_g)
1470	!-
1471	DO k=1,nparts
1472	WRITE(part_str,'(I2)') k
1473	IF (k < 10) part_str(1:1) = '0'
1474	var_name = 'turnover_longterm_'//part_str(1:LEN_TRIM(part_str))
1475	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1476	& turnover_longterm(:,:,k), 'scatter', nbp_glo, index_g)
1477	ENDDO
1478	!-
1479	var_name = 'gpp_week'
1480	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1481	& gpp_week, 'scatter', nbp_glo, index_g)
1482	!-
1483	DO k=1,nparts
1484	WRITE(part_str,'(I2)') k
1485	IF (k < 10) part_str(1:1) = '0'
1486	var_name = 'biomass_'//part_str(1:LEN_TRIM(part_str))
1487	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1488	& biomass(:,:,k), 'scatter', nbp_glo, index_g)
1489	ENDDO
1490	!-
1491	DO k=1,nparts
1492	WRITE(part_str,'(I2)') k
1493	IF (k < 10) part_str(1:1) = '0'
1494	var_name = 'maint_resp_'//part_str(1:LEN_TRIM(part_str))
1495	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1496	& resp_maint_part(:,:,k), 'scatter', nbp_glo, index_g)
1497	ENDDO
1498	!-
1499	DO m=1,nleafages
1500	WRITE(part_str,'(I2)') m
1501	IF (m < 10) part_str(1:1) = '0'
1502	var_name = 'leaf_age_'//part_str(1:LEN_TRIM(part_str))
1503	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1504	& leaf_age(:,:,m), 'scatter', nbp_glo, index_g)
1505	ENDDO
1506	!-
1507	DO m=1,nleafages
1508	WRITE(part_str,'(I2)') m
1509	IF (m < 10) part_str(1:1) = '0'
1510	var_name = 'leaf_frac_'//part_str(1:LEN_TRIM(part_str))
1511	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1512	& leaf_frac(:,:,m), 'scatter', nbp_glo, index_g)
1513	ENDDO
1514	!-
1515	var_name = 'senescence'
1516	WHERE ( senescence(:,:) )
1517	senescence_real = un
1518	ELSEWHERE
1519	senescence_real = zero
1520	ENDWHERE
1521	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1522	& senescence_real, 'scatter', nbp_glo, index_g)
1523	!-
1524	var_name = 'when_growthinit'
1525	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1526	& when_growthinit, 'scatter', nbp_glo, index_g)
1527	!-
1528	var_name = 'age'
1529	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm , 1, itime, &
1530	& age, 'scatter', nbp_glo, index_g)
1531	!-
1532	! 13 CO2
1533	!-
1534	var_name = 'resp_hetero'
1535	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1536	& resp_hetero, 'scatter', nbp_glo, index_g)
1537	!-
1538	var_name = 'resp_maint'
1539	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1540	& resp_maint, 'scatter', nbp_glo, index_g)
1541	!-
1542	var_name = 'resp_growth'
1543	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1544	& resp_growth, 'scatter', nbp_glo, index_g)
1545	!-
1546	var_name = 'co2_fire'
1547	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1548	& co2_fire, 'scatter', nbp_glo, index_g)
1549	!-
1550	var_name = 'co2_to_bm_dgvm'
1551	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1552	& co2_to_bm_dgvm, 'scatter', nbp_glo, index_g)
1553	!-
1554	! 14 vegetation distribution after last light competition
1555	!-
1556	var_name = 'veget_lastlight'
1557	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1558	& veget_lastlight, 'scatter', nbp_glo, index_g)
1559	!-
1560	! 15 establishment criteria
1561	!-
1562	var_name = 'everywhere'
1563	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1564	& everywhere, 'scatter', nbp_glo, index_g)
1565	!-
1566	var_name = 'need_adjacent'
1567	WHERE (need_adjacent(:,:))
1568	need_adjacent_real = un
1569	ELSEWHERE
1570	need_adjacent_real = zero
1571	ENDWHERE
1572	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1573	& need_adjacent_real, 'scatter', nbp_glo, index_g)
1574	!-
1575	var_name = 'RIP_time'
1576	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1577	& RIP_time, 'scatter', nbp_glo, index_g)
1578	!-
1579	! 16 black carbon
1580	!-
1581	var_name = 'black_carbon'
1582	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1583	& black_carbon, 'scatter', nbp_glo, index_g)
1584	!-
1585	! 17 litter
1586	!-
1587	DO l=1,nlitt
1588	var_name = 'litterpart_'//litter_str(l)
1589	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1590	& litterpart(:,:,l), 'scatter', nbp_glo, index_g)
1591	ENDDO
1592	!-
1593	DO l=1,nlevs
1594	DO m=1,nvm
1595	WRITE (part_str, '(I2)') m
1596	IF (m<10) part_str(1:1)='0'
1597	var_name = 'litter_'//part_str(1:LEN_TRIM(part_str))//'_'//level_str(l)
1598	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nlitt, 1, itime, &
1599	& litter(:,:,m,l), 'scatter', nbp_glo, index_g)
1600	ENDDO
1601	ENDDO
1602	!-
1603	DO l=1,nlitt
1604	var_name = 'dead_leaves_'//litter_str(l)
1605	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1606	& dead_leaves(:,:,l), 'scatter', nbp_glo, index_g)
1607	ENDDO
1608	!-
1609	DO m=1,nvm
1610	WRITE (part_str, '(I2)') m
1611	IF (m<10) part_str(1:1)='0'
1612	var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
1613	CALL restput_p (rest_id_stomate, var_name, nbp_glo, ncarb, 1, itime, &
1614	& carbon(:,:,m), 'scatter', nbp_glo, index_g)
1615	ENDDO
1616	!-
1617	DO l=1,nlevs
1618	var_name = 'lignin_struc_'//level_str(l)
1619	CALL restput_p &
1620	& (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1621	& lignin_struc(:,:,l), 'scatter', nbp_glo, index_g)
1622	ENDDO
1623	!-
1624	! 18 land cover change
1625	!-
1626	var_name = 'prod10'
1627	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 11, 1, itime, &
1628	& prod10, 'scatter', nbp_glo, index_g)
1629	var_name = 'prod100'
1630	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 101, 1, itime, &
1631	& prod100, 'scatter', nbp_glo, index_g)
1632	var_name = 'flux10'
1633	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 10, 1, itime, &
1634	& flux10, 'scatter', nbp_glo, index_g)
1635	var_name = 'flux100'
1636	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 100, 1, itime, &
1637	& flux100, 'scatter', nbp_glo, index_g)
1638
1639	var_name = 'convflux'
1640	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1641	& convflux, 'scatter', nbp_glo, index_g)
1642	var_name = 'cflux_prod10'
1643	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1644	& cflux_prod10, 'scatter', nbp_glo, index_g)
1645	var_name = 'cflux_prod100'
1646	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1647	& cflux_prod100, 'scatter', nbp_glo, index_g)
1648	DO k=1,nparts
1649	WRITE(part_str,'(I2)') k
1650	IF (k < 10) part_str(1:1) = '0'
1651	var_name = 'bm_to_litter_'//part_str(1:LEN_TRIM(part_str))
1652	CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1, itime, &
1653	& bm_to_litter(:,:,k), 'scatter', nbp_glo, index_g)
1654	ENDDO
1655	var_name = 'carb_mass_total'
1656	CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1, 1, itime, &
1657	& carb_mass_total, 'scatter', nbp_glo, index_g)
1658	!-
1659	IF (bavard >= 4) WRITE(numout,*) 'Leaving writerestart'
1660	!--------------------------
1661	END SUBROUTINE writerestart
1662	!-
1663	!===
1664	!-
1665	SUBROUTINE readbc (npts, lalo, resolution, tref)
1666	!---------------------------------------------------------------------
1667	!-
1668	! 0.1 input
1669	!-
1670	! Domain size
1671	INTEGER(i_std),INTENT(in) :: npts
1672	! Geogr. coordinates (latitude,longitude) (degrees)
1673	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: lalo
1674	! size in x an y of the grid (m)
1675	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: resolution
1676	!-
1677	! 0.2 not necessarily output
1678	!-
1679	! "long term" reference 2 meter temperatures (K)
1680	REAL(r_std),DIMENSION(npts),INTENT(inout) :: tref
1681	!---------------------------------------------------------------------
1682	!-
1683	! If the vegetation is static, then the long-term reference
1684	! temperature is a boundary condition.
1685	!-
1686	IF ( .NOT. control%ok_dgvm ) THEN
1687	CALL get_reftemp (npts, lalo, resolution, tref)
1688	ENDIF
1689	!--------------------
1690	END SUBROUTINE readbc
1691	!-
1692	!===
1693	!-
1694	SUBROUTINE get_reftemp_clear
1695	!---------------------------------------------------------------------
1696	firstcall=.TRUE.
1697	IF (ALLOCATED (trefe)) DEALLOCATE( trefe )
1698	!-------------------------------
1699	END SUBROUTINE get_reftemp_clear
1700	!-
1701	!===
1702	!-
1703	SUBROUTINE get_reftemp (npts, lalo, resolution, tref_out)
1704	!---------------------------------------------------------------------
1705	!- read the long-term reference temperature from a boundary condition
1706	!- file. If the vegetation is dynamic, this field is used to
1707	!- initialize correctly the (prognostic) long-term reference
1708	!- temperature (in the case it is not found in the restart file).
1709	!- If the vegetation is static, the field read here is a real boundary
1710	!- condition that is not modified by the model.
1711	!---------------------------------------------------------------------
1712	!-
1713	! 0 declarations
1714	!-
1715	! 0.1 input
1716	!-
1717	! Domain size
1718	INTEGER(i_std),INTENT(in) :: npts
1719	! Geogr. coordinates (latitude,longitude) (degrees)
1720	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: lalo
1721	! size in x an y of the grid (m)
1722	REAL(r_std),DIMENSION (npts,2),INTENT(in) :: resolution
1723	!-
1724	! 0.2 output
1725	!-
1726	! reference temperature (K)
1727	REAL(r_std), DIMENSION(npts),INTENT(out) :: tref_out
1728	!-
1729	! 0.3 local
1730	!-
1731	INTEGER(i_std),PARAMETER :: nbvmax=200
1732	CHARACTER(LEN=80) :: filename
1733	INTEGER(i_std) :: &
1734	& iml, jml, lml, tml, fid, ib, ip, jp, fopt, ilf, lastjp
1735	REAL(r_std) :: lev(1), date, dt, coslat
1736	INTEGER(i_std) :: itau(1)
1737	REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: &
1738	& lat_rel, lon_rel, lat_ful, lon_ful, tref_file
1739	REAL(r_std),ALLOCATABLE,DIMENSION(:,:) :: &
1740	& loup_rel, lolow_rel, laup_rel, lalow_rel
1741	REAL(r_std) :: lon_up, lon_low, lat_up, lat_low
1742	REAL(r_std) :: ax, ay, sgn
1743	REAL(r_std),DIMENSION(nbvmax) :: area
1744	REAL(r_std),DIMENSION(nbvmax) :: tt
1745	REAL(r_std) :: resx, resy
1746	LOGICAL :: do_again
1747	!---------------------------------------------------------------------
1748	!-
1749	! 1 If this is the first call, calculate the reference temperature
1750	! and keep it in memory
1751	!-
1752	IF (firstcall) THEN
1753	!---
1754	!-- 1.1 only do this once
1755	!---
1756	firstcall = .FALSE.
1757	!---
1758	!-- 1.2 allocate the field
1759	!---
1760	ALLOCATE( trefe(npts) )
1761	!---
1762	!-- 1.3 read and interpolate the temperature file
1763	!---
1764	!-- Needs to be a configurable variable
1765	!---
1766	!Config Key = REFTEMP_FILE
1767	!Config Desc = Name of file from which the reference temperature is read
1768	!Config If = OK_STOMATE
1769	!Config Def = reftemp.nc
1770	!Config Help = The name of the file to be opened to read
1771	!Config the reference surface temperature.
1772	!Config The data from this file is then interpolated
1773	!Config to the grid of of the model.
1774	!Config The aim is to get a reference temperature either
1775	!Config to initialize the corresponding prognostic model
1776	!Config variable correctly (ok_dgvm=TRUE) or to impose it
1777	!Config as boundary condition (ok_dgvm=FALSE)
1778	!Config Units = [FILE]
1779	!---
1780	filename = 'reftemp.nc'
1781	CALL getin_p('REFTEMP_FILE',filename)
1782	!---
1783	IF (is_root_prc) CALL flininfo(filename,iml, jml, lml, tml, fid)
1784	CALL bcast(iml)
1785	CALL bcast(jml)
1786	CALL bcast(lml)
1787	CALL bcast(tml)
1788	!---
1789	ALLOCATE (lat_rel(iml,jml))
1790	ALLOCATE (lon_rel(iml,jml))
1791	ALLOCATE (laup_rel(iml,jml))
1792	ALLOCATE (loup_rel(iml,jml))
1793	ALLOCATE (lalow_rel(iml,jml))
1794	ALLOCATE (lolow_rel(iml,jml))
1795	ALLOCATE (lat_ful(iml+2,jml+2))
1796	ALLOCATE (lon_ful(iml+2,jml+2))
1797	ALLOCATE (tref_file(iml,jml))
1798	!---
1799	IF (is_root_prc) CALL flinopen (filename, .FALSE., iml, jml, lml, &
1800	& lon_rel, lat_rel, lev, tml, itau, date, dt, fid)
1801	CALL bcast(lon_rel)
1802	CALL bcast(lat_rel)
1803	CALL bcast(itau)
1804	CALL bcast(date)
1805	CALL bcast(dt)
1806
1807	!---
1808	IF (is_root_prc) CALL flinget (fid, 'temperature', iml, jml, lml, tml, &
1809	& 1, 1, tref_file)
1810	CALL bcast(tref_file)
1811	!---
1812	IF (is_root_prc) CALL flinclo (fid)
1813	!---
1814	!-- Duplicate the border assuming we have a global grid
1815	!-- going from west to east
1816	!---
1817	lon_ful(2:iml+1,2:jml+1) = lon_rel(1:iml,1:jml)
1818	lat_ful(2:iml+1,2:jml+1) = lat_rel(1:iml,1:jml)
1819	!---
1820	IF ( lon_rel(iml,1) < lon_ful(2,2)) THEN
1821	lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)
1822	lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
1823	ELSE
1824	lon_ful(1,2:jml+1) = lon_rel(iml,1:jml)-360
1825	lat_ful(1,2:jml+1) = lat_rel(iml,1:jml)
1826	ENDIF
1827	!---
1828	IF ( lon_rel(1,1) > lon_ful(iml+1,2)) THEN
1829	lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)
1830	lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
1831	ELSE
1832	lon_ful(iml+2,2:jml+1) = lon_rel(1,1:jml)+360
1833	lat_ful(iml+2,2:jml+1) = lat_rel(1,1:jml)
1834	ENDIF
1835	!---
1836	sgn = lat_rel(1,1)/ABS(lat_rel(1,1))
1837	lat_ful(2:iml+1,1) = sgn*180 - lat_rel(1:iml,1)
1838	sgn = lat_rel(1,jml)/ABS(lat_rel(1,jml))
1839	lat_ful(2:iml+1,jml+2) = sgn*180 - lat_rel(1:iml,jml)
1840	lat_ful(1,1) = lat_ful(iml+1,1)
1841	lat_ful(iml+2,1) = lat_ful(2,1)
1842	lat_ful(1,jml+2) = lat_ful(iml+1,jml+2)
1843	lat_ful(iml+2,jml+2) = lat_ful(2,jml+2)
1844	!---
1845	!-- Add the longitude lines to the top and bottom
1846	!---
1847	lon_ful(:,1) = lon_ful(:,2)
1848	lon_ful(:,jml+2) = lon_ful(:,jml+1)
1849	!---
1850	!-- Get the upper and lower limits of each grid box
1851	!---
1852	DO ip=1,iml
1853	DO jp=1,jml
1854	loup_rel(ip,jp) = &
1855	& MAX(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), &
1856	& 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
1857	lolow_rel(ip,jp) = &
1858	& MIN(0.5*(lon_ful(ip,jp+1)+lon_ful(ip+1,jp+1)), &
1859	& 0.5*(lon_ful(ip+1,jp+1)+lon_ful(ip+2,jp+1)))
1860	laup_rel(ip,jp) = &
1861	& MAX(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), &
1862	& 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
1863	lalow_rel(ip,jp) = &
1864	& MIN(0.5*(lat_ful(ip+1,jp)+lat_ful(ip+1,jp+1)), &
1865	& 0.5*(lat_ful(ip+1,jp+1)+lat_ful(ip+1,jp+2)))
1866	ENDDO
1867	ENDDO
1868	!---
1869	!-- Now we take each grid point and find out which values
1870	!-- from the forcing we need to average
1871	!---
1872	DO ib=1,npts
1873	!-----
1874	resx = resolution(ib,1)
1875	resy = resolution(ib,2)
1876	!-----
1877	do_again = .TRUE.
1878	!-----
1879	DO WHILE (do_again)
1880	!-----
1881	do_again = .FALSE.
1882	!-------
1883	!------ We find the 4 limits of the grid-box.
1884	!------ As we transform the resolution of the model into longitudes
1885	!------ and latitudes we do not have the problem of periodicity.
1886	!------ coslat is a help variable here !
1887	!-------
1888	coslat = MAX(COS(lalo(ib,1)pi/180.),mincos)pi/180.*R_Earth
1889	!-------
1890	lon_up = lalo(ib,2)+resx/(2.0*coslat)
1891	lon_low = lalo(ib,2)-resx/(2.0*coslat)
1892	!-------
1893	coslat = pi/180.*R_Earth
1894	!-------
1895	lat_up = lalo(ib,1)+resy/(2.0*coslat)
1896	lat_low = lalo(ib,1)-resy/(2.0*coslat)
1897	!-------
1898	!------ Find the grid boxes from the data that go into
1899	!------ the model's boxes.
1900	!------ We still work as if we had a regular grid !
1901	!------ Well it needs to be localy regular so that
1902	!------ the longitude at the latitude of the last found point
1903	!------ is close to the one of the next point.
1904	!-------
1905	fopt = 0
1906	lastjp = 1
1907	DO ip=1,iml
1908	!---------
1909	!-------- Either the center of the data grid point is in the interval
1910	!-------- of the model grid or the East and West limits of the data
1911	!-------- grid point are on either sides of the border of the data grid
1912	!---------
1913	IF ( lon_rel(ip,lastjp) > lon_low &
1914	& .AND. lon_rel(ip,lastjp) < lon_up &
1915	& .OR. lolow_rel(ip,lastjp) < lon_low &
1916	& .AND. loup_rel(ip,lastjp) > lon_low &
1917	& .OR. lolow_rel(ip,lastjp) < lon_up &
1918	& .AND. loup_rel(ip,lastjp) > lon_up ) THEN
1919	DO jp=1,jml
1920	!-------------
1921	!------------ Now that we have the longitude let us find the latitude
1922	!-------------
1923	IF ( lat_rel(ip,jp) > lat_low &
1924	& .AND. lat_rel(ip,jp) < lat_up &
1925	& .OR. lalow_rel(ip,jp) < lat_low &
1926	& .AND. laup_rel(ip,jp) > lat_low &
1927	& .OR. lalow_rel(ip,jp) < lat_up &
1928	& .AND. laup_rel(ip,jp) > lat_up) THEN
1929	lastjp = jp
1930	!---------------
1931	fopt = fopt + 1
1932	IF ( fopt > nbvmax) THEN
1933	WRITE(numout,*) &
1934	& 'Please increase nbvmax in subroutine get_reftemp',ib
1935	STOP
1936	ELSE
1937	!-----------------
1938	!---------------- Get the area of the fine grid in the model grid
1939	!-----------------
1940	coslat = MAX(COS(lat_rel(ip,jp)*pi/180.),mincos)
1941	ax = ( MIN(lon_up,loup_rel(ip,jp)) &
1942	& -MAX(lon_low,lolow_rel(ip,jp))) &
1943	& pi/180.R_Earth*coslat
1944	ay = ( MIN(lat_up,laup_rel(ip,jp)) &
1945	& -MAX(lat_low,lalow_rel(ip,jp))) &
1946	& pi/180.R_Earth
1947	area(fopt) = ax*ay
1948	tt(fopt) = tref_file(ip,jp)
1949	ENDIF
1950	ENDIF
1951	ENDDO
1952	ENDIF
1953	ENDDO
1954	!-------
1955	!------ Check that we found some points
1956	!-------
1957	trefe(ib) = zero
1958	!-------
1959	IF (fopt == 0) THEN
1960	do_again = .TRUE.
1961	!-------
1962	!------ increase search radius
1963	!-------
1964	resx = resx*2.
1965	resy = resy*2.
1966	IF ( resx > 2.piR_Earth .OR. resy > pi*R_Earth ) THEN
1967	STOP 'get_reftemp: found no point'
1968	ENDIF
1969	ELSE
1970	sgn = zero
1971	!-------
1972	!------ Compute the average surface air temperature
1973	!-------
1974	DO ilf=1,fopt
1975	trefe(ib) = trefe(ib) + tt(ilf) * area(ilf)
1976	sgn = sgn + area(ilf)
1977	ENDDO
1978	!-------
1979	!------ Normalize the surface
1980	!-------
1981	IF (sgn < min_sechiba) THEN
1982	do_again = .TRUE.
1983	!---------
1984	!-------- increase search radius
1985	!---------
1986	resx = resx * 2.
1987	resy = resy * 2.
1988	IF ( resx > 2.piR_Earth .OR. resy > pi*R_Earth ) THEN
1989	STOP 'get_reftemp: found no point'
1990	ENDIF
1991	ELSE
1992	trefe(ib) = trefe(ib) / sgn
1993	ENDIF
1994	ENDIF
1995	ENDDO
1996	ENDDO
1997	!-
1998	! transform into Kelvin
1999	!-
2000	trefe(:) = trefe(:) + ZeroCelsius
2001	!-
2002	! deallocate
2003	!-
2004	DEALLOCATE (lat_rel)
2005	DEALLOCATE (lon_rel)
2006	DEALLOCATE (laup_rel)
2007	DEALLOCATE (loup_rel)
2008	DEALLOCATE (lalow_rel)
2009	DEALLOCATE (lolow_rel)
2010	DEALLOCATE (lat_ful)
2011	DEALLOCATE (lon_ful)
2012	DEALLOCATE (tref_file)
2013	ENDIF
2014	!-
2015	! 2 output the reference temperature
2016	!-
2017	tref_out(:) = trefe(:)
2018	!-------------------------
2019	END SUBROUTINE get_reftemp
2020	!-
2021	!===
2022	!-
2023	END MODULE stomate_io

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

Download in other formats: