Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_io.f90 @ 64

Last change on this file since 64 was 64, checked in by didier.solyga, 13 years ago
Import first version of ORCHIDEE_EXT
File size: 84.3 KB

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

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

Download in other formats: