Context Navigation

source: perso/abdelouhab.djerrah/ORCHIDEEE/src_stomate/stomate_io.f90 @ 937

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

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

Download in other formats: