Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_sechiba/intersurf.f90 @ 311

Last change on this file since 311 was 311, checked in by didier.solyga, 13 years ago
Move and clean the rest of the externalized parameters from sechiba and stomate to src_parameters. Add two subroutines in constantes. Correct Olson type number 79 in vegcorr
File size: 278.3 KB

Line
1
2	!! This subroutine is the interface between the main program
3	!! (LMDZ or dim2_driver) and SECHIBA.
4	!! - Input fields are gathered to keep just continental points
5	!! - call sechiba_main That's SECHIBA process.
6	!! - Output fields are scattered to complete global fields
7	!!
8	!! @call sechiba_main
9	!! @Version : $Revision: 275 $, $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $
10	!!
11	!! @author Marie-Alice Foujols and Jan Polcher
12	!!
13	!< $HeadURL: http://forge.ipsl.jussieu.fr/orchidee/svn/trunk/ORCHIDEE/src_sechiba/intersurf.f90 $
14	!< $Date: 2011-06-21 15:28:18 +0200 (Tue, 21 Jun 2011) $
15	!< $Author: martial.mancip $
16	!< $Revision: 275 $
17	!! IPSL (2006)
18	!! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
19	!!
20	!f90doc MODULEintersurf
21	MODULE intersurf
22
23	USE IOIPSL
24
25	USE defprec
26	USE sechiba
27	USE constantes
28	USE pft_parameters
29	USE parallel
30	USE watchout
31	USE solar
32	USE grid
33	! USE Write_Field_p
34
35	IMPLICIT NONE
36
37	PRIVATE
38	PUBLIC :: intersurf_main, stom_define_history, intsurf_time
39
40	INTERFACE intersurf_main
41	MODULE PROCEDURE intersurf_main_2d, intersurf_main_1d, intersurf_gathered, intersurf_gathered_2m
42	END INTERFACE
43	!
44	! Global variables
45	!
46	INTEGER(i_std),PARAMETER :: max_hist_level = 11
47	!
48	LOGICAL, SAVE :: l_first_intersurf=.TRUE. !! Initialisation has to be done one time
49	!
50	INTEGER(i_std), SAVE :: hist_id, rest_id !! IDs for history and restart files
51	INTEGER(i_std), SAVE :: hist2_id !! ID for the second history files (Hi-frequency ?)
52	INTEGER(i_std), SAVE :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
53	REAL(r_std), SAVE :: dw !! frequency of history write (sec.)
54	!
55	INTEGER(i_std), SAVE :: itau_offset !! This offset is used to phase the
56	! !! calendar of the GCM or the driver.
57	REAL(r_std) :: date0_shifted
58	!
59	TYPE(control_type), SAVE :: control_flags !! Flags that (de)activate parts of the model
60	!
61	!
62	!! first day of this year
63	REAL(r_std) :: julian0
64	!
65	LOGICAL :: check_INPUTS = .FALSE. !! (very) long print of INPUTs in intersurf
66	LOGICAL, SAVE :: OFF_LINE_MODE = .FALSE.
67	!
68	!!$ DS : ajout du flag IMPOSE_PARAM
69	! Flag impos_param : it is set to true by default
70	LOGICAL, SAVE :: impose_param = .TRUE.
71	!
72	CONTAINS
73	!
74	!f90doc CONTAINS
75	!
76	SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
77	& lrestart_read, lrestart_write, lon, lat, zcontfrac, zneighbours, zresolution, date0, &
78	! First level conditions
79	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
80	! Variables for the implicit coupling
81	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
82	! Rain, snow, radiation and surface pressure
83	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
84	! Output : Fluxes
85	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
86	! Surface temperatures and surface properties
87	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
88
89	! routines called : sechiba_main
90	!
91	IMPLICIT NONE
92	!
93	! interface description for dummy arguments
94	! input scalar
95	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
96	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
97	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
98	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
99	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
100	LOGICAL, INTENT (in) :: lrestart_write!! Logical for _restart_ file to write'
101	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
102	! input fields
103	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
104	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
105	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
106	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
107	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
108	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
109	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
110	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
111	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
112	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
113	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
114	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
115	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
116	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
117	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
118	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
119	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
120	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
121	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Lowest level pressure
122	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
123	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
124	INTEGER, DIMENSION (iim,jjm,8), INTENT(in) :: zneighbours !! land neighbours
125	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
126	! output fields
127	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0 !! Surface roughness
128	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/dt)
129	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/dt)
130	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
131	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: vevapp !! Total of evaporation
132	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: temp_sol_new !! New soil temperature
133	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: qsurf !! Surface specific humidity
134	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out) :: albedo !! Albedo
135	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
136	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
137	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: emis !! Emissivity
138	! LOCAL declaration
139	! work arrays to scatter and/or gather information just before/after sechiba_main call's
140	! and to keep output value for next call
141	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
142	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
143	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
144	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
145	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
146	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
147	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
148	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
149	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
150	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
151	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
152	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
153	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
154	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
155	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
156	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
157	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
158	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
159	REAL(r_std),DIMENSION (kjpindex) :: zz0 !! Work array to keep z0
160	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastalflow
161	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep riverflow
162	REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastalflow
163	REAL(r_std),DIMENSION (kjpindex) :: driver !! Work array to keep riverflow
164	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
165	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
166	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
167	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
168	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
169	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
170	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
171	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
172	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
173	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
174	!
175	! Local variables with shape of the inputs
176	!
177	REAL(r_std),DIMENSION (iim,jjm) :: dswnet !! Net surface short-wave flux
178	REAL(r_std),DIMENSION (iim,jjm) :: dswdown !! Incident surface short-wave flux
179	!
180	INTEGER(i_std) :: i, j, ik
181	INTEGER(i_std) :: itau_sechiba
182	REAL(r_std) :: zlev_mean
183	LOGICAL :: do_watch !! if it's time, write watchout
184	INTEGER :: old_fileout !! old Logical Int for std IO output
185	LOGICAL :: check = .FALSE.
186	!
187	CALL ipslnlf(new_number=numout,old_number=old_fileout)
188	!
189	IF (l_first_intersurf) THEN
190	! CALL Init_WriteField_p(kindex)
191	!
192	CALL intsurf_time( kjit, date0, xrdt )
193	!
194	IF ( check ) WRITE(numout,*) 'Initialisation of intersurf_main_2d'
195	!
196	OFF_LINE_MODE = .TRUE.
197	!
198	DO ik=1,kjpindex
199
200	j = ((kindex(ik)-1)/iim) + 1
201	i = (kindex(ik) - (j-1)*iim)
202
203	!- Create the internal coordinate table
204	!-
205	lalo(ik,1) = lat(i,j)
206	lalo(ik,2) = lon(i,j)
207	!
208	!- Store the fraction of the continents only once so that the user
209	!- does not change them afterwards.
210	!-
211	contfrac(ik) = zcontfrac(i,j)
212	ENDDO
213	CALL gather(contfrac,contfrac_g)
214	CALL gather(lalo,lalo_g)
215	CALL gather2D(lon,lon_g)
216	CALL gather2D(lat,lat_g)
217	CALL gather2D(zlev,zlev_g)
218	!
219	! Configuration of SSL specific parameters
220	!
221	CALL intsurf_config(control_flags, xrdt)
222	!
223	CALL intsurf_restart(kjit, iim, jjm, lon, lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
224	itau_sechiba = kjit + itau_offset
225	!
226	CALL intsurf_history(iim, jjm, lon, lat, itau_sechiba, date0_shifted, xrdt, control_flags, hist_id, &
227	& hist2_id, hist_id_stom, hist_id_stom_IPCC)
228	!
229	IF ( ok_watchout ) THEN
230	IF (is_root_prc) THEN
231	zlev_mean = zero
232	DO ik=1, nbp_glo
233	j = ((index_g(ik)-1)/iim_g) + 1
234	i = (index_g(ik) - (j-1)*iim_g)
235
236	zlev_mean = zlev_mean + zlev_g(i,j)
237	ENDDO
238	zlev_mean = zlev_mean / REAL(nbp_glo,r_std)
239	ENDIF
240
241	last_action_watch = itau_sechiba
242	last_check_watch = last_action_watch
243
244	! Only root proc write watchout file
245	CALL watchout_init (iim_g, jjm_g, kjpindex, nbp_glo, &
246	& date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
247	ENDIF
248	!
249	IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
250	!
251	ENDIF
252	!
253	! Shift the time step to phase the two models
254	!
255	itau_sechiba = kjit + itau_offset
256	!
257	CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
258	!
259	! 1. gather input fields from kindex array
260	! Warning : I'm not sure this interface with one dimension array is the good one
261	!
262	DO ik=1, kjpindex
263
264	j = ((kindex(ik)-1)/iim) + 1
265	i = (kindex(ik) - (j-1)*iim)
266
267	zu(ik) = u(i,j)
268	zv(ik) = v(i,j)
269	zzlev(ik) = zlev(i,j)
270	zqair(ik) = qair(i,j)
271	zprecip_rain(ik) = precip_rain(i,j)*xrdt
272	zprecip_snow(ik) = precip_snow(i,j)*xrdt
273	zlwdown(ik) = lwdown(i,j)
274	zswnet(ik) = swnet(i,j)
275	zswdown(ik) = swdown(i,j)
276	ztemp_air(ik) = temp_air(i,j)
277	zepot_air(ik) = epot_air(i,j)
278	zccanopy(ik) = ccanopy(i,j)
279	zpetAcoef(ik) = petAcoef(i,j)
280	zpeqAcoef(ik) = peqAcoef(i,j)
281	zpetBcoef(ik) = petBcoef(i,j)
282	zpeqBcoef(ik) = peqBcoef(i,j)
283	zcdrag(ik) = cdrag(i,j)
284	zpb(ik) = pb(i,j)
285
286	ENDDO
287	!
288	IF (check_INPUTS) THEN
289	WRITE(numout,*) "Intersurf_main_2D :"
290	WRITE(numout,*) "Time step number = ",kjit
291	WRITE(numout,*) "Dimension of input fields = ",iim, jjm
292	WRITE(numout,*) "Number of continental points = ",kjpindex
293	WRITE(numout,*) "Time step in seconds = ",xrdt
294	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
295	WRITE(numout,*) "Date at which kjit = 0 = ",date0
296	WRITE(numout,*) "Index for continental points = ",kindex
297	WRITE(numout,*) "Lowest level wind speed North = ",zu
298	WRITE(numout,*) "Lowest level wind speed East = ",zv
299	WRITE(numout,*) "Height of first layer = ",zzlev
300	WRITE(numout,*) "Lowest level specific humidity = ",zqair
301	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
302	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
303	WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
304	WRITE(numout,*) "Net surface short-wave flux = ",zswnet
305	WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
306	WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
307	WRITE(numout,*) "Air potential energy = ",zepot_air
308	WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
309	WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
310	WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
311	WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
312	WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
313	WRITE(numout,*) "Cdrag = ",zcdrag
314	WRITE(numout,*) "Lowest level pressure = ",zpb
315	WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
316	WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
317	WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
318	ENDIF
319	!
320	! 2. save the grid
321	!
322	IF ( check ) WRITE(numout,*) 'Save the grid'
323	!
324	IF (l_first_intersurf) THEN
325	CALL histwrite(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
326	CALL histwrite(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
327	IF ( control_flags%ok_stomate ) THEN
328	CALL histwrite(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
329	IF ( hist_id_stom_IPCC > 0 ) THEN
330	CALL histwrite(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
331	ENDIF
332	ENDIF
333	CALL histwrite(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
334	CALL histsync(hist_id)
335	!
336	IF ( hist2_id > 0 ) THEN
337	CALL histwrite(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
338	CALL histwrite(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
339	CALL histwrite(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
340	CALL histsync(hist2_id)
341	ENDIF
342	!
343	ENDIF
344	!
345	! 3. call sechiba for continental points only
346	!
347	IF ( check ) WRITE(numout,*) 'Calling sechiba'
348	!
349	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
350	& lrestart_read, lrestart_write, control_flags, &
351	& lalo, contfrac, neighbours, resolution, &
352	! First level conditions
353	! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
354	! & zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
355	& zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
356	! Variables for the implicit coupling
357	& zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
358	! Rain, snow, radiation and surface pressure
359	& zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zpb, &
360	! Output : Fluxes
361	& zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
362	! Surface temperatures and surface properties
363	& ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
364	! File ids
365	& rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
366
367	!
368	IF ( check ) WRITE(numout,*) 'out of SECHIBA'
369	!
370	! 4. save watchout
371	!
372	IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
373	! Accumulate last time step
374	sum_zlev(:) = sum_zlev(:) + zzlev(:)
375	sum_u(:) = sum_u(:) + zu(:)
376	sum_v(:) = sum_v(:) + zv(:)
377	sum_qair(:) = sum_qair(:) + zqair(:)
378	sum_temp_air(:) = sum_temp_air(:) + ztemp_air(:)
379	sum_epot_air(:) = sum_epot_air(:) + zepot_air(:)
380	sum_ccanopy(:) = sum_ccanopy(:) + zccanopy(:)
381	sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
382	sum_petAcoef(:) = sum_petAcoef(:) + zpetAcoef(:)
383	sum_peqAcoef(:) = sum_peqAcoef(:) + zpeqAcoef(:)
384	sum_petBcoef(:) = sum_petBcoef(:) + zpetBcoef(:)
385	sum_peqBcoef(:) = sum_peqBcoef(:) + zpeqBcoef(:)
386	sum_rain(:) = sum_rain(:) + zprecip_rain(:)
387	sum_snow(:) = sum_snow(:) + zprecip_snow(:)
388	sum_lwdown(:) = sum_lwdown(:) + zlwdown(:)
389	sum_pb(:) = sum_pb(:) + zpb(:)
390
391	!!$ IF ( dt_watch > 3600 ) THEN
392	!!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
393	!!$ WRITE(numout, *) "WATCH register : julian_watch ",julian_watch, " julian0",julian0,"date0_shifted ",date0_shifted, &
394	!!$ "itau_sechiba ",itau_sechiba, &
395	!!$ dt_split_watch,dt_watch,one_day
396	!!$ CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang)
397	!!$ WHERE ( sinang(:,:) .LT. EPSILON(un) )
398	!!$ isinang(:,:) = isinang(:,:) - 1
399	!!$ ENDWHERE
400	!!$ mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
401	!!$ WRITE(numout, *) "WATCH sinang : ",sinang, mean_sinang
402	!!$ WRITE(numout,*) "sum_swdown",sum_swdown
403	!!$ !
404	!!$ DO ik=1,kjpindex
405	!!$ j = ((kindex(ik)-1)/iim) + 1
406	!!$ i = (kindex(ik) - (j-1)*iim)
407	!!$
408	!!$ sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*zswnet(ik)
409	!!$ sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*zswdown(ik)
410	!!$ ENDDO
411	!!$ ELSE
412	sum_swnet(:) = sum_swnet(:) + zswnet(:)
413	sum_swdown(:) = sum_swdown(:) + zswdown(:)
414	!!$ ENDIF
415
416	do_watch = .FALSE.
417	call isittime &
418	& (itau_sechiba,date0_shifted,xrdt,dt_watch,&
419	& last_action_watch,last_check_watch,do_watch)
420	last_check_watch = itau_sechiba
421	IF (do_watch) THEN
422	!
423	IF ( check ) WRITE(numout,*) 'save watchout'
424	!
425	IF (long_print) THEN
426	WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba,&
427	& last_action_watch, last_check_watch
428	ENDIF
429	last_action_watch = itau_sechiba
430
431	sum_zlev(:) = sum_zlev(:) / dt_split_watch
432	sum_u(:) = sum_u(:) / dt_split_watch
433	sum_v(:) = sum_v(:) / dt_split_watch
434	sum_qair(:) = sum_qair(:) / dt_split_watch
435	sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
436	sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
437	sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
438	sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
439	sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
440	sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
441	sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
442	sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
443	sum_rain(:) = sum_rain(:) / dt_split_watch
444	sum_snow(:) = sum_snow(:) / dt_split_watch
445	sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
446	sum_pb(:) = sum_pb(:) / dt_split_watch
447
448	!!$ IF ( dt_watch > 3600 ) THEN
449	!!$ WRITE(numout, *) "WATCH mean_sinang before norm : ",mean_sinang,isinang
450	!!$ WHERE ( isinang(:,:) .LT. dt_split_watch )
451	!!$ mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
452	!!$ ENDWHERE
453	!!$ WRITE(numout, *) "WATCH mean_sinang norm : ",mean_sinang
454	!!$ WRITE(numout,*) "SWDOWN 0 : ",sum_swdown(:)
455	!!$ !
456	!!$ DO ik=1,kjpindex
457	!!$ j = ((kindex(ik)-1)/iim) + 1
458	!!$ i = (kindex(ik) - (j-1)*iim)
459	!!$ IF (mean_sinang(i,j) > zero) THEN
460	!!$ sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
461	!!$ sum_swnet(ik) = sum_swnet(ik)/mean_sinang(i,j)
462	!!$ ELSE
463	!!$ sum_swdown(ik) = zero
464	!!$ sum_swnet(ik) = zero
465	!!$ ENDIF
466	!!$ ENDDO
467	!!$ ELSE
468	sum_swnet(:) = sum_swnet(:) / dt_split_watch
469	sum_swdown(:) = sum_swdown(:) / dt_split_watch
470	!!$ ENDIF
471
472	CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
473	& sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
474	& sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
475	& sum_cdrag, sum_ccanopy )
476	ENDIF
477	ENDIF
478	!
479	! 5. scatter output fields
480	!
481	z0(:,:) = undef_sechiba
482	coastalflow(:,:) = undef_sechiba
483	riverflow(:,:) = undef_sechiba
484	tsol_rad(:,:) = undef_sechiba
485	vevapp(:,:) = undef_sechiba
486	temp_sol_new(:,:) = undef_sechiba
487	qsurf(:,:) = undef_sechiba
488	albedo(:,:,:) = undef_sechiba
489	fluxsens(:,:) = undef_sechiba
490	fluxlat(:,:) = undef_sechiba
491	emis(:,:) = undef_sechiba
492	cdrag(:,:) = undef_sechiba
493	dswnet(:,:) = undef_sechiba
494	dswdown(:,:) = undef_sechiba
495	!
496	DO ik=1, kjpindex
497
498
499	j = ((kindex(ik)-1)/iim) + 1
500	i = (kindex(ik) - (j-1)*iim)
501
502	z0(i,j) = zz0(ik)
503	coastalflow(i,j) = zcoastal(ik)/1000.
504	riverflow(i,j) = zriver(ik)/1000.
505	tsol_rad(i,j) = ztsol_rad(ik)
506	vevapp(i,j) = zvevapp(ik)
507	temp_sol_new(i,j) = ztemp_sol_new(ik)
508	qsurf(i,j) = zqsurf(ik)
509	albedo(i,j,1) = zalbedo(ik,1)
510	albedo(i,j,2) = zalbedo(ik,2)
511	fluxsens(i,j) = zfluxsens(ik)
512	fluxlat(i,j) = zfluxlat(ik)
513	emis(i,j) = zemis(ik)
514	cdrag(i,j) = zcdrag(ik)
515	dswnet(i,j) = zswnet(ik)
516	dswdown(i,j) = zswdown(ik)
517
518	ENDDO
519	!
520	! Modified fields for variables scattered during the writing
521	!
522	dcoastal(:) = (zcoastal(:))/1000.
523	driver(:) = (zriver(:))/1000.
524	!
525	IF ( .NOT. l_first_intersurf) THEN
526	!
527	IF ( .NOT. almaoutput ) THEN
528	!
529	! scattered during the writing
530	!
531	CALL histwrite (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
532	CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
533	CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
534	!
535	CALL histwrite (hist_id, 'temp_sol', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
536	CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
537	CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
538	CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
539	CALL histwrite (hist_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex)
540	CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, kjpindex, kindex)
541	CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, kjpindex, kindex)
542	CALL histwrite (hist_id, 'alb_vis', itau_sechiba, albedo(:,:,1), kjpindex, kindex)
543	CALL histwrite (hist_id, 'alb_nir', itau_sechiba, albedo(:,:,2), kjpindex, kindex)
544	CALL histwrite (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
545	CALL histwrite (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
546	! Ajout Nathalie - Juin 2006 - on conserve q2m/t2m
547	CALL histwrite (hist_id, 'q2m', itau_sechiba, qair, kjpindex, kindex)
548	CALL histwrite (hist_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex)
549	IF ( hist2_id > 0 ) THEN
550	CALL histwrite (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
551	CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
552	CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
553	!
554	CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
555	CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
556	CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
557	CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
558	CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex)
559	CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, kjpindex, kindex)
560	CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, kjpindex, kindex)
561	CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, albedo(:,:,1), kjpindex, kindex)
562	CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, albedo(:,:,2), kjpindex, kindex)
563	CALL histwrite (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
564	CALL histwrite (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
565	CALL histwrite (hist2_id, 'q2m', itau_sechiba, qair, kjpindex, kindex)
566	CALL histwrite (hist2_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex)
567	ENDIF
568	ELSE
569	CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
570	CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, kjpindex, kindex)
571	CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
572	CALL histwrite (hist_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex)
573	CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
574	CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
575	IF ( hist2_id > 0 ) THEN
576	CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
577	CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, kjpindex, kindex)
578	CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
579	CALL histwrite (hist2_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex)
580	CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
581	CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, kjpindex, kindex)
582	ENDIF
583	ENDIF
584	!
585	IF (dw .EQ. xrdt) THEN
586	CALL histsync(hist_id)
587	ENDIF
588	!
589	ENDIF
590	!
591	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
592	!
593	DO ik=1, kjpindex
594
595	j = ((kindex(ik)-1)/iim) + 1
596	i = (kindex(ik) - (j-1)*iim)
597
598	vevapp(i,j) = vevapp(i,j)/xrdt
599	coastalflow(i,j) = coastalflow(i,j)/xrdt
600	riverflow(i,j) = riverflow(i,j)/xrdt
601
602	ENDDO
603	!
604	IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN
605	CALL watchout_close()
606	ENDIF
607	!
608	IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
609	l_first_intersurf = .FALSE.
610	!
611	IF (long_print) WRITE (numout,*) ' intersurf_main done '
612	!
613	CALL ipslnlf(new_number=old_fileout)
614	!
615	END SUBROUTINE intersurf_main_2d
616	!
617	SUBROUTINE intersurf_main_1d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
618	& lrestart_read, lrestart_write, lon, lat, zcontfrac, zneighbours, zresolution, date0, &
619	! First level conditions
620	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
621	! Variables for the implicit coupling
622	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
623	! Rain, snow, radiation and surface pressure
624	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
625	! Output : Fluxes
626	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
627	! Surface temperatures and surface properties
628	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
629
630	! routines called : sechiba_main
631	!
632	IMPLICIT NONE
633	!
634	! interface description for dummy arguments
635	! input scalar
636	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
637	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
638	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
639	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
640	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
641	LOGICAL, INTENT (in) :: lrestart_write!! Logical for _restart_ file to write'
642	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
643	! input fields
644	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
645	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: u !! Lowest level wind speed
646	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: v !! Lowest level wind speed
647	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: zlev !! Height of first layer
648	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: qair !! Lowest level specific humidity
649	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: precip_rain !! Rain precipitation
650	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: precip_snow !! Snow precipitation
651	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
652	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: swnet !! Net surface short-wave flux
653	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
654	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
655	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: epot_air !! Air potential energy
656	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
657	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
658	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: peqAcoef !! One for T and another for q
659	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
660	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: peqBcoef !! One for T and another for q
661	REAL(r_std),DIMENSION (iim*jjm), INTENT(inout) :: cdrag !! Cdrag
662	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: pb !! Lowest level pressure
663	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: lon, lat !! Geographical coordinates
664	REAL(r_std),DIMENSION (iim*jjm), INTENT(in) :: zcontfrac !! Fraction of continent
665	INTEGER, DIMENSION (iim*jjm,8), INTENT(in) :: zneighbours !! land neighbours
666	REAL(r_std),DIMENSION (iim*jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
667	! output fields
668	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: z0 !! Surface roughness
669	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/dt)
670	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/dt)
671	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
672	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: vevapp !! Total of evaporation
673	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: temp_sol_new !! New soil temperature
674	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: qsurf !! Surface specific humidity
675	REAL(r_std),DIMENSION (iim*jjm,2), INTENT(out) :: albedo !! Albedo
676	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
677	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
678	REAL(r_std),DIMENSION (iim*jjm), INTENT(out) :: emis !! Emissivity
679	! LOCAL declaration
680	! work arrays to scatter and/or gather information just before/after sechiba_main call's
681	! and to keep output value for next call
682	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
683	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
684	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
685	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
686	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
687	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
688	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
689	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
690	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
691	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
692	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
693	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
694	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
695	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
696	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
697	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
698	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
699	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
700	REAL(r_std),DIMENSION (kjpindex) :: zz0 !! Work array to keep z0
701	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
702	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
703	REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow
704	REAL(r_std),DIMENSION (kjpindex) :: driver !! Work array to keep river out flow
705	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
706	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
707	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
708	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
709	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
710	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
711	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
712	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
713	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
714	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
715	!
716	! Local but with input shape
717	!
718	REAL(r_std),DIMENSION (iim*jjm) :: dswnet !! Net surface short-wave flux
719	REAL(r_std),DIMENSION (iim*jjm) :: dswdown !! Incident surface short-wave flux
720	!
721	INTEGER(i_std) :: i, j, ik
722	INTEGER(i_std) :: itau_sechiba
723	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon, tmp_lat, tmp_lev
724	REAL(r_std) :: zlev_mean
725	LOGICAL :: do_watch !! if it's time, write watchout
726	INTEGER :: old_fileout !! old Logical Int for std IO output
727	LOGICAL :: check = .FALSE.
728	!
729	CALL ipslnlf(new_number=numout,old_number=old_fileout)
730	!
731	IF (l_first_intersurf) THEN
732	!
733	CALL intsurf_time( kjit, date0, xrdt )
734	!
735	IF ( check ) WRITE(numout,*) 'Initialisation of intersurf_main_1d'
736	!
737	OFF_LINE_MODE = .TRUE.
738	!
739	! Create the internal coordinate table
740	!
741	IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
742	ALLOCATE(tmp_lon(iim,jjm))
743	ENDIF
744	IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
745	ALLOCATE(tmp_lat(iim,jjm))
746	ENDIF
747	IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
748	ALLOCATE(tmp_lev(iim,jjm))
749	ENDIF
750	!
751	DO i=1,iim
752	DO j=1,jjm
753	ik = (j-1)*iim + i
754	tmp_lon(i,j) = lon(ik)
755	tmp_lat(i,j) = lat(ik)
756	tmp_lev(i,j) = zlev(kindex(ik))
757	ENDDO
758	ENDDO
759	!
760	lalo(:,1) = lat(:)
761	lalo(:,2) = lon(:)
762	!
763	!- Store the fraction of the continents only once so that the user
764	!- does not change them afterwards.
765	!
766	DO ik=1,kjpindex
767
768	contfrac(ik) = zcontfrac(kindex(ik))
769
770	ENDDO
771	contfrac_g(:) = contfrac(:)
772	lalo_g(:,:) = lalo(:,:)
773	lon_g(:,:) = tmp_lon(:,:)
774	lat_g(:,:) = tmp_lat(:,:)
775	zlev_g(:,:) = tmp_lev(:,:)
776	!
777	! Configuration of SSL specific parameters
778	!
779	CALL intsurf_config(control_flags, xrdt)
780	!
781	CALL intsurf_restart(kjit, iim, jjm, tmp_lon, tmp_lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
782	itau_sechiba = kjit + itau_offset
783	!
784	CALL intsurf_history(iim, jjm, tmp_lon, tmp_lat, itau_sechiba, date0_shifted, xrdt, control_flags, hist_id, &
785	& hist2_id, hist_id_stom, hist_id_stom_IPCC)
786	!
787	IF ( ok_watchout ) THEN
788	zlev_mean = zero
789	DO ik=1, kjpindex
790
791	zlev_mean = zlev_mean + zlev(ik)
792	ENDDO
793	! Divide by one
794	zlev_mean = zlev_mean / REAL(kjpindex,r_std)
795
796	last_action_watch = itau_sechiba
797	last_check_watch = last_action_watch
798
799	CALL watchout_init(iim, jjm, kjpindex, kjpindex, &
800	& date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
801	ENDIF
802	!
803	IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
804	!
805	ENDIF
806	!
807	! Shift the time step to phase the two models
808	!
809	itau_sechiba = kjit + itau_offset
810	!
811	CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
812	!
813	! 1. gather input fields from kindex array
814	!
815	DO ik=1, kjpindex
816
817	zu(ik) = u(kindex(ik))
818	zv(ik) = v(kindex(ik))
819	zzlev(ik) = zlev(kindex(ik))
820	zqair(ik) = qair(kindex(ik))
821	zprecip_rain(ik) = precip_rain(kindex(ik))*xrdt
822	zprecip_snow(ik) = precip_snow(kindex(ik))*xrdt
823	zlwdown(ik) = lwdown(kindex(ik))
824	zswnet(ik) = swnet(kindex(ik))
825	zswdown(ik) = swdown(kindex(ik))
826	ztemp_air(ik) = temp_air(kindex(ik))
827	zepot_air(ik) = epot_air(kindex(ik))
828	zccanopy(ik) = ccanopy(kindex(ik))
829	zpetAcoef(ik) = petAcoef(kindex(ik))
830	zpeqAcoef(ik) = peqAcoef(kindex(ik))
831	zpetBcoef(ik) = petBcoef(kindex(ik))
832	zpeqBcoef(ik) = peqBcoef(kindex(ik))
833	zcdrag(ik) = cdrag(kindex(ik))
834	zpb(ik) = pb(kindex(ik))
835
836	ENDDO
837	!
838	! 2. save the grid
839	!
840	IF ( check ) WRITE(numout,*) 'Save the grid'
841	!
842	IF (l_first_intersurf) THEN
843	!
844	CALL histwrite(hist_id, 'LandPoints', itau_sechiba+1, (/ REAL(kindex) /), kjpindex, kindex)
845	CALL histwrite(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
846	IF ( control_flags%ok_stomate ) THEN
847	CALL histwrite(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
848	IF ( hist_id_stom_IPCC > 0 ) THEN
849	CALL histwrite(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
850	ENDIF
851	ENDIF
852	CALL histwrite(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
853	CALL histsync(hist_id)
854	!
855	IF ( hist2_id > 0 ) THEN
856	CALL histwrite(hist2_id, 'LandPoints', itau_sechiba+1, (/ REAL(kindex) /), kjpindex, kindex)
857	CALL histwrite(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
858	CALL histwrite(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
859	CALL histsync(hist2_id)
860	ENDIF
861	!
862	ENDIF
863	!
864	! 3. call sechiba
865	!
866	IF ( check ) WRITE(numout,*) 'Calling sechiba'
867	!
868	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
869	& lrestart_read, lrestart_write, control_flags, &
870	& lalo, contfrac, neighbours, resolution, &
871	! First level conditions
872	! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
873	! & zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
874	& zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
875	! Variables for the implicit coupling
876	& zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
877	! Rain, snow, radiation and surface pressure
878	& zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zpb, &
879	! Output : Fluxes
880	& zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
881	! Surface temperatures and surface properties
882	& ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
883	! File ids
884	& rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
885
886	!
887	IF ( check ) WRITE(numout,*) 'out of SECHIBA'
888	!
889	! 4. save watchout
890	!
891	IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
892	! Accumulate last time step
893	sum_zlev(:) = sum_zlev(:) + zzlev(:)
894	sum_u(:) = sum_u(:) + zu(:)
895	sum_v(:) = sum_v(:) + zv(:)
896	sum_qair(:) = sum_qair(:) + zqair(:)
897	sum_temp_air(:) = sum_temp_air(:) + ztemp_air(:)
898	sum_epot_air(:) = sum_epot_air(:) + zepot_air(:)
899	sum_ccanopy(:) = sum_ccanopy(:) + zccanopy(:)
900	sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
901	sum_petAcoef(:) = sum_petAcoef(:) + zpetAcoef(:)
902	sum_peqAcoef(:) = sum_peqAcoef(:) + zpeqAcoef(:)
903	sum_petBcoef(:) = sum_petBcoef(:) + zpetBcoef(:)
904	sum_peqBcoef(:) = sum_peqBcoef(:) + zpeqBcoef(:)
905	sum_rain(:) = sum_rain(:) + zprecip_rain(:)
906	sum_snow(:) = sum_snow(:) + zprecip_snow(:)
907	sum_lwdown(:) = sum_lwdown(:) + zlwdown(:)
908	sum_pb(:) = sum_pb(:) + zpb(:)
909
910	!!$ IF ( dt_watch > 3600 ) THEN
911	!!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
912	!!$ CALL solarang (julian_watch, julian0, iim, jjm, lon, lat, sinang)
913	!!$ WHERE ( sinang(:,:) .LT. EPSILON(un) )
914	!!$ isinang(:,:) = isinang(:,:) - 1
915	!!$ ENDWHERE
916	!!$ mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
917	!!$ !
918	!!$ DO ik=1,kjpindex
919	!!$ j = ((kindex(ik)-1)/iim) + 1
920	!!$ i = (kindex(ik) - (j-1)*iim)
921	!!$
922	!!$ sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*zswnet(ik)
923	!!$ sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*zswdown(ik)
924	!!$ ENDDO
925	!!$ ELSE
926	sum_swnet(:) = sum_swnet(:) + zswnet(:)
927	sum_swdown(:) = sum_swdown(:) + zswdown(:)
928	!!$ ENDIF
929
930	do_watch = .FALSE.
931	call isittime &
932	& (itau_sechiba,date0_shifted,xrdt,dt_watch,&
933	& last_action_watch,last_check_watch,do_watch)
934	last_check_watch = itau_sechiba
935	IF (do_watch) THEN
936	!
937	IF ( check ) WRITE(numout,*) 'save watchout'
938	!
939	IF (long_print) THEN
940	WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba,&
941	& last_action_watch, last_check_watch
942	ENDIF
943	last_action_watch = itau_sechiba
944
945	sum_zlev(:) = sum_zlev(:) / dt_split_watch
946	sum_u(:) = sum_u(:) / dt_split_watch
947	sum_v(:) = sum_v(:) / dt_split_watch
948	sum_qair(:) = sum_qair(:) / dt_split_watch
949	sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
950	sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
951	sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
952	sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
953	sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
954	sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
955	sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
956	sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
957	sum_rain(:) = sum_rain(:) / dt_split_watch
958	sum_snow(:) = sum_snow(:) / dt_split_watch
959	sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
960	sum_pb(:) = sum_pb(:) / dt_split_watch
961
962	!!$ IF ( dt_watch > 3600 ) THEN
963	!!$ WHERE ( isinang(:,:) .GT. 0 )
964	!!$ mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
965	!!$ ENDWHERE
966	!!$ !
967	!!$ DO ik=1,kjpindex
968	!!$ j = ((kindex(ik)-1)/iim) + 1
969	!!$ i = (kindex(ik) - (j-1)*iim)
970	!!$ IF (mean_sinang(i,j) > zero) THEN
971	!!$ sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
972	!!$ sum_swnet(ik) = sum_swnet(ik)/mean_sinang(i,j)
973	!!$ ELSE
974	!!$ sum_swdown(ik) = zero
975	!!$ sum_swnet(ik) = zero
976	!!$ ENDIF
977	!!$ ENDDO
978	!!$ ELSE
979	sum_swnet(:) = sum_swnet(:) / dt_split_watch
980	sum_swdown(:) = sum_swdown(:) / dt_split_watch
981	!!$ ENDIF
982
983	CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
984	& sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
985	& sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
986	& sum_cdrag, sum_ccanopy )
987	ENDIF
988	ENDIF
989	!
990	! 5. scatter output fields
991	!
992	!
993	z0(:) = undef_sechiba
994	coastalflow(:) = undef_sechiba
995	riverflow(:) = undef_sechiba
996	tsol_rad(:) = undef_sechiba
997	vevapp(:) = undef_sechiba
998	temp_sol_new(:) = undef_sechiba
999	qsurf(:) = undef_sechiba
1000	albedo(:,:) = undef_sechiba
1001	fluxsens(:) = undef_sechiba
1002	fluxlat(:) = undef_sechiba
1003	emis(:) = undef_sechiba
1004	cdrag(:) = undef_sechiba
1005	dswnet(:) = undef_sechiba
1006	dswdown(:) = undef_sechiba
1007	!
1008	DO ik=1, kjpindex
1009
1010	z0(kindex(ik)) = zz0(ik)
1011	coastalflow(kindex(ik)) = zcoastal(ik)/1000.
1012	riverflow(kindex(ik)) = zriver(ik)/1000.
1013	tsol_rad(kindex(ik)) = ztsol_rad(ik)
1014	vevapp(kindex(ik)) = zvevapp(ik)
1015	temp_sol_new(kindex(ik)) = ztemp_sol_new(ik)
1016	qsurf(kindex(ik)) = zqsurf(ik)
1017	albedo(kindex(ik),1) = zalbedo(ik,1)
1018	albedo(kindex(ik),2) = zalbedo(ik,2)
1019	fluxsens(kindex(ik)) = zfluxsens(ik)
1020	fluxlat(kindex(ik)) = zfluxlat(ik)
1021	emis(kindex(ik)) = zemis(ik)
1022	cdrag(kindex(ik)) = zcdrag(ik)
1023	dswnet(kindex(ik)) = zswnet(ik)
1024	dswdown(kindex(ik)) = zswdown(ik)
1025
1026	ENDDO
1027	!
1028	! Modified fields for variables scattered during the writing
1029	!
1030	dcoastal(:) = (zcoastal(:))/1000.
1031	driver(:) = (zriver(:))/1000.
1032	!
1033	IF ( .NOT. l_first_intersurf) THEN
1034	!
1035	IF ( .NOT. almaoutput ) THEN
1036	!
1037	! scattered during the writing
1038	!
1039	CALL histwrite (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1040	CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
1041	CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
1042	!
1043	CALL histwrite (hist_id, 'temp_sol', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1044	CALL histwrite (hist_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1045	CALL histwrite (hist_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1046	CALL histwrite (hist_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)
1047	CALL histwrite (hist_id, 'fluxlat', itau_sechiba, fluxlat, iim*jjm, kindex)
1048	CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
1049	CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
1050	CALL histwrite (hist_id, 'alb_vis', itau_sechiba, albedo(:,1), iim*jjm, kindex)
1051	CALL histwrite (hist_id, 'alb_nir', itau_sechiba, albedo(:,2), iim*jjm, kindex)
1052	CALL histwrite (hist_id, 'tair', itau_sechiba, temp_air, iim*jjm, kindex)
1053	CALL histwrite (hist_id, 'qair', itau_sechiba, qair, iim*jjm, kindex)
1054	! Ajouts Nathalie - Juin 2006 - sauvegarde de t2m et q2m
1055	CALL histwrite (hist_id, 'q2m', itau_sechiba, qair, iim*jjm, kindex)
1056	CALL histwrite (hist_id, 't2m', itau_sechiba, temp_air, iim*jjm, kindex)
1057	IF ( hist2_id > 0 ) THEN
1058	CALL histwrite (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1059	CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
1060	CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
1061	!
1062	CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1063	CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1064	CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1065	CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, fluxsens, iim*jjm, kindex)
1066	CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, fluxlat, iim*jjm, kindex)
1067	CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
1068	CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
1069	CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, albedo(:,1), iim*jjm, kindex)
1070	CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, albedo(:,2), iim*jjm, kindex)
1071	CALL histwrite (hist2_id, 'tair', itau_sechiba, temp_air, iim*jjm, kindex)
1072	CALL histwrite (hist2_id, 'qair', itau_sechiba, qair, iim*jjm, kindex)
1073	CALL histwrite (hist2_id, 'q2m', itau_sechiba, qair, iim*jjm, kindex)
1074	CALL histwrite (hist2_id, 't2m', itau_sechiba, temp_air, iim*jjm, kindex)
1075	ENDIF
1076	ELSE
1077	CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1078	CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
1079	CALL histwrite (hist_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)
1080	CALL histwrite (hist_id, 'Qle', itau_sechiba, fluxlat, iim*jjm, kindex)
1081	CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1082	CALL histwrite (hist_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1083	IF ( hist2_id > 0 ) THEN
1084	CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1085	CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
1086	CALL histwrite (hist2_id, 'Qh', itau_sechiba, fluxsens, iim*jjm, kindex)
1087	CALL histwrite (hist2_id, 'Qle', itau_sechiba, fluxlat, iim*jjm, kindex)
1088	CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1089	CALL histwrite (hist2_id, 'RadT', itau_sechiba, temp_sol_NEW, iim*jjm, kindex)
1090	ENDIF
1091	ENDIF
1092	!
1093	IF (dw .EQ. xrdt) THEN
1094	CALL histsync(hist_id)
1095	ENDIF
1096	!
1097	ENDIF
1098	!
1099	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
1100	!
1101	DO ik=1, kjpindex
1102
1103	vevapp(kindex(ik)) = vevapp(kindex(ik))/xrdt
1104	coastalflow(kindex(ik)) = coastalflow(kindex(ik))/xrdt
1105	riverflow(kindex(ik)) = riverflow(kindex(ik))/xrdt
1106
1107	ENDDO
1108	!
1109	IF ( lrestart_write .AND. ok_watchout ) THEN
1110	CALL watchout_close()
1111	ENDIF
1112	!
1113	IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
1114	l_first_intersurf = .FALSE.
1115	!
1116	IF (long_print) WRITE (numout,*) ' intersurf_main done '
1117	!
1118	CALL ipslnlf(new_number=old_fileout)
1119	!
1120	END SUBROUTINE intersurf_main_1d
1121	!
1122	!-------------------------------------------------------------------------------------
1123	!
1124	#ifdef CPP_PARA
1125	SUBROUTINE intersurf_gathered (kjit, iim_glo, jjm_glo, offset, kjpindex, kindex, communicator, xrdt, &
1126	& lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1127	! First level conditions
1128	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1129	! Variables for the implicit coupling
1130	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1131	! Rain, snow, radiation and surface pressure
1132	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1133	! Output : Fluxes
1134	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
1135	! Surface temperatures and surface properties
1136	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g)
1137	#else
1138	SUBROUTINE intersurf_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1139	& lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1140	! First level conditions
1141	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1142	! Variables for the implicit coupling
1143	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1144	! Rain, snow, radiation and surface pressure
1145	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1146	! Output : Fluxes
1147	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
1148	! Surface temperatures and surface properties
1149	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g)
1150	#endif
1151	! routines called : sechiba_main
1152	!
1153	IMPLICIT NONE
1154	!
1155	! interface description for dummy arguments
1156	! input scalar
1157	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
1158	INTEGER(i_std),INTENT (in) :: iim_glo, jjm_glo !! Dimension of global fields
1159	#ifdef CPP_PARA
1160	INTEGER(i_std),INTENT (in) :: offset !! offset between the first global 2D point
1161	!! and the first local 2D point.
1162	INTEGER(i_std),INTENT(IN) :: communicator !! Orchidee communicator
1163	#endif
1164	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
1165	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
1166	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
1167	LOGICAL, INTENT (in) :: lrestart_write!! Logical for _restart_ file to write'
1168	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
1169	! input fields
1170	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
1171	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
1172	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
1173	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
1174	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
1175	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
1176	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
1177	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
1178	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
1179	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
1180	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
1181	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
1182	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
1183	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
1184	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
1185	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
1186	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
1187	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
1188	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Lowest level pressure
1189	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: latlon !! Geographical coordinates
1190	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
1191	INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in) :: zneighbours !! neighbours
1192	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
1193	! output fields
1194	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0 !! Surface roughness
1195	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/dt)
1196	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/dt)
1197	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
1198	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
1199	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
1200	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
1201	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
1202	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
1203	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
1204	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
1205	! LOCAL declaration
1206	! work arrays to scatter and/or gather information just before/after sechiba_main call's
1207	! and to keep output value for next call
1208	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
1209	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
1210	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
1211	REAL(r_std),DIMENSION (kjpindex) :: zz0 !! Work array to keep z0
1212	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
1213	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
1214	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
1215	REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow
1216	REAL(r_std),DIMENSION (kjpindex) :: driver !! Work array to keep river out flow
1217	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
1218	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
1219	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
1220	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
1221	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
1222	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
1223	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
1224	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
1225	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
1226	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
1227	!
1228	! Optional arguments
1229	!
1230	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN), OPTIONAL :: lon_scat_g, lat_scat_g !! The scattered values for longitude
1231	!
1232	INTEGER(i_std) :: iim,jjm !! local sizes
1233	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lon_scat, lat_scat !! The scattered values for longitude
1234	! !! and latitude.
1235	!
1236	! Scattered variables for diagnostics
1237	!
1238	! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dvevapp !! Diagnostic array for evaporation
1239	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dtemp_sol !! for surface temperature
1240	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dfluxsens !! for sensible heat flux
1241	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dfluxlat !! for latent heat flux
1242	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dswnet !! net solar radiation
1243	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dswdown !! Incident solar radiation
1244	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:,:) :: dalbedo !! albedo
1245	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dtair !! air temperature
1246	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dqair !! specific air humidity
1247	!
1248	!
1249	INTEGER(i_std) :: i, j, ik
1250	INTEGER(i_std) :: itau_sechiba
1251	REAL(r_std) :: mx, zlev_mean
1252	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon, tmp_lat, tmp_lev
1253	LOGICAL :: do_watch !! if it's time, write watchout
1254	INTEGER :: old_fileout !! old Logical Int for std IO output
1255	LOGICAL :: check = .FALSE.
1256	INTEGER(i_std),DIMENSION (kjpindex) :: kindex_p
1257	!
1258	LOGICAL, SAVE :: fatmco2 !! Flag to force the value of atmospheric CO2 for vegetation.
1259	REAL(r_std), SAVE :: atmco2 !! atmospheric CO2
1260	!
1261	CALL ipslnlf(old_number=old_fileout)
1262	!
1263	IF (l_first_intersurf) THEN
1264	!
1265	CALL intsurf_time( kjit, date0, xrdt )
1266	!
1267	IF ( check ) WRITE(numout,*) 'Initialisation of intersurf'
1268	!
1269	CALL ioget_calendar (one_year, one_day)
1270	!
1271	#ifdef CPP_PARA
1272	CALL init_para(.TRUE.,communicator)
1273	kindex_p(:)=kindex(:) + offset
1274	#else
1275	CALL init_para(.FALSE.)
1276	kindex_p(:)=kindex(:)
1277	#endif
1278	CALL ipslnlf(new_number=numout)
1279	!
1280	CALL init_data_para(iim_glo,jjm_glo,kjpindex,kindex_p)
1281	iim=iim_glo
1282	jjm=jj_nb
1283	ALLOCATE(lon_scat(iim,jjm))
1284	ALLOCATE(lat_scat(iim,jjm))
1285	! ALLOCATE(dvevapp(iim*jjm))
1286	ALLOCATE(dtemp_sol(iim*jjm))
1287	ALLOCATE(dfluxsens(iim*jjm))
1288	ALLOCATE(dfluxlat(iim*jjm))
1289	ALLOCATE(dswnet(iim*jjm))
1290	ALLOCATE(dswdown(iim*jjm))
1291	ALLOCATE(dalbedo(iim*jjm,2))
1292	ALLOCATE(dtair(iim*jjm))
1293	ALLOCATE(dqair(iim*jjm))
1294
1295	! CALL init_WriteField_p(kindex)
1296	!
1297	! Allocation of grid variables
1298	!
1299	CALL init_grid ( kjpindex )
1300	!
1301	! Create the internal coordinate table
1302	!
1303	lalo(:,:) = latlon(:,:)
1304	CALL gather(lalo,lalo_g)
1305	!
1306	!-
1307	!- Store variable to help describe the grid
1308	!- once the points are gathered.
1309	!-
1310	neighbours(:,:) = zneighbours(:,:)
1311	CALL gather(neighbours,neighbours_g)
1312	!
1313	resolution(:,:) = zresolution(:,:)
1314	CALL gather(resolution,resolution_g)
1315	!
1316	area(:) = resolution(:,1)*resolution(:,2)
1317	CALL gather(area,area_g)
1318	!
1319	!- Store the fraction of the continents only once so that the user
1320	!- does not change them afterwards.
1321	!
1322	contfrac(:) = zcontfrac(:)
1323	CALL gather(contfrac,contfrac_g)
1324	!
1325	!
1326	! Create the internal coordinate table
1327	!
1328	IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
1329	ALLOCATE(tmp_lon(iim,jjm))
1330	ENDIF
1331	IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
1332	ALLOCATE(tmp_lat(iim,jjm))
1333	ENDIF
1334	IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
1335	ALLOCATE(tmp_lev(iim,jjm))
1336	ENDIF
1337	!
1338	! Either we have the scattered coordinates as arguments or
1339	! we have to do the work here.
1340	!
1341	IF ( PRESENT(lon_scat_g) .AND. PRESENT(lat_scat_g)) THEN
1342
1343	lon_scat(:,:)=zero
1344	lat_scat(:,:)=zero
1345	CALL scatter2D(lon_scat_g,lon_scat)
1346	CALL scatter2D(lat_scat_g,lat_scat)
1347	lon_scat(:,1)=lon_scat(:,2)
1348	lon_scat(:,jj_nb)=lon_scat(:,2)
1349	lat_scat(:,1)=lat_scat(iim,1)
1350	lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
1351
1352	tmp_lon(:,:) = lon_scat(:,:)
1353	tmp_lat(:,:) = lat_scat(:,:)
1354
1355	IF (is_root_prc) THEN
1356	lon_g(:,:) = lon_scat_g(:,:)
1357	lat_g(:,:) = lat_scat_g(:,:)
1358	ENDIF
1359
1360	ELSE IF ( PRESENT(lon_scat_g) .OR. PRESENT(lat_scat_g)) THEN
1361
1362	WRITE(numout,*) 'You need to provide the longitude AND latitude on the'
1363	WRITE(numout,*) 'gathered grid in order to start ORCHIDEE.'
1364	STOP 'intersurf_gathered'
1365
1366	ELSE
1367	!
1368	WRITE(numout,*) 'intersurf_gathered : We try to guess to full grid of the model.'
1369	WRITE(numout,*) 'I might fail, please report if it does. '
1370	!
1371	tmp_lon(:,:) = val_exp
1372	tmp_lat(:,:) = val_exp
1373	!
1374	DO ik=1, kjpindex
1375	j = INT( (kindex(ik)-1) / iim ) + 1
1376	i = kindex(ik) - (j-1) * iim
1377	tmp_lon(i,j) = lalo(ik,2)
1378	tmp_lat(i,j) = lalo(ik,1)
1379	ENDDO
1380	!
1381	! Here we fill out the grid. To do this we do the strong hypothesis
1382	! that the grid is regular. Will this work in all cases ????
1383	!
1384	DO i=1,iim
1385	mx = MAXVAL(tmp_lon(i,:), MASK=tmp_lon(i,:) .LT. val_exp)
1386	IF ( mx .LT. val_exp ) THEN
1387	tmp_lon(i,:) = mx
1388	ELSE
1389	WRITE(numout,*) 'Could not find a continental point on this longitude. Thus the grid'
1390	WRITE(numout,*) 'could not be completed.'
1391	STOP 'intersurf_gathered'
1392	ENDIF
1393	ENDDO
1394	!
1395	DO j=1,jjm
1396	mx = MAXVAL(tmp_lat(:,j), MASK=tmp_lat(:,j) .LT. val_exp)
1397	IF ( mx .LT. val_exp ) THEN
1398	tmp_lat(:,j) = mx
1399	ELSE
1400	WRITE(numout,*) 'Could not find a continental point on this latitude. Thus the grid'
1401	WRITE(numout,*) 'could not be completed.'
1402	STOP 'intersurf_gathered'
1403	ENDIF
1404	ENDDO
1405
1406	CALL gather2D(tmp_lon,lon_g)
1407	CALL gather2D(tmp_lat,lat_g)
1408
1409	ENDIF
1410	!
1411	DO ik=1, kjpindex
1412	j = INT( (kindex(ik)-1) / iim ) + 1
1413	i = kindex(ik) - (j-1) * iim
1414	tmp_lev(i,j) = zlev(ik)
1415	ENDDO
1416	CALL gather2D(tmp_lev,zlev_g)
1417	!
1418	!
1419	! Configuration of SSL specific parameters
1420	!
1421	CALL intsurf_config(control_flags,xrdt)
1422	!
1423	!Config Key = FORCE_CO2_VEG
1424	!Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
1425	!Config Def = FALSE
1426	!Config Help = If this flag is set to true, the ATM_CO2 parameter is used
1427	!Config to prescribe the atmospheric CO2.
1428	!Config This Flag is only use in couple mode.
1429	!
1430	fatmco2=.FALSE.
1431	CALL getin_p('FORCE_CO2_VEG',fatmco2)
1432	!
1433	! Next flag is only use in couple mode with a gcm in intersurf.
1434	! In forced mode, it has already been read and set in driver.
1435	IF ( fatmco2 ) THEN
1436	!Config Key = ATM_CO2
1437	!Config IF = FORCE_CO2_VEG (in not forced mode)
1438	!Config Desc = Value for atm CO2
1439	!Config Def = 350.
1440	!Config Help = Value to prescribe the atm CO2.
1441	!Config For pre-industrial simulations, the value is 286.2 .
1442	!Config 348. for 1990 year.
1443	!
1444	atmco2=350.
1445	CALL getin_p('ATM_CO2',atmco2)
1446	WRITE(numout,*) 'atmco2 ',atmco2
1447	ENDIF
1448
1449	!
1450	CALL intsurf_restart(kjit, iim, jjm, tmp_lon, tmp_lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
1451	itau_sechiba = kjit + itau_offset
1452	!
1453	CALL intsurf_history(iim, jjm, tmp_lon, tmp_lat, itau_sechiba, &
1454	& date0_shifted, xrdt, control_flags, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
1455	!
1456	IF ( ok_watchout ) THEN
1457	IF (is_root_prc) THEN
1458	zlev_mean = zero
1459	DO ik=1, nbp_glo
1460	j = ((index_g(ik)-1)/iim_g) + 1
1461	i = (index_g(ik) - (j-1)*iim_g)
1462
1463	zlev_mean = zlev_mean + zlev_g(i,j)
1464	ENDDO
1465	zlev_mean = zlev_mean / REAL(nbp_glo,r_std)
1466	ENDIF
1467
1468	last_action_watch = itau_sechiba
1469	last_check_watch = last_action_watch
1470
1471	CALL watchout_init(iim_g, jjm_g, kjpindex, nbp_glo, &
1472	& date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
1473	ENDIF
1474	!
1475	IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
1476	!
1477	ENDIF
1478	!
1479	CALL ipslnlf(new_number=numout)
1480	!
1481	! Shift the time step to phase the two models
1482	!
1483	itau_sechiba = kjit + itau_offset
1484	!
1485	CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
1486	!
1487	! 1. Just change the units of some input fields
1488	!
1489	DO ik=1, kjpindex
1490
1491	zprecip_rain(ik) = precip_rain(ik)*xrdt
1492	zprecip_snow(ik) = precip_snow(ik)*xrdt
1493	zcdrag(ik) = cdrag(ik)
1494
1495	ENDDO
1496	!
1497	IF (check_INPUTS) THEN
1498	WRITE(numout,*) "Intersurf_main_gathered :"
1499	WRITE(numout,*) "Time step number = ",kjit
1500	WRITE(numout,*) "Dimension of input fields = ",iim, jjm
1501	WRITE(numout,*) "Number of continental points = ",kjpindex
1502	WRITE(numout,*) "Time step in seconds = ",xrdt
1503	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
1504	WRITE(numout,*) "Date at which kjit = 0 = ",date0
1505	WRITE(numout,*) "Index for continental points = ",kindex
1506	WRITE(numout,*) "Lowest level wind speed North = ",u
1507	WRITE(numout,*) "Lowest level wind speed East = ",v
1508	WRITE(numout,*) "Height of first layer = ",zlev
1509	WRITE(numout,*) "Lowest level specific humidity = ",qair
1510	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
1511	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
1512	WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
1513	WRITE(numout,*) "Net surface short-wave flux = ",swnet
1514	WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
1515	WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
1516	WRITE(numout,*) "Air potential energy = ",epot_air
1517	WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
1518	WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
1519	WRITE(numout,*) "One for T and another for q = ",peqAcoef
1520	WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
1521	WRITE(numout,*) "One for T and another for q = ",peqBcoef
1522	WRITE(numout,*) "Cdrag = ",zcdrag
1523	WRITE(numout,*) "Lowest level pressure = ",pb
1524	WRITE(numout,*) "Geographical coordinates lon = ", lon_scat
1525	WRITE(numout,*) "Geographical coordinates lat = ", lat_scat
1526	WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
1527	ENDIF
1528	!
1529	! 2. modification of co2
1530	!
1531	IF ( fatmco2 ) THEN
1532	zccanopy(:) = atmco2
1533	WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
1534	ELSE
1535	zccanopy(:) = ccanopy(:)
1536	ENDIF
1537	!
1538	! 3. save the grid
1539	!
1540	IF ( check ) WRITE(numout,*) 'Save the grid'
1541	!
1542	IF (l_first_intersurf) THEN
1543	CALL histwrite(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
1544	CALL histwrite(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1545	IF ( control_flags%ok_stomate ) THEN
1546	CALL histwrite(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1547	IF ( hist_id_stom_IPCC > 0 ) THEN
1548	CALL histwrite(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1549	ENDIF
1550	ENDIF
1551	CALL histwrite(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
1552	CALL histsync(hist_id)
1553	!
1554	IF ( hist2_id > 0 ) THEN
1555	CALL histwrite(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
1556	CALL histwrite(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1557	CALL histwrite(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
1558	CALL histsync(hist2_id)
1559	ENDIF
1560	!
1561	ENDIF
1562	!
1563	! 4. call sechiba for continental points only
1564	!
1565	IF ( check ) WRITE(numout,*) 'Calling sechiba'
1566	!
1567	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
1568	& lrestart_read, lrestart_write, control_flags, &
1569	& lalo, contfrac, neighbours, resolution, &
1570	! First level conditions
1571	! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
1572	! & zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1573	& zlev, u, v, qair, qair, temp_air, temp_air, epot_air, zccanopy, &
1574	! Variables for the implicit coupling
1575	& zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1576	! Rain, snow, radiation and surface pressure
1577	& zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, pb, &
1578	! Output : Fluxes
1579	& zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
1580	! Surface temperatures and surface properties
1581	& ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
1582	! File ids
1583	& rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
1584
1585	!
1586	IF ( check ) WRITE(numout,*) 'out of SECHIBA'
1587	!
1588	! 5. save watchout
1589	!
1590	IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
1591	! Accumulate last time step
1592	sum_zlev(:) = sum_zlev(:) + zlev(:)
1593	sum_u(:) = sum_u(:) + u(:)
1594	sum_v(:) = sum_v(:) + v(:)
1595	sum_qair(:) = sum_qair(:) + qair(:)
1596	sum_temp_air(:) = sum_temp_air(:) + temp_air(:)
1597	sum_epot_air(:) = sum_epot_air(:) + epot_air(:)
1598	sum_ccanopy(:) = sum_ccanopy(:) + ccanopy(:)
1599	sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
1600	sum_petAcoef(:) = sum_petAcoef(:) + petAcoef(:)
1601	sum_peqAcoef(:) = sum_peqAcoef(:) + peqAcoef(:)
1602	sum_petBcoef(:) = sum_petBcoef(:) + petBcoef(:)
1603	sum_peqBcoef(:) = sum_peqBcoef(:) + peqBcoef(:)
1604	sum_rain(:) = sum_rain(:) + zprecip_rain(:)
1605	sum_snow(:) = sum_snow(:) + zprecip_snow(:)
1606	sum_lwdown(:) = sum_lwdown(:) + lwdown(:)
1607	sum_pb(:) = sum_pb(:) + pb(:)
1608
1609	!!$ IF ( dt_watch > 3600 ) THEN
1610	!!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
1611	!!$ CALL solarang (julian_watch, julian0, iim, jjm, tmp_lon, tmp_lat, sinang)
1612	!!$ WHERE ( sinang(:,:) .LT. EPSILON(un) )
1613	!!$ isinang(:,:) = isinang(:,:) - 1
1614	!!$ ENDWHERE
1615	!!$ mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
1616	!!$ !
1617	!!$ DO ik=1,kjpindex
1618	!!$ j = ((kindex(ik)-1)/iim) + 1
1619	!!$ i = (kindex(ik) - (j-1)*iim)
1620	!!$
1621	!!$ sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*swnet(ik)
1622	!!$ sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*swdown(ik)
1623	!!$ ENDDO
1624	!!$ ELSE
1625	sum_swnet(:) = sum_swnet(:) + swnet(:)
1626	sum_swdown(:) = sum_swdown(:) + swdown(:)
1627	!!$ ENDIF
1628
1629	do_watch = .FALSE.
1630	call isittime &
1631	& (itau_sechiba,date0_shifted,xrdt,dt_watch,&
1632	& last_action_watch,last_check_watch,do_watch)
1633	last_check_watch = itau_sechiba
1634	IF (do_watch) THEN
1635	!
1636	IF ( check ) WRITE(numout,*) 'save watchout'
1637	!
1638	IF (long_print) THEN
1639	WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba, &
1640	& last_action_watch,last_check_watch
1641	ENDIF
1642	last_action_watch = itau_sechiba
1643
1644	sum_zlev(:) = sum_zlev(:) / dt_split_watch
1645	sum_u(:) = sum_u(:) / dt_split_watch
1646	sum_v(:) = sum_v(:) / dt_split_watch
1647	sum_qair(:) = sum_qair(:) / dt_split_watch
1648	sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
1649	sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
1650	sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
1651	sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
1652	sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
1653	sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
1654	sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
1655	sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
1656	sum_rain(:) = sum_rain(:) / dt_split_watch
1657	sum_snow(:) = sum_snow(:) / dt_split_watch
1658	sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
1659	sum_pb(:) = sum_pb(:) / dt_split_watch
1660
1661	!!$ IF ( dt_watch > 3600 ) THEN
1662	!!$ WHERE ( isinang(:,:) .GT. 0 )
1663	!!$ mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
1664	!!$ ENDWHERE
1665	!!$ !
1666	!!$ DO ik=1,kjpindex
1667	!!$ j = ((kindex(ik)-1)/iim) + 1
1668	!!$ i = (kindex(ik) - (j-1)*iim)
1669	!!$ IF (mean_sinang(i,j) > zero) THEN
1670	!!$ sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
1671	!!$ sum_swnet(ik) = sum_swnet(ik)/mean_sinang(i,j)
1672	!!$ ELSE
1673	!!$ sum_swdown(ik) = zero
1674	!!$ sum_swnet(ik) = zero
1675	!!$ ENDIF
1676	!!$ ENDDO
1677	!!$ ELSE
1678	sum_swnet(:) = sum_swnet(:) / dt_split_watch
1679	sum_swdown(:) = sum_swdown(:) / dt_split_watch
1680	!!$ ENDIF
1681
1682	CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
1683	& sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
1684	& sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
1685	& sum_cdrag, sum_ccanopy )
1686	ENDIF
1687	ENDIF
1688	!
1689	! 6. scatter output fields
1690	!
1691	z0(:) = undef_sechiba
1692	coastalflow(:) = undef_sechiba
1693	riverflow(:) = undef_sechiba
1694	tsol_rad(:) = undef_sechiba
1695	vevapp(:) = undef_sechiba
1696	temp_sol_new(:) = undef_sechiba
1697	qsurf(:) = undef_sechiba
1698	albedo(:,1) = undef_sechiba
1699	albedo(:,2) = undef_sechiba
1700	fluxsens(:) = undef_sechiba
1701	fluxlat(:) = undef_sechiba
1702	emis(:) = undef_sechiba
1703	cdrag(:) = undef_sechiba
1704	!
1705	! dvevapp(:) = undef_sechiba
1706	dtemp_sol(:) = undef_sechiba
1707	dfluxsens(:) = undef_sechiba
1708	dfluxlat(:) = undef_sechiba
1709	dswnet (:) = undef_sechiba
1710	dswdown (:) = undef_sechiba
1711	dalbedo (:,1) = undef_sechiba
1712	dalbedo (:,2) = undef_sechiba
1713	dtair (:) = undef_sechiba
1714	dqair (:) = undef_sechiba
1715	!
1716	DO ik=1, kjpindex
1717
1718	z0(ik) = zz0(ik)
1719	coastalflow(ik) = zcoastal(ik)/1000.
1720	riverflow(ik) = zriver(ik)/1000.
1721	tsol_rad(ik) = ztsol_rad(ik)
1722	vevapp(ik) = zvevapp(ik)
1723	temp_sol_new(ik) = ztemp_sol_new(ik)
1724	qsurf(ik) = zqsurf(ik)
1725	albedo(ik,1) = zalbedo(ik,1)
1726	albedo(ik,2) = zalbedo(ik,2)
1727	fluxsens(ik) = zfluxsens(ik)
1728	fluxlat(ik) = zfluxlat(ik)
1729	emis(ik) = zemis(ik)
1730	cdrag(ik) = zcdrag(ik)
1731
1732	! Fill up the diagnostic arrays
1733
1734	! dvevapp(kindex(ik)) = zvevapp(ik)
1735	dtemp_sol(kindex(ik)) = ztemp_sol_new(ik)
1736	dfluxsens(kindex(ik)) = zfluxsens(ik)
1737	dfluxlat(kindex(ik)) = zfluxlat(ik)
1738	dswnet (kindex(ik)) = swnet(ik)
1739	dswdown (kindex(ik)) = swdown(ik)
1740	dalbedo (kindex(ik),1) = zalbedo(ik,1)
1741	dalbedo (kindex(ik),2) = zalbedo(ik,2)
1742	dtair (kindex(ik)) = temp_air(ik)
1743	dqair (kindex(ik)) = qair(ik)
1744	!
1745	ENDDO
1746	!
1747	! Modified fields for variables scattered during the writing
1748	!
1749	dcoastal(:) = (zcoastal(:))/1000.
1750	driver(:) = (zriver(:))/1000.
1751	!
1752	IF ( .NOT. l_first_intersurf) THEN
1753	!
1754	IF ( .NOT. almaoutput ) THEN
1755	!
1756	! scattered during the writing
1757	!
1758	CALL histwrite (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1759	CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
1760	CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
1761	!
1762	CALL histwrite (hist_id, 'temp_sol', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1763	CALL histwrite (hist_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1764	CALL histwrite (hist_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1765	CALL histwrite (hist_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
1766	CALL histwrite (hist_id, 'fluxlat', itau_sechiba, dfluxlat, iim*jjm, kindex)
1767	CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
1768	CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
1769	CALL histwrite (hist_id, 'alb_vis', itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
1770	CALL histwrite (hist_id, 'alb_nir', itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
1771	CALL histwrite (hist_id, 'tair', itau_sechiba, dtair, iim*jjm, kindex)
1772	CALL histwrite (hist_id, 'qair', itau_sechiba, dqair, iim*jjm, kindex)
1773	CALL histwrite (hist_id, 't2m', itau_sechiba, dtair, iim*jjm, kindex)
1774	CALL histwrite (hist_id, 'q2m', itau_sechiba, dqair, iim*jjm, kindex)
1775	!
1776	IF ( hist2_id > 0 ) THEN
1777	CALL histwrite (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1778	CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
1779	CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
1780	!
1781	CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1782	CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1783	CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1784	CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
1785	CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, dfluxlat, iim*jjm, kindex)
1786	CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
1787	CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
1788	CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
1789	CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
1790	CALL histwrite (hist2_id, 'tair', itau_sechiba, dtair, iim*jjm, kindex)
1791	CALL histwrite (hist2_id, 'qair', itau_sechiba, dqair, iim*jjm, kindex)
1792	CALL histwrite (hist2_id, 't2m', itau_sechiba, dtair, iim*jjm, kindex)
1793	CALL histwrite (hist2_id, 'q2m', itau_sechiba, dqair, iim*jjm, kindex)
1794	ENDIF
1795	ELSE
1796	CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1797	CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
1798	CALL histwrite (hist_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
1799	CALL histwrite (hist_id, 'Qle', itau_sechiba, dfluxlat, iim*jjm, kindex)
1800	CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1801	CALL histwrite (hist_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1802	!
1803	IF ( hist2_id > 0 ) THEN
1804	CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1805	CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
1806	CALL histwrite (hist2_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
1807	CALL histwrite (hist2_id, 'Qle', itau_sechiba, dfluxlat, iim*jjm, kindex)
1808	CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1809	CALL histwrite (hist2_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
1810	ENDIF
1811	ENDIF
1812	!
1813	IF (dw .EQ. xrdt) THEN
1814	CALL histsync(hist_id)
1815	ENDIF
1816	!
1817	ENDIF
1818	!
1819	! 7. Transform the water fluxes into Kg/m^2s and m^3/s
1820	!
1821	DO ik=1, kjpindex
1822
1823	vevapp(ik) = vevapp(ik)/xrdt
1824	coastalflow(ik) = coastalflow(ik)/xrdt
1825	riverflow(ik) = riverflow(ik)/xrdt
1826
1827	ENDDO
1828	!
1829	IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN
1830	CALL watchout_close()
1831	ENDIF
1832	!
1833	IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
1834	l_first_intersurf = .FALSE.
1835	!
1836	IF (long_print) WRITE (numout,*) ' intersurf_main done '
1837	!
1838	CALL ipslnlf(new_number=old_fileout)
1839	!
1840	END SUBROUTINE intersurf_gathered
1841	!
1842	!
1843	#ifdef CPP_PARA
1844	SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, offset, kjpindex, kindex, communicator, xrdt, &
1845	& lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1846	! First level conditions
1847	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1848	! Variables for the implicit coupling
1849	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1850	! Rain, snow, radiation and surface pressure
1851	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1852	! Output : Fluxes
1853	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
1854	! Surface temperatures and surface properties
1855	! & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g)
1856	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, &
1857	! Ajout Nathalie - passage q2m/t2m pour calcul Rveget
1858	& q2m, t2m, &
1859	! Add emission/deposit fields
1860	& field_out_names, fields_out, field_in_names, fields_in)
1861	#else
1862	SUBROUTINE intersurf_gathered_2m (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1863	& lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1864	! First level conditions
1865	& zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1866	! Variables for the implicit coupling
1867	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1868	! Rain, snow, radiation and surface pressure
1869	& precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1870	! Output : Fluxes
1871	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
1872	! Surface temperatures and surface properties
1873	! & tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g)
1874	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0, lon_scat_g, lat_scat_g, &
1875	! Ajout Nathalie - passage q2m/t2m pour calcul Rveget
1876	& q2m, t2m, &
1877	! Add emission/deposit fields
1878	& field_out_names, fields_out, field_in_names, fields_in)
1879	#endif
1880	! routines called : sechiba_main
1881	!
1882	IMPLICIT NONE
1883	!
1884	! interface description for dummy arguments
1885	! input scalar
1886	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
1887	INTEGER(i_std),INTENT (in) :: iim_glo, jjm_glo !! Dimension of global fields
1888	#ifdef CPP_PARA
1889	INTEGER(i_std),INTENT (in) :: offset !! offset between the first global 2D point
1890	!! and the first local 2D point.
1891	INTEGER(i_std),INTENT(IN) :: communicator !! Orchidee communicator
1892	#endif
1893	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
1894	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
1895	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
1896	LOGICAL, INTENT (in) :: lrestart_write!! Logical for _restart_ file to write'
1897	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
1898	! input fields
1899	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
1900	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
1901	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
1902	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
1903	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
1904	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
1905	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
1906	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
1907	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
1908	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
1909	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
1910	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
1911	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
1912	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
1913	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
1914	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
1915	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
1916	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
1917	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Lowest level pressure
1918	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: latlon !! Geographical coordinates
1919	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
1920	INTEGER(i_std),DIMENSION (kjpindex,8), INTENT(in) :: zneighbours !! neighbours
1921	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
1922	! Ajout Nathalie - Juin 2006 - q2m/t2m pour calcul Rveget
1923	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: q2m !! Surface specific humidity
1924	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: t2m !! Surface air temperature
1925	! output fields
1926	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0 !! Surface roughness
1927	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/dt)
1928	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/dt)
1929	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
1930	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
1931	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
1932	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
1933	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
1934	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
1935	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
1936	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
1937	!
1938	! Optional arguments
1939	!
1940	! Names and fields for emission variables : to be transport by GCM to chemistry model.
1941	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names
1942	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out
1943	!
1944	! Names and fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
1945	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names
1946	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in
1947	!
1948	! LOCAL declaration
1949	! work arrays to scatter and/or gather information just before/after sechiba_main call's
1950	! and to keep output value for next call
1951	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
1952	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
1953	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
1954	REAL(r_std),DIMENSION (kjpindex) :: zz0 !! Work array to keep z0
1955	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
1956	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
1957	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
1958	REAL(r_std),DIMENSION (kjpindex) :: dcoastal !! Work array to keep coastal flow
1959	REAL(r_std),DIMENSION (kjpindex) :: driver !! Work array to keep river out flow
1960	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
1961	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
1962	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
1963	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
1964	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
1965	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
1966	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
1967	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
1968	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
1969	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
1970	!
1971	! Optional arguments
1972	!
1973	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g, lat_scat_g !! The scattered values for longitude
1974	!
1975	INTEGER(i_std) :: iim,jjm !! local sizes
1976	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lon_scat, lat_scat !! The scattered values for longitude
1977	! !! and latitude.
1978	!
1979	! Scattered variables for diagnostics
1980	!
1981	! REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dvevapp !! Diagnostic array for evaporation
1982	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dtemp_sol !! for surface temperature
1983	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dfluxsens !! for sensible heat flux
1984	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dfluxlat !! for latent heat flux
1985	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dswnet !! net solar radiation
1986	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dswdown !! Incident solar radiation
1987	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:,:) :: dalbedo !! albedo
1988	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dtair !! air temperature
1989	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dqair !! specific air humidity
1990	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dq2m !! Surface specific humidity
1991	REAL(r_std),ALLOCATABLE,SAVE,DIMENSION (:) :: dt2m !! Surface air temperature
1992	!
1993	!
1994	INTEGER(i_std) :: i, j, ik
1995	INTEGER(i_std) :: itau_sechiba
1996	REAL(r_std) :: mx, zlev_mean
1997	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon, tmp_lat, tmp_lev
1998	LOGICAL :: do_watch !! if it's time, write watchout
1999	INTEGER :: old_fileout !! old Logical Int for std IO output
2000	LOGICAL :: check = .FALSE.
2001	INTEGER(i_std),DIMENSION (kjpindex) :: kindex_p
2002	!
2003	LOGICAL, SAVE :: fatmco2 !! Flag to force the value of atmospheric CO2 for vegetation.
2004	REAL(r_std), SAVE :: atmco2 !! atmospheric CO2
2005	!
2006	! Number of fields to give (nb_fields_out) or get from (nb_fields_in) GCM :
2007	INTEGER(i_std), SAVE :: nb_fields_out, nb_fields_in
2008	! Id of fields to give (nb_fields_out) or get from (nb_fields_in) GCM :
2009	INTEGER(i_std) :: i_fields_out, i_fields_in
2010	!
2011	CALL ipslnlf(old_number=old_fileout)
2012	!
2013	IF (l_first_intersurf) THEN
2014	!
2015	CALL intsurf_time( kjit, date0, xrdt )
2016	!
2017	IF ( check ) WRITE(numout,*) 'Initialisation of intersurf'
2018	!
2019	CALL ioget_calendar (one_year, one_day)
2020	!
2021	#ifdef CPP_PARA
2022	CALL init_para(.TRUE.,communicator)
2023	kindex_p(:)=kindex(:) + offset
2024	#else
2025	CALL init_para(.FALSE.)
2026	kindex_p(:)=kindex(:)
2027	#endif
2028	CALL ipslnlf(new_number=numout)
2029	!
2030	CALL init_data_para(iim_glo,jjm_glo,kjpindex,kindex_p)
2031	iim=iim_glo
2032	jjm=jj_nb
2033	ALLOCATE(lon_scat(iim,jjm))
2034	ALLOCATE(lat_scat(iim,jjm))
2035	! ALLOCATE(dvevapp(iim*jjm))
2036	ALLOCATE(dtemp_sol(iim*jjm))
2037	ALLOCATE(dfluxsens(iim*jjm))
2038	ALLOCATE(dfluxlat(iim*jjm))
2039	ALLOCATE(dswnet(iim*jjm))
2040	ALLOCATE(dswdown(iim*jjm))
2041	ALLOCATE(dalbedo(iim*jjm,2))
2042	ALLOCATE(dtair(iim*jjm))
2043	ALLOCATE(dqair(iim*jjm))
2044	ALLOCATE(dq2m(iim*jjm))
2045	ALLOCATE(dt2m(iim*jjm))
2046
2047	! CALL init_WriteField_p(kindex)
2048	!
2049	! Allocation of grid variables
2050	!
2051	CALL init_grid ( kjpindex )
2052	!
2053	! Create the internal coordinate table
2054	!
2055	lalo(:,:) = latlon(:,:)
2056	CALL gather(lalo,lalo_g)
2057	!
2058	!-
2059	!- Store variable to help describe the grid
2060	!- once the points are gathered.
2061	!-
2062	neighbours(:,:) = zneighbours(:,:)
2063	CALL gather(neighbours,neighbours_g)
2064	!
2065	resolution(:,:) = zresolution(:,:)
2066	CALL gather(resolution,resolution_g)
2067	!
2068	area(:) = resolution(:,1)*resolution(:,2)
2069	CALL gather(area,area_g)
2070	!
2071	!- Store the fraction of the continents only once so that the user
2072	!- does not change them afterwards.
2073	!
2074	contfrac(:) = zcontfrac(:)
2075	CALL gather(contfrac,contfrac_g)
2076	!
2077	!
2078	! Create the internal coordinate table
2079	!
2080	IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
2081	ALLOCATE(tmp_lon(iim,jjm))
2082	ENDIF
2083	IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
2084	ALLOCATE(tmp_lat(iim,jjm))
2085	ENDIF
2086	IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
2087	ALLOCATE(tmp_lev(iim,jjm))
2088	ENDIF
2089	!
2090	! Either we have the scattered coordinates as arguments or
2091	! we have to do the work here.
2092	!
2093	IF ( .TRUE. ) THEN
2094
2095	lon_scat(:,:)=zero
2096	lat_scat(:,:)=zero
2097	CALL scatter2D(lon_scat_g,lon_scat)
2098	CALL scatter2D(lat_scat_g,lat_scat)
2099	lon_scat(:,1)=lon_scat(:,2)
2100	lon_scat(:,jj_nb)=lon_scat(:,2)
2101	lat_scat(:,1)=lat_scat(iim,1)
2102	lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
2103
2104	tmp_lon(:,:) = lon_scat(:,:)
2105	tmp_lat(:,:) = lat_scat(:,:)
2106
2107	IF (is_root_prc) THEN
2108	lon_g(:,:) = lon_scat_g(:,:)
2109	lat_g(:,:) = lat_scat_g(:,:)
2110	ENDIF
2111
2112	ELSE
2113	!
2114	WRITE(numout,*) 'intersurf_gathered : We try to guess to full grid of the model.'
2115	WRITE(numout,*) 'I might fail, please report if it does. '
2116	!
2117	tmp_lon(:,:) = val_exp
2118	tmp_lat(:,:) = val_exp
2119	!
2120	DO ik=1, kjpindex
2121	j = INT( (kindex(ik)-1) / iim ) + 1
2122	i = kindex(ik) - (j-1) * iim
2123	tmp_lon(i,j) = lalo(ik,2)
2124	tmp_lat(i,j) = lalo(ik,1)
2125	ENDDO
2126	!
2127	! Here we fill out the grid. To do this we do the strong hypothesis
2128	! that the grid is regular. Will this work in all cases ????
2129	!
2130	DO i=1,iim
2131	mx = MAXVAL(tmp_lon(i,:), MASK=tmp_lon(i,:) .LT. val_exp)
2132	IF ( mx .LT. val_exp ) THEN
2133	tmp_lon(i,:) = mx
2134	ELSE
2135	WRITE(numout,*) 'Could not find a continental point on this longitude. Thus the grid'
2136	WRITE(numout,*) 'could not be completed.'
2137	STOP 'intersurf_gathered'
2138	ENDIF
2139	ENDDO
2140	!
2141	DO j=1,jjm
2142	mx = MAXVAL(tmp_lat(:,j), MASK=tmp_lat(:,j) .LT. val_exp)
2143	IF ( mx .LT. val_exp ) THEN
2144	tmp_lat(:,j) = mx
2145	ELSE
2146	WRITE(numout,*) 'Could not find a continental point on this latitude. Thus the grid'
2147	WRITE(numout,*) 'could not be completed.'
2148	STOP 'intersurf_gathered'
2149	ENDIF
2150	ENDDO
2151
2152	CALL gather2D(tmp_lon,lon_g)
2153	CALL gather2D(tmp_lat,lat_g)
2154
2155	ENDIF
2156	!
2157	DO ik=1, kjpindex
2158	j = INT( (kindex(ik)-1) / iim ) + 1
2159	i = kindex(ik) - (j-1) * iim
2160	tmp_lev(i,j) = zlev(ik)
2161	ENDDO
2162	CALL gather2D(tmp_lev,zlev_g)
2163	!
2164	!
2165	! Configuration of SSL specific parameters
2166	!
2167	CALL intsurf_config(control_flags,xrdt)
2168	!
2169	!Config Key = FORCE_CO2_VEG
2170	!Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
2171	!Config Def = FALSE
2172	!Config Help = If this flag is set to true, the ATM_CO2 parameter is used
2173	!Config to prescribe the atmospheric CO2.
2174	!Config This Flag is only use in couple mode.
2175	!
2176	fatmco2=.FALSE.
2177	CALL getin_p('FORCE_CO2_VEG',fatmco2)
2178	!
2179	! Next flag is only use in couple mode with a gcm in intersurf.
2180	! In forced mode, it has already been read and set in driver.
2181	IF ( fatmco2 ) THEN
2182	!Config Key = ATM_CO2
2183	!Config IF = FORCE_CO2_VEG (in not forced mode)
2184	!Config Desc = Value for atm CO2
2185	!Config Def = 350.
2186	!Config Help = Value to prescribe the atm CO2.
2187	!Config For pre-industrial simulations, the value is 286.2 .
2188	!Config 348. for 1990 year.
2189	!
2190	atmco2=350.
2191	CALL getin_p('ATM_CO2',atmco2)
2192	WRITE(numout,*) 'atmco2 ',atmco2
2193	ENDIF
2194
2195	!
2196	CALL intsurf_restart(kjit, iim, jjm, tmp_lon, tmp_lat, date0, xrdt, control_flags, rest_id, rest_id_stom, itau_offset)
2197	itau_sechiba = kjit + itau_offset
2198	!
2199	CALL intsurf_history(iim, jjm, tmp_lon, tmp_lat, itau_sechiba, &
2200	& date0_shifted, xrdt, control_flags, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
2201	!
2202	IF ( ok_watchout ) THEN
2203	IF (is_root_prc) THEN
2204	zlev_mean = zero
2205	DO ik=1, nbp_glo
2206	j = ((index_g(ik)-1)/iim_g) + 1
2207	i = (index_g(ik) - (j-1)*iim_g)
2208
2209	zlev_mean = zlev_mean + zlev_g(i,j)
2210	ENDDO
2211	zlev_mean = zlev_mean / REAL(nbp_glo,r_std)
2212	ENDIF
2213
2214	last_action_watch = itau_sechiba
2215	last_check_watch = last_action_watch
2216
2217	! Only root proc write watchout file
2218	CALL watchout_init(iim_g, jjm_g, kjpindex, nbp_glo, &
2219	& date0_shifted, last_action_watch, dt_watch, index_g, lon_g, lat_g, zlev_mean)
2220	ENDIF
2221	!
2222
2223	! Prepare fieds out/in for interface with GCM.
2224	IF (PRESENT(field_out_names)) THEN
2225	nb_fields_out=SIZE(field_out_names)
2226	ELSE
2227	nb_fields_out=0
2228	ENDIF
2229	IF (PRESENT(field_in_names)) THEN
2230	nb_fields_in=SIZE(field_in_names)
2231	ELSE
2232	nb_fields_in=0
2233	ENDIF
2234
2235	IF ( check ) WRITE(numout,*) 'End of Initialisation of intersurf'
2236	!
2237	ENDIF
2238	!
2239	CALL ipslnlf(new_number=numout)
2240	!
2241	! Shift the time step to phase the two models
2242	!
2243	itau_sechiba = kjit + itau_offset
2244	!
2245	CALL intsurf_time( itau_sechiba, date0_shifted, xrdt )
2246	!
2247	! 1. Just change the units of some input fields
2248	!
2249	DO ik=1, kjpindex
2250
2251	zprecip_rain(ik) = precip_rain(ik)*xrdt
2252	zprecip_snow(ik) = precip_snow(ik)*xrdt
2253	zcdrag(ik) = cdrag(ik)
2254
2255	ENDDO
2256	!
2257	IF (check_INPUTS) THEN
2258	WRITE(numout,*) "Intersurf_main_gathered :"
2259	WRITE(numout,*) "Time step number = ",kjit
2260	WRITE(numout,*) "Dimension of input fields = ",iim, jjm
2261	WRITE(numout,*) "Number of continental points = ",kjpindex
2262	WRITE(numout,*) "Time step in seconds = ",xrdt
2263	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
2264	WRITE(numout,*) "Date at which kjit = 0 = ",date0
2265	WRITE(numout,*) "Index for continental points = ",kindex
2266	WRITE(numout,*) "Lowest level wind speed North = ",u
2267	WRITE(numout,*) "Lowest level wind speed East = ",v
2268	WRITE(numout,*) "Height of first layer = ",zlev
2269	WRITE(numout,*) "Lowest level specific humidity = ",qair
2270	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
2271	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
2272	WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
2273	WRITE(numout,*) "Net surface short-wave flux = ",swnet
2274	WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
2275	WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
2276	WRITE(numout,*) "Air potential energy = ",epot_air
2277	WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
2278	WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
2279	WRITE(numout,*) "One for T and another for q = ",peqAcoef
2280	WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
2281	WRITE(numout,*) "One for T and another for q = ",peqBcoef
2282	WRITE(numout,*) "Cdrag = ",zcdrag
2283	WRITE(numout,*) "Lowest level pressure = ",pb
2284	WRITE(numout,*) "Geographical coordinates lon = ", lon_scat
2285	WRITE(numout,*) "Geographical coordinates lat = ", lat_scat
2286	WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
2287	ENDIF
2288
2289
2290	! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
2291	WRITE(numout,*) "Get fields from atmosphere."
2292
2293	DO i_fields_in=1,nb_fields_in
2294	WRITE(numout,*) i_fields_in," Champ = ",TRIM(field_in_names(i_fields_in))
2295	SELECT CASE(TRIM(field_in_names(i_fields_in)))
2296	CASE DEFAULT
2297	CALL ipslerr (3,'intsurf_gathered_2m', &
2298	& 'You ask in GCM an unknown field '//TRIM(field_in_names(i_fields_in))//&
2299	& ' to give to ORCHIDEE for this specific version.',&
2300	& 'This model won''t be able to continue.', &
2301	& '(check your tracer parameters in GCM)')
2302	END SELECT
2303	ENDDO
2304
2305	!
2306	! 2. modification of co2
2307	!
2308	IF ( fatmco2 ) THEN
2309	zccanopy(:) = atmco2
2310	WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
2311	ELSE
2312	zccanopy(:) = ccanopy(:)
2313	ENDIF
2314	!
2315	! 3. save the grid
2316	!
2317	IF ( check ) WRITE(numout,*) 'Save the grid'
2318	!
2319	IF (l_first_intersurf) THEN
2320	CALL histwrite(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
2321	CALL histwrite(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
2322	IF ( control_flags%ok_stomate ) THEN
2323	CALL histwrite(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
2324	IF ( hist_id_stom_ipcc > 0 ) &
2325	CALL histwrite(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
2326	ENDIF
2327	CALL histwrite(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
2328	CALL histsync(hist_id)
2329	!
2330	IF ( hist2_id > 0 ) THEN
2331	CALL histwrite(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
2332	CALL histwrite(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
2333	CALL histwrite(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
2334	CALL histsync(hist2_id)
2335	ENDIF
2336	!
2337	ENDIF
2338	!
2339	! 4. call sechiba for continental points only
2340	!
2341	IF ( check ) WRITE(numout,*) 'Calling sechiba'
2342	!
2343	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, xrdt, date0_shifted, &
2344	& lrestart_read, lrestart_write, control_flags, &
2345	& lalo, contfrac, neighbours, resolution, &
2346	! First level conditions
2347	! Ajout Nathalie - Juin 2006 - passage q2m/t2m pour calcul rveget
2348	! & zlev, u, v, qair, temp_air, epot_air, ccanopy, &
2349	& zlev, u, v, qair, q2m, t2m, temp_air, epot_air, zccanopy, &
2350	! Variables for the implicit coupling
2351	& zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
2352	! Rain, snow, radiation and surface pressure
2353	& zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, pb, &
2354	! Output : Fluxes
2355	& zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
2356	! Surface temperatures and surface properties
2357	& ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0, &
2358	! File ids
2359	& rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
2360
2361	!
2362	IF ( check ) WRITE(numout,*) 'out of SECHIBA'
2363	!
2364	! 5. save watchout
2365	!
2366	IF ( ok_watchout .AND. .NOT. l_first_intersurf ) THEN
2367	! Accumulate last time step
2368	sum_zlev(:) = sum_zlev(:) + zlev(:)
2369	sum_u(:) = sum_u(:) + u(:)
2370	sum_v(:) = sum_v(:) + v(:)
2371	sum_qair(:) = sum_qair(:) + qair(:)
2372	sum_temp_air(:) = sum_temp_air(:) + temp_air(:)
2373	sum_epot_air(:) = sum_epot_air(:) + epot_air(:)
2374	sum_ccanopy(:) = sum_ccanopy(:) + ccanopy(:)
2375	sum_cdrag(:) = sum_cdrag(:) + zcdrag(:)
2376	sum_petAcoef(:) = sum_petAcoef(:) + petAcoef(:)
2377	sum_peqAcoef(:) = sum_peqAcoef(:) + peqAcoef(:)
2378	sum_petBcoef(:) = sum_petBcoef(:) + petBcoef(:)
2379	sum_peqBcoef(:) = sum_peqBcoef(:) + peqBcoef(:)
2380	sum_rain(:) = sum_rain(:) + zprecip_rain(:)
2381	sum_snow(:) = sum_snow(:) + zprecip_snow(:)
2382	sum_lwdown(:) = sum_lwdown(:) + lwdown(:)
2383	sum_pb(:) = sum_pb(:) + pb(:)
2384
2385	!!$ IF ( dt_watch > 3600 ) THEN
2386	!!$ julian_watch = date0_shifted+((itau_sechiba-0.5)/dt_split_watch)*dt_watch/one_day
2387	!!$ CALL solarang (julian_watch, julian0, iim, jjm, tmp_lon, tmp_lat, sinang)
2388	!!$ WHERE ( sinang(:,:) .LT. EPSILON(un) )
2389	!!$ isinang(:,:) = isinang(:,:) - 1
2390	!!$ ENDWHERE
2391	!!$ mean_sinang(:,:) = mean_sinang(:,:)+sinang(:,:)
2392	!!$ !
2393	!!$ DO ik=1,kjpindex
2394	!!$ j = ((kindex(ik)-1)/iim) + 1
2395	!!$ i = (kindex(ik) - (j-1)*iim)
2396	!!$
2397	!!$ sum_swnet(ik) = sum_swnet(ik) + sinang(i,j)*swnet(ik)
2398	!!$ sum_swdown(ik) = sum_swdown(ik) + sinang(i,j)*swdown(ik)
2399	!!$ ENDDO
2400	!!$ ELSE
2401	sum_swnet(:) = sum_swnet(:) + swnet(:)
2402	sum_swdown(:) = sum_swdown(:) + swdown(:)
2403	!!$ ENDIF
2404
2405	do_watch = .FALSE.
2406	call isittime &
2407	& (itau_sechiba,date0_shifted,xrdt,dt_watch,&
2408	& last_action_watch,last_check_watch,do_watch)
2409	last_check_watch = itau_sechiba
2410	IF (do_watch) THEN
2411	!
2412	IF ( check ) WRITE(numout,*) 'save watchout'
2413	!
2414	IF (long_print) THEN
2415	WRITE(numout,*) "intersurf : write watchout for date ",date0,date0_shifted,itau_sechiba, &
2416	& last_action_watch,last_check_watch
2417	ENDIF
2418	last_action_watch = itau_sechiba
2419
2420	sum_zlev(:) = sum_zlev(:) / dt_split_watch
2421	sum_u(:) = sum_u(:) / dt_split_watch
2422	sum_v(:) = sum_v(:) / dt_split_watch
2423	sum_qair(:) = sum_qair(:) / dt_split_watch
2424	sum_temp_air(:) = sum_temp_air(:) / dt_split_watch
2425	sum_epot_air(:) = sum_epot_air(:) / dt_split_watch
2426	sum_ccanopy(:) = sum_ccanopy(:) / dt_split_watch
2427	sum_cdrag(:) = sum_cdrag(:) / dt_split_watch
2428	sum_petAcoef(:) = sum_petAcoef(:) / dt_split_watch
2429	sum_peqAcoef(:) = sum_peqAcoef(:) / dt_split_watch
2430	sum_petBcoef(:) = sum_petBcoef(:) / dt_split_watch
2431	sum_peqBcoef(:) = sum_peqBcoef(:) / dt_split_watch
2432	sum_rain(:) = sum_rain(:) / dt_split_watch
2433	sum_snow(:) = sum_snow(:) / dt_split_watch
2434	sum_lwdown(:) = sum_lwdown(:) / dt_split_watch
2435	sum_pb(:) = sum_pb(:) / dt_split_watch
2436
2437	!!$ IF ( dt_watch > 3600 ) THEN
2438	!!$ WHERE ( isinang(:,:) .GT. 0 )
2439	!!$ mean_sinang(:,:) = mean_sinang(:,:) / isinang(:,:)
2440	!!$ ENDWHERE
2441	!!$ !
2442	!!$ DO ik=1,kjpindex
2443	!!$ j = ((kindex(ik)-1)/iim) + 1
2444	!!$ i = (kindex(ik) - (j-1)*iim)
2445	!!$ IF (mean_sinang(i,j) > zero) THEN
2446	!!$ sum_swdown(ik) = sum_swdown(ik)/mean_sinang(i,j)
2447	!!$ sum_swnet(ik) = sum_swnet(ik)/mean_sinang(i,j)
2448	!!$ ELSE
2449	!!$ sum_swdown(ik) = zero
2450	!!$ sum_swnet(ik) = zero
2451	!!$ ENDIF
2452	!!$ ENDDO
2453	!!$ ELSE
2454	sum_swnet(:) = sum_swnet(:) / dt_split_watch
2455	sum_swdown(:) = sum_swdown(:) / dt_split_watch
2456	!!$ ENDIF
2457
2458	CALL watchout_write_p(kjpindex, itau_sechiba, xrdt, sum_zlev, sum_swdown, sum_rain, &
2459	& sum_snow, sum_lwdown, sum_pb, sum_temp_air, sum_epot_air, sum_qair, &
2460	& sum_u, sum_v, sum_swnet, sum_petAcoef, sum_peqAcoef, sum_petBcoef, sum_peqBcoef, &
2461	& sum_cdrag, sum_ccanopy )
2462	ENDIF
2463	ENDIF
2464	!
2465	! 6. scatter output fields
2466	!
2467	z0(:) = undef_sechiba
2468	coastalflow(:) = undef_sechiba
2469	riverflow(:) = undef_sechiba
2470	tsol_rad(:) = undef_sechiba
2471	vevapp(:) = undef_sechiba
2472	temp_sol_new(:) = undef_sechiba
2473	qsurf(:) = undef_sechiba
2474	albedo(:,1) = undef_sechiba
2475	albedo(:,2) = undef_sechiba
2476	fluxsens(:) = undef_sechiba
2477	fluxlat(:) = undef_sechiba
2478	emis(:) = undef_sechiba
2479	cdrag(:) = undef_sechiba
2480	!
2481	! dvevapp(:) = undef_sechiba
2482	dtemp_sol(:) = undef_sechiba
2483	dfluxsens(:) = undef_sechiba
2484	dfluxlat(:) = undef_sechiba
2485	dswnet (:) = undef_sechiba
2486	dswdown (:) = undef_sechiba
2487	dalbedo (:,1) = undef_sechiba
2488	dalbedo (:,2) = undef_sechiba
2489	dtair (:) = undef_sechiba
2490	dqair (:) = undef_sechiba
2491	dt2m (:) = undef_sechiba
2492	dq2m (:) = undef_sechiba
2493	!
2494	DO ik=1, kjpindex
2495
2496	z0(ik) = zz0(ik)
2497	coastalflow(ik) = zcoastal(ik)/1000.
2498	riverflow(ik) = zriver(ik)/1000.
2499	tsol_rad(ik) = ztsol_rad(ik)
2500	vevapp(ik) = zvevapp(ik)
2501	temp_sol_new(ik) = ztemp_sol_new(ik)
2502	qsurf(ik) = zqsurf(ik)
2503	albedo(ik,1) = zalbedo(ik,1)
2504	albedo(ik,2) = zalbedo(ik,2)
2505	fluxsens(ik) = zfluxsens(ik)
2506	fluxlat(ik) = zfluxlat(ik)
2507	emis(ik) = zemis(ik)
2508	cdrag(ik) = zcdrag(ik)
2509
2510	! Fill up the diagnostic arrays
2511
2512	! dvevapp(kindex(ik)) = zvevapp(ik)
2513	dtemp_sol(kindex(ik)) = ztemp_sol_new(ik)
2514	dfluxsens(kindex(ik)) = zfluxsens(ik)
2515	dfluxlat(kindex(ik)) = zfluxlat(ik)
2516	dswnet (kindex(ik)) = swnet(ik)
2517	dswdown (kindex(ik)) = swdown(ik)
2518	dalbedo (kindex(ik),1) = zalbedo(ik,1)
2519	dalbedo (kindex(ik),2) = zalbedo(ik,2)
2520	dtair (kindex(ik)) = temp_air(ik)
2521	dqair (kindex(ik)) = qair(ik)
2522	dt2m (kindex(ik)) = t2m(ik)
2523	dq2m (kindex(ik)) = q2m(ik)
2524	!
2525	ENDDO
2526	!
2527	! Modified fields for variables scattered during the writing
2528	!
2529	dcoastal(:) = (zcoastal(:))/1000.
2530	driver(:) = (zriver(:))/1000.
2531	!
2532	IF ( .NOT. l_first_intersurf) THEN
2533	!
2534	IF ( .NOT. almaoutput ) THEN
2535	!
2536	! scattered during the writing
2537	!
2538	CALL histwrite (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
2539	CALL histwrite (hist_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
2540	CALL histwrite (hist_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
2541	!
2542	CALL histwrite (hist_id, 'temp_sol', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2543	CALL histwrite (hist_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2544	CALL histwrite (hist_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2545	CALL histwrite (hist_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
2546	CALL histwrite (hist_id, 'fluxlat', itau_sechiba, dfluxlat, iim*jjm, kindex)
2547	CALL histwrite (hist_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
2548	CALL histwrite (hist_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
2549	CALL histwrite (hist_id, 'alb_vis', itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
2550	CALL histwrite (hist_id, 'alb_nir', itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
2551	CALL histwrite (hist_id, 'tair', itau_sechiba, dtair, iim*jjm, kindex)
2552	CALL histwrite (hist_id, 'qair', itau_sechiba, dqair, iim*jjm, kindex)
2553	CALL histwrite (hist_id, 't2m', itau_sechiba, dq2m, iim*jjm, kindex)
2554	CALL histwrite (hist_id, 'q2m', itau_sechiba, dt2m, iim*jjm, kindex)
2555	!
2556	IF ( hist2_id > 0 ) THEN
2557	CALL histwrite (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
2558	CALL histwrite (hist2_id, 'coastalflow',itau_sechiba, dcoastal, kjpindex, kindex)
2559	CALL histwrite (hist2_id, 'riverflow',itau_sechiba, driver, kjpindex, kindex)
2560	!
2561	CALL histwrite (hist2_id, 'temp_sol', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2562	CALL histwrite (hist2_id, 'tsol_max', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2563	CALL histwrite (hist2_id, 'tsol_min', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2564	CALL histwrite (hist2_id, 'fluxsens', itau_sechiba, dfluxsens, iim*jjm, kindex)
2565	CALL histwrite (hist2_id, 'fluxlat', itau_sechiba, dfluxlat, iim*jjm, kindex)
2566	CALL histwrite (hist2_id, 'swnet', itau_sechiba, dswnet, iim*jjm, kindex)
2567	CALL histwrite (hist2_id, 'swdown', itau_sechiba, dswdown, iim*jjm, kindex)
2568	CALL histwrite (hist2_id, 'alb_vis', itau_sechiba, dalbedo(:,1), iim*jjm, kindex)
2569	CALL histwrite (hist2_id, 'alb_nir', itau_sechiba, dalbedo(:,2), iim*jjm, kindex)
2570	CALL histwrite (hist2_id, 'tair', itau_sechiba, dtair, iim*jjm, kindex)
2571	CALL histwrite (hist2_id, 'qair', itau_sechiba, dqair, iim*jjm, kindex)
2572	CALL histwrite (hist2_id, 't2m', itau_sechiba, dq2m, iim*jjm, kindex)
2573	CALL histwrite (hist2_id, 'q2m', itau_sechiba, dt2m, iim*jjm, kindex)
2574	ENDIF
2575	ELSE
2576	CALL histwrite (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
2577	CALL histwrite (hist_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
2578	CALL histwrite (hist_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
2579	CALL histwrite (hist_id, 'Qle', itau_sechiba, dfluxlat, iim*jjm, kindex)
2580	CALL histwrite (hist_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2581	CALL histwrite (hist_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2582	!
2583	IF ( hist2_id > 0 ) THEN
2584	CALL histwrite (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
2585	CALL histwrite (hist2_id, 'SWnet', itau_sechiba, dswnet, iim*jjm, kindex)
2586	CALL histwrite (hist2_id, 'Qh', itau_sechiba, dfluxsens, iim*jjm, kindex)
2587	CALL histwrite (hist2_id, 'Qle', itau_sechiba, dfluxlat, iim*jjm, kindex)
2588	CALL histwrite (hist2_id, 'AvgSurfT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2589	CALL histwrite (hist2_id, 'RadT', itau_sechiba, dtemp_sol, iim*jjm, kindex)
2590	ENDIF
2591	ENDIF
2592	!
2593	IF (dw .EQ. xrdt) THEN
2594	CALL histsync(hist_id)
2595	ENDIF
2596	!
2597	ENDIF
2598	!
2599	! 7. Transform the water fluxes into Kg/m^2s and m^3/s
2600	!
2601	DO ik=1, kjpindex
2602
2603	vevapp(ik) = vevapp(ik)/xrdt
2604	coastalflow(ik) = coastalflow(ik)/xrdt
2605	riverflow(ik) = riverflow(ik)/xrdt
2606
2607	ENDDO
2608	!
2609	WRITE(numout,*) "Give fields to atmosphere."
2610
2611	! Fields for emission variables : to be transport by GCM to chemistry model.
2612	DO i_fields_out=1,nb_fields_out
2613	SELECT CASE(TRIM(field_out_names(i_fields_out)))
2614	CASE("fCO2_land")
2615	fields_out(:,i_fields_out)=znetco2(:)
2616	CASE("fCO2_land_use")
2617	fields_out(:,i_fields_out)=zcarblu(:)
2618	CASE DEFAULT
2619	CALL ipslerr (3,'intsurf_gathered_2m', &
2620	& 'You ask from GCM an unknown field '//TRIM(field_out_names(i_fields_out))//&
2621	& ' to ORCHIDEE for this specific version.',&
2622	& 'This model won''t be able to continue.', &
2623	& '(check your tracer parameters in GCM)')
2624	END SELECT
2625	ENDDO
2626	!
2627	IF ( lrestart_write .AND. ok_watchout .AND. is_root_prc ) THEN
2628	CALL watchout_close()
2629	ENDIF
2630	!
2631	IF(l_first_intersurf .AND. is_root_prc) CALL getin_dump
2632	l_first_intersurf = .FALSE.
2633	!
2634	IF (long_print) WRITE (numout,*) ' intersurf_main done '
2635	!
2636	CALL ipslnlf(new_number=old_fileout)
2637	!
2638	END SUBROUTINE intersurf_gathered_2m
2639	!
2640	!-------------------------------------------------------------------------------------
2641	!
2642	SUBROUTINE intsurf_time(istp, date0, dt)
2643	!
2644	! This subroutine initialized the time global variables in grid module.
2645	!
2646	IMPLICIT NONE
2647	!
2648	INTEGER(i_std), INTENT(in) :: istp !! Time step of the restart file
2649	REAL(r_std), INTENT(in) :: date0 !! The date at which itau = 0
2650	REAL(r_std), INTENT(in) :: dt !! Time step
2651	!
2652	! LOCAL
2653	LOGICAL :: check=.FALSE.
2654
2655	IF (l_first_intersurf) THEN
2656	CALL ioget_calendar(calendar_str)
2657	CALL ioget_calendar(one_year, one_day)
2658	CALL tlen2itau('1Y',dt,date0,year_length)
2659	IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN
2660	year_spread=un
2661	ELSE
2662	year_spread = one_year/365.2425
2663	ENDIF
2664
2665	IF (check) THEN
2666	write(numout,*) "calendar_str =",calendar_str
2667	write(numout,*) "one_year=",one_year,", one_day=",one_day
2668	write(numout,*) "dt=",dt,", date0=",date0,", year_length=",year_length,", year_spread=",year_spread
2669	ENDIF
2670	ENDIF
2671
2672	!
2673	IF (check) &
2674	WRITE(numout,*) "---"
2675	! Dans diffuco (ie date0 == date0_shift !!)
2676
2677	IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN
2678	!
2679	! Get Julian date
2680	in_julian = itau2date(istp, date0, dt)
2681
2682	! Real date
2683	CALL ju2ymds (in_julian, year, month, day, sec)
2684	!!$ jur=zero
2685	!!$ julian_diff = in_julian
2686	!!$ month_len = ioget_mon_len (year,month)
2687	!!$ IF (check) THEN
2688	!!$ write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff
2689	!!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
2690	!!$ ENDIF
2691
2692	! julian number for january, the first.
2693	CALL ymds2ju (year,1,1,zero, julian0)
2694	julian_diff = in_julian-julian0
2695	! real number of seconds
2696	! sec = (julian_diff-REAL(INT(julian_diff)))*one_day
2697	sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
2698	month_len = ioget_mon_len (year,month)
2699	IF (check) THEN
2700	write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff
2701	write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
2702	ENDIF
2703	ELSE
2704	!!$ in_julian = itau2date(istp-1, zero, dt)
2705	!!$ CALL ju2ymds (in_julian, year, month, day, sec)
2706	!!$ jur=zero
2707	!!$ julian_diff = in_julian
2708	!!$ month_len = ioget_mon_len (year,month)
2709	!!$ IF (check) THEN
2710	!!$ write(numout,*) "in_julian=",in_julian, jur, julian_diff
2711	!!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
2712	!!$ ENDIF
2713	!!$
2714	!!$
2715	!!$ CALL ymds2ju (year,1,1,zero, jur)
2716	!!$ julian_diff = in_julian-jur
2717	!!$ CALL ju2ymds (julian_diff, year, month, day, sec)
2718	!!$! sec = (julian_diff-REAL(INT(julian_diff)))*one_day
2719	!!$ sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
2720	!!$ month_len = ioget_mon_len (year,month)
2721	!!$ IF (check) THEN
2722	!!$ write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff
2723	!!$ write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
2724	!!$ ENDIF
2725
2726
2727	!!$ IF (check) &
2728	!!$ WRITE(numout,*) "-"
2729
2730	!MM
2731	!PB date0 = celui de Soenke (Ã tester avec un autre date0)
2732	! in_julian = itau2date(istp, 153116., dt)
2733	in_julian = itau2date(istp, date0, dt)
2734	CALL itau2ymds(istp, dt, year, month, day, sec)
2735	CALL ymds2ju (year,1,1,zero, julian0)
2736	julian_diff = in_julian
2737	month_len = ioget_mon_len (year,month)
2738	IF (check) THEN
2739	write(numout,*) "in_julian=",in_julian, julian0, julian_diff
2740	write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
2741	ENDIF
2742	ENDIF
2743	!!$ IF (check) &
2744	!!$ WRITE(numout,*) "---"
2745
2746	END SUBROUTINE intsurf_time
2747	!
2748
2749	!-------------------------------------------------------------------------------------
2750	!
2751	SUBROUTINE intsurf_config(control_flags,dt)
2752	!
2753	! This subroutine reads all the configuration flags which control the behaviour of the model
2754	!
2755	IMPLICIT NONE
2756	!
2757	REAL, INTENT(in) :: dt !! Time step in seconds
2758	!
2759	TYPE(control_type), INTENT(out) :: control_flags !! Flags that (de)activate parts of the model
2760
2761
2762	!
2763	!Config Key = NVM
2764	!Config Desc = number of PFTs
2765	CALL getin_p('NVM',nvm)
2766	WRITE(numout,*)'the number of pfts is : ', nvm
2767	!
2768	!Config Key = LONGPRINT
2769	!Config Desc = ORCHIDEE will print more messages
2770	!Config Def = n
2771	!Config Help = This flag permits to print more debug messages in the run.
2772	!
2773	long_print = .FALSE.
2774	CALL getin_p('LONGPRINT',long_print)
2775	!
2776	!
2777	!Config Key = ORCHIDEE_WATCHOUT
2778	!Config Desc = ORCHIDEE will write out its forcing to a file
2779	!Config Def = n
2780	!Config Help = This flag allows to write to a file all the variables
2781	!Config which are used to force the land-surface. The file
2782	!Config has exactly the same format than a normal off-line forcing
2783	!Config and thus this forcing can be used for forcing ORCHIDEE.
2784	!
2785	ok_watchout = .FALSE.
2786	CALL getin_p('ORCHIDEE_WATCHOUT',ok_watchout)
2787	!
2788	IF (ok_watchout) THEN
2789	!Config Key = DT_WATCHOUT
2790	!Config Desc = ORCHIDEE will write out with this frequency
2791	!Config IF = ORCHIDEE_WATCHOUT
2792	!Config Def = dt
2793	!Config Help = This flag indicates the frequency of the write of the variables.
2794	!
2795	dt_watch = dt
2796	CALL getin_p('DT_WATCHOUT',dt_watch)
2797	dt_split_watch = dt_watch / dt
2798	!
2799	!Config Key = WATCHOUT_FILE
2800	!Config Desc = Filenane for the ORCHIDEE forcing file
2801	!Config IF = ORCHIDEE_WATCHOUT
2802	!Config Def = orchidee_watchout.nc
2803	!Config Help = This is the name of the file in which the
2804	!Config forcing used here will be written for later use.
2805	!
2806	watchout_file = "orchidee_watchout.nc"
2807	CALL getin_p('WATCHOUT_FILE',watchout_file)
2808
2809	WRITE(numout,*) 'WATCHOUT flag :', ok_watchout
2810	WRITE(numout,*) 'WATCHOUT file :', watchout_file
2811	ENDIF
2812
2813	!!$ DS : reading of IMPOSE_PARAM
2814	! Option : do you want to change the values of the parameters
2815	CALL getin_p('IMPOSE_PARAM',impose_param)
2816	CALL pft_parameters_main
2817	!
2818	!Config Key = RIVER_ROUTING
2819	!Config Desc = Decides if we route the water or not
2820	!Config Def = n
2821	!Config Help = This flag allows the user to decide if the runoff
2822	!Config and drainage should be routed to the ocean
2823	!Config and to downstream grid boxes.
2824	!
2825	control_flags%river_routing = .FALSE.
2826	CALL getin_p('RIVER_ROUTING', control_flags%river_routing)
2827	WRITE(numout,*) "RIVER routing is activated : ",control_flags%river_routing
2828	!
2829	!!$ DS : reading of parameters associated to river_routing
2830	IF ( control_flags%river_routing ) THEN
2831	CALL getin_routing_parameters
2832	ENDIF
2833
2834	!
2835	!Config key = HYDROL_CWRR
2836	!Config Desc = Allows to switch on the multilayer hydrology of CWRR
2837	!Config Def = n
2838	!Config Help = This flag allows the user to decide if the vertical
2839	!Config hydrology should be treated using the multi-layer
2840	!Config diffusion scheme adapted from CWRR by Patricia de Rosnay.
2841	!Config by default the Choisnel hydrology is used.
2842	!
2843	control_flags%hydrol_cwrr = .FALSE.
2844	CALL getin_p('HYDROL_CWRR', control_flags%hydrol_cwrr)
2845	IF ( control_flags%hydrol_cwrr ) then
2846	CALL ipslerr (2,'intsurf_config', &
2847	& 'You will use in this run the second version of CWRR hydrology in ORCHIDEE.',&
2848	& 'This model hasn''t been tested for global run yet.', &
2849	& '(check your parameters)')
2850	ENDIF
2851	!
2852	!!$ DS : reading of parameters associated to hydrol_cwrr
2853	IF ( control_flags%hydrol_cwrr ) THEN
2854	CALL getin_hydrol_cwrr_parameters
2855	ELSE
2856	CALL getin_hydrolc_parameters
2857	! we read the parameters for the choisnel hydrology
2858	ENDIF
2859
2860	!
2861	!Config Key = STOMATE_OK_CO2
2862	!Config Desc = Activate CO2?
2863	!Config Def = n
2864	!Config Help = set to TRUE if photosynthesis is to be activated
2865	!
2866	control_flags%ok_co2 = .FALSE.
2867	CALL getin_p('STOMATE_OK_CO2', control_flags%ok_co2)
2868	WRITE(numout,*) 'photosynthesis: ', control_flags%ok_co2
2869	!
2870	!!$ DS : reading of parameters associated to ok_co2
2871	IF ( control_flags%ok_co2 ) THEN
2872	CALL getin_co2_parameters
2873	ENDIF
2874
2875	!
2876	!Config Key = STOMATE_OK_STOMATE
2877	!Config Desc = Activate STOMATE?
2878	!Config Def = n
2879	!Config Help = set to TRUE if STOMATE is to be activated
2880	!
2881	control_flags%ok_stomate = .FALSE.
2882	CALL getin_p('STOMATE_OK_STOMATE',control_flags%ok_stomate)
2883	WRITE(numout,*) 'STOMATE is activated: ',control_flags%ok_stomate
2884	!
2885	!!$ DS : reading of parameters associated to ok_stomate
2886	IF ( control_flags%ok_stomate ) THEN
2887	CALL getin_stomate_parameters
2888	IF ( impose_param ) THEN
2889	CALL getin_stomate_pft_parameters
2890	WRITE(numout,*)' some stomate_pft_parameters have been imposed '
2891	ELSE
2892	WRITE(numout,*)' all stomate_pft_parameters are set to default values'
2893	ENDIF
2894	ENDIF
2895
2896	!
2897	!Config Key = STOMATE_OK_DGVM
2898	!Config Desc = Activate DGVM?
2899	!Config Def = n
2900	!Config Help = set to TRUE if DGVM is to be activated
2901	!
2902	control_flags%ok_dgvm = .FALSE.
2903	CALL getin_p('STOMATE_OK_DGVM',control_flags%ok_dgvm)
2904
2905	IF ( control_flags%ok_dgvm ) THEN
2906	WRITE(numout,*) 'You try to use LPJ ',control_flags%ok_dgvm, &
2907	' with this version. '
2908	WRITE(numout,*) 'It is not possible because it has to be modified ', &
2909	' to give correct values.'
2910	CALL ipslerr (2,'intsurf_config', &
2911	& 'Use of STOMATE_OK_DGVM is not stable for this version.',&
2912	& 'ORCHIDEE should not give correct results with this option activated.', &
2913	& 'Please disable DGVM to use this version of ORCHIDEE.')
2914	ENDIF
2915	!
2916	!!$ DS : reading of parameters associated to ok_dgvm
2917	IF ( control_flags%ok_dgvm ) THEN
2918	CALL getin_dgvm_parameters
2919	ENDIF
2920
2921	!
2922	! control initialisation with sechiba
2923	!
2924	control_flags%ok_sechiba = .TRUE.
2925	!!$ DS : reading of parameters associated to ok_sechiba
2926	IF ( control_flags%ok_sechiba ) THEN
2927	CALL getin_sechiba_parameters
2928	IF ( impose_param ) THEN
2929	CALL getin_sechiba_pft_parameters
2930	WRITE(numout,*)' some sechiba_pft_parameters have been imposed '
2931	ELSE
2932	WRITE(numout,*)' all sechiba_pft_parameters are set to default values'
2933	ENDIF
2934	ENDIF
2935
2936	!
2937	!
2938	! Ensure consistency
2939	!
2940	IF ( control_flags%ok_dgvm ) control_flags%ok_stomate = .TRUE.
2941	IF ( control_flags%ok_stomate ) control_flags%ok_co2 = .TRUE.
2942	!
2943	!Config Key = STOMATE_WATCHOUT
2944	!Config Desc = STOMATE does minimum service
2945	!Config Def = n
2946	!Config Help = set to TRUE if you want STOMATE to read
2947	!Config and write its start files and keep track
2948	!Config of longer-term biometeorological variables.
2949	!Config This is useful if OK_STOMATE is not set,
2950	!Config but if you intend to activate STOMATE later.
2951	!Config In that case, this run can serve as a
2952	!Config spinup for longer-term biometeorological
2953	!Config variables.
2954	!
2955	control_flags%stomate_watchout = .FALSE.
2956	CALL getin_p('STOMATE_WATCHOUT',control_flags%stomate_watchout)
2957	WRITE(numout,*) 'STOMATE keeps an eye open: ',control_flags%stomate_watchout
2958	!
2959	! Here we need the same initialisation as above
2960	!
2961	control_flags%ok_pheno = .TRUE.
2962	!
2963	!>> july 2011
2964	! DS: activation of sub-models of ORCHIDEE
2965	CALL activate_sub_models(control_flags%ok_sechiba, control_flags%river_routing,control_flags%ok_stomate)
2966	! Vegetation configuration(impose_veg, land_use, lcchnage...previously in slowproc)
2967	CALL veget_config
2968	!
2969	RETURN
2970	!
2971	END SUBROUTINE intsurf_config
2972	!
2973	!
2974	!
2975	SUBROUTINE intsurf_restart(istp, iim, jjm, lon, lat, date0, dt, control_flags, rest_id, rest_id_stom, itau_offset)
2976	!
2977	! This subroutine initialized the restart file for the land-surface scheme
2978	!
2979	IMPLICIT NONE
2980	!
2981	INTEGER(i_std), INTENT(in) :: istp !! Time step of the restart file
2982	INTEGER(i_std), INTENT(in) :: iim, jjm !! Size in x and y of the data to be handeled
2983	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Logitude and latitude of the data points
2984	REAL(r_std) :: date0 !! The date at which itau = 0
2985	REAL(r_std) :: dt !! Time step
2986	INTEGER(i_std), INTENT(out) :: rest_id, rest_id_stom !! ID of the restart file
2987	INTEGER(i_std), INTENT(out) :: itau_offset
2988	!
2989	TYPE(control_type), INTENT(in) :: control_flags !! Flags that (de)activate parts of the model
2990	!
2991	! LOCAL
2992	!
2993	CHARACTER(LEN=80) :: restname_in, restname_out, stom_restname_in, stom_restname_out
2994	REAL(r_std) :: dt_rest, date0_rest
2995	INTEGER(i_std) :: itau_dep
2996	INTEGER(i_std),PARAMETER :: llm=1
2997	REAL(r_std), DIMENSION(llm) :: lev
2998	LOGICAL :: overwrite_time
2999	REAL(r_std) :: in_julian, rest_julian
3000	INTEGER(i_std) :: yy, mm, dd
3001	REAL(r_std) :: ss
3002	!
3003	!Config Key = SECHIBA_restart_in
3004	!Config Desc = Name of restart to READ for initial conditions
3005	!Config Def = NONE
3006	!Config Help = This is the name of the file which will be opened
3007	!Config to extract the initial values of all prognostic
3008	!Config values of the model. This has to be a netCDF file.
3009	!Config Not truly COADS compliant. NONE will mean that
3010	!Config no restart file is to be expected.
3011	!-
3012	restname_in = 'NONE'
3013	CALL getin_p('SECHIBA_restart_in',restname_in)
3014	WRITE(numout,*) 'INPUT RESTART_FILE', restname_in
3015	!-
3016	!Config Key = SECHIBA_rest_out
3017	!Config Desc = Name of restart files to be created by SECHIBA
3018	!Config Def = sechiba_rest_out.nc
3019	!Config Help = This variable give the name for
3020	!Config the restart files. The restart software within
3021	!Config IOIPSL will add .nc if needed.
3022	!
3023	restname_out = 'restart_out.nc'
3024	CALL getin_p('SECHIBA_rest_out', restname_out)
3025	!
3026	!Config Key = SECHIBA_reset_time
3027	!Config Desc = Option to overrides the time of the restart
3028	!Config Def = n
3029	!Config Help = This option allows the model to override the time
3030	!Config found in the restart file of SECHIBA with the time
3031	!Config of the first call. That is the restart time of the GCM.
3032	!
3033	overwrite_time = .FALSE.
3034	CALL getin_p('SECHIBA_reset_time', overwrite_time)
3035	!
3036	lev(:) = zero
3037	itau_dep = istp
3038	in_julian = itau2date(istp, date0, dt)
3039	date0_rest = date0
3040	dt_rest = dt
3041	!
3042	IF (is_root_prc) THEN
3043	CALL restini( restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
3044	& restname_out, itau_dep, date0_rest, dt_rest, rest_id, overwrite_time)
3045	ELSE
3046	rest_id=0
3047	ENDIF
3048	CALL bcast (itau_dep)
3049	CALL bcast (date0_rest)
3050	CALL bcast (dt_rest)
3051	!
3052	! itau_dep of SECHIBA is phased with the GCM if needed
3053	!
3054	rest_julian = itau2date(itau_dep, date0_rest, dt_rest)
3055	!
3056	IF ( ABS( in_julian - rest_julian) .GT. dt/one_day .AND. .NOT. OFF_LINE_MODE ) THEN
3057	IF ( overwrite_time ) THEN
3058	WRITE(numout,*) 'The SECHIBA restart is not for the same timestep as the GCM,'
3059	WRITE(numout,*) 'the two are synchronized. The land-surface conditions can not impose'
3060	WRITE(numout,*) 'the chronology of the simulation.'
3061	WRITE(numout,*) 'Time step of the GCM :', istp, 'Julian day : ', in_julian
3062	CALL ju2ymds(in_julian, yy, mm, dd, ss)
3063	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3064	WRITE(numout,*) 'Time step of SECHIBA :', itau_dep, 'Julian day : ', rest_julian
3065	CALL ju2ymds(rest_julian, yy, mm, dd, ss)
3066	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3067
3068	itau_offset = itau_dep - istp
3069	date0_shifted = date0 - itau_offset*dt/one_day
3070	!MM_ A VOIR : dans le TAG 1.4 :
3071	! date0_shifted = in_julian - itau_dep*dt/one_day
3072	!MM_ Bon calcul ?
3073
3074	WRITE(numout,*) 'The new starting date is :', date0_shifted
3075	CALL ju2ymds(date0_shifted, yy, mm, dd, ss)
3076	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3077	ELSE
3078	WRITE(numout,*) 'IN -> OUT :', istp, '->', itau_dep
3079	WRITE(numout,*) 'IN -> OUT :', in_julian, '->', rest_julian
3080	WRITE(numout,*) 'SECHIBA''s restart file is not consistent with the one of the GCM'
3081	WRITE(numout,*) 'Correct the time axis of the restart file or force the code to change it.'
3082	STOP
3083	ENDIF
3084	ELSE
3085	itau_offset = 0
3086	date0_shifted = date0
3087	ENDIF
3088	!
3089	!!! CALL ioconf_startdate(date0_shifted)
3090	!
3091	!=====================================================================
3092	!- 1.5 Restart file for STOMATE
3093	!=====================================================================
3094	IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN
3095	!-
3096	! STOMATE IS ACTIVATED
3097	!-
3098	!Config Key = STOMATE_RESTART_FILEIN
3099	!Config Desc = Name of restart to READ for initial conditions
3100	!Config of STOMATE
3101	!Config If = STOMATE_OK_STOMATE \|\| STOMATE_WATCHOUT
3102	!Config Def = NONE
3103	!Config Help = This is the name of the file which will be opened
3104	!Config to extract the initial values of all prognostic
3105	!Config values of STOMATE.
3106	!-
3107	stom_restname_in = 'NONE'
3108	CALL getin_p('STOMATE_RESTART_FILEIN',stom_restname_in)
3109	WRITE(numout,*) 'STOMATE INPUT RESTART_FILE', stom_restname_in
3110	!-
3111	!Config Key = STOMATE_RESTART_FILEOUT
3112	!Config Desc = Name of restart files to be created by STOMATE
3113	!Config If = STOMATE_OK_STOMATE \|\| STOMATE_WATCHOUT
3114	!Config Def = stomate_restart.nc
3115	!Config Help = This is the name of the file which will be opened
3116	!Config to write the final values of all prognostic values
3117	!Config of STOMATE.
3118	!-
3119	stom_restname_out = 'stomate_restart.nc'
3120	CALL getin_p('STOMATE_RESTART_FILEOUT', stom_restname_out)
3121	WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE', stom_restname_out
3122	!-
3123	IF (is_root_prc) THEN
3124	CALL restini (stom_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
3125	& stom_restname_out, itau_dep, date0_rest, dt_rest, rest_id_stom, overwrite_time)
3126	ELSE
3127	rest_id_stom=0
3128	ENDIF
3129	CALL bcast (itau_dep)
3130	CALL bcast (date0_rest)
3131	CALL bcast (dt_rest)
3132	!-
3133	ENDIF
3134	!
3135	END SUBROUTINE intsurf_restart
3136
3137	SUBROUTINE intsurf_history(iim, jjm, lon, lat, istp_old, date0, dt, control_flags, hist_id, hist2_id, &
3138	& hist_id_stom, hist_id_stom_IPCC)
3139	!
3140	!
3141	! This subroutine initialized the history files for the land-surface scheme
3142	!
3143	IMPLICIT NONE
3144	!
3145	INTEGER(i_std), INTENT(in) :: iim, jjm !! Size in x and y of the data to be handeled
3146	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Longitude and latitude of the data points
3147	INTEGER(i_std), INTENT(in) :: istp_old !! Time step counter
3148	REAL(r_std), INTENT(in) :: date0 !! Julian day at which istp=0
3149	REAL(r_std), INTENT(in) :: dt !! Time step of the counter in seconds
3150	!
3151	TYPE(control_type), INTENT(in) :: control_flags !! Flags that (de)activate parts of the model
3152	!
3153	INTEGER(i_std), INTENT(out) :: hist_id !! History file identification for SECHIBA
3154	INTEGER(i_std), INTENT(out) :: hist2_id !! History file 2 identification for SECHIBA (Hi-frequency ?)
3155	!! History file identification for STOMATE and IPCC
3156	INTEGER(i_std), INTENT(out) :: hist_id_stom, hist_id_stom_IPCC
3157	!
3158	! LOCAL
3159	!
3160	CHARACTER(LEN=80) :: histname,histname2 !! Name of history files for SECHIBA
3161	CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname !! Name of history files for STOMATE
3162	LOGICAL :: ok_histfile2 !! Flag to switch on histfile 2 for SECHIBA
3163	REAL(r_std) :: dw2 !! frequency of history write (sec.)
3164	CHARACTER(LEN=30) :: flux_op !! Operations to be performed on fluxes
3165	CHARACTER(LEN=30) :: flux_sc !! Operations which do not include a scatter
3166	CHARACTER(LEN=30) :: flux_insec, flux_scinsec !! Operation in seconds
3167	INTEGER(i_std) :: hist_level, hist2_level !! history output level (default is 10 => maximum output)
3168	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
3169	& ave, avecels, avescatter, fluxop, &
3170	& fluxop_scinsec, tmincels, tmaxcels, once, sumscatter !! The various operation to be performed
3171	!!, tmax, fluxop_sc, fluxop_insec, &
3172	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
3173	& ave2, avecels2, avescatter2, fluxop2, &
3174	& fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2 !! The various operation to be performed
3175	!!, tmax2, fluxop_sc2, fluxop_insec2, &
3176	INTEGER(i_std) :: i, jst
3177	! SECHIBA AXIS
3178	INTEGER(i_std) :: hori_id !! ID of the default horizontal longitude and latitude map.
3179	INTEGER(i_std) :: vegax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
3180	INTEGER(i_std) :: solayax_id !! ID for the vertical axis of the CWRR hydrology
3181	INTEGER(i_std) :: hori_id2 !! ID of the default horizontal longitude and latitude map.
3182	INTEGER(i_std) :: vegax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
3183	INTEGER(i_std) :: solayax_id2 !! ID for the vertical axis of the CWRR hydrology
3184	! STOMATE AXIS
3185	INTEGER(i_std) :: hist_PFTaxis_id
3186	! deforestation
3187	INTEGER(i_std) :: hist_pool_10axis_id
3188	INTEGER(i_std) :: hist_pool_100axis_id
3189	INTEGER(i_std) :: hist_pool_11axis_id
3190	INTEGER(i_std) :: hist_pool_101axis_id
3191	! STOMATE IPCC AXIS
3192	INTEGER(i_std) :: hist_IPCC_PFTaxis_id
3193	!
3194	LOGICAL :: rectilinear
3195	INTEGER(i_std) :: ier
3196	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
3197	!
3198	REAL(r_std),DIMENSION(nvm) :: veg
3199	REAL(r_std),DIMENSION(ngrnd) :: sol
3200	REAL(r_std),DIMENSION(nstm) :: soltyp
3201	REAL(r_std),DIMENSION(nnobio):: nobiotyp
3202	REAL(r_std),DIMENSION(2) :: albtyp
3203	REAL(r_std),DIMENSION(nslm) :: solay
3204	!
3205	CHARACTER(LEN=80) :: var_name !! To store variables names
3206	!
3207	! STOMATE history file
3208	REAL(r_std) :: hist_days_stom !!- GK time step in days for this history file
3209	REAL(r_std) :: hist_dt_stom !!- GK time step in seconds for this history file
3210	REAL(r_std) :: dt_slow_ !! for test : time step of slow processes and STOMATE
3211	REAL(r_std),DIMENSION(nvm) :: hist_PFTaxis !!- GK An axis we need for the history files
3212	!
3213	REAL(r_std),DIMENSION(10) :: hist_pool_10axis !! Deforestation axis
3214	REAL(r_std),DIMENSION(100) :: hist_pool_100axis !! Deforestation axis
3215	REAL(r_std),DIMENSION(11) :: hist_pool_11axis !! Deforestation axis
3216	REAL(r_std),DIMENSION(101) :: hist_pool_101axis !! Deforestation axis
3217	!
3218	! IPCC history file
3219	REAL(r_std) :: hist_days_stom_ipcc !!- GK time step in days for this history file
3220	REAL(r_std) :: hist_dt_stom_ipcc !!- GK time step in seconds for this history file
3221	!
3222	!
3223	!
3224	!=====================================================================
3225	!- 3.0 Setting up the history files
3226	!=====================================================================
3227	!- 3.1 SECHIBA
3228	!=====================================================================
3229	!Config Key = ALMA_OUTPUT
3230	!Config Desc = Should the output follow the ALMA convention
3231	!Config Def = n
3232	!Config Help = If this logical flag is set to true the model
3233	!Config will output all its data according to the ALMA
3234	!Config convention. It is the recommended way to write
3235	!Config data out of ORCHIDEE.
3236	!-
3237	almaoutput = .FALSE.
3238	CALL getin_p('ALMA_OUTPUT', almaoutput)
3239	WRITE(numout,*) 'ALMA_OUTPUT', almaoutput
3240	!-
3241	!Config Key = OUTPUT_FILE
3242	!Config Desc = Name of file in which the output is going
3243	!Config to be written
3244	!Config Def = cabauw_out.nc
3245	!Config Help = This file is going to be created by the model
3246	!Config and will contain the output from the model.
3247	!Config This file is a truly COADS compliant netCDF file.
3248	!Config It will be generated by the hist software from
3249	!Config the IOIPSL package.
3250	!-
3251	histname='cabauw_out.nc'
3252	CALL getin_p('OUTPUT_FILE', histname)
3253	WRITE(numout,*) 'OUTPUT_FILE', histname
3254	!-
3255	!Config Key = WRITE_STEP
3256	!Config Desc = Frequency in seconds at which to WRITE output
3257	!Config Def = one_day
3258	!Config Help = This variables gives the frequency the output of
3259	!Config the model should be written into the netCDF file.
3260	!Config It does not affect the frequency at which the
3261	!Config operations such as averaging are done.
3262	!Config That is IF the coding of the calls to histdef
3263	!Config are correct !
3264	!-
3265	dw = one_day
3266	CALL getin_p('WRITE_STEP', dw)
3267	!
3268	veg(1:nvm) = (/ (REAL(i,r_std),i=1,nvm) /)
3269	sol(1:ngrnd) = (/ (REAL(i,r_std),i=1,ngrnd) /)
3270	soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
3271	nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
3272	albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
3273	solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
3274	!
3275	!- We need to flux averaging operation as when the data is written
3276	!- from within SECHIBA a scatter is needed. In the driver on the other
3277	!- hand the data is 2D and can be written is it is.
3278	!-
3279	WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day/dt
3280	! WRITE(flux_op,'("(ave(scatter(X))*",F8.1,")")') one_day/dt
3281	WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt
3282	!WRITE(flux_sc,'("(ave(X)*",F8.1,")")') one_day/dt
3283	WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
3284	WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') un/dt
3285	WRITE(numout,*) flux_op, one_day/dt, dt, dw
3286	!-
3287	!Config Key = SECHIBA_HISTLEVEL
3288	!Config Desc = SECHIBA history output level (0..10)
3289	!Config Def = 5
3290	!Config Help = Chooses the list of variables in the history file.
3291	!Config Values between 0: nothing is written; 10: everything is
3292	!Config written are available More details can be found on the web under documentation.
3293	!Config web under documentation.
3294	!-
3295	hist_level = 5
3296	CALL getin_p('SECHIBA_HISTLEVEL', hist_level)
3297	!-
3298	WRITE(numout,*) 'SECHIBA history level: ',hist_level
3299	IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
3300	STOP 'This history level is not allowed'
3301	ENDIF
3302	!-
3303	!- define operations as a function of history level.
3304	!- Above hist_level, operation='never'
3305	!-
3306	ave(1:max_hist_level) = 'ave(X)'
3307	IF (hist_level < max_hist_level) THEN
3308	ave(hist_level+1:max_hist_level) = 'never'
3309	ENDIF
3310	sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
3311	IF (hist_level < max_hist_level) THEN
3312	sumscatter(hist_level+1:max_hist_level) = 'never'
3313	ENDIF
3314	avecels(1:max_hist_level) = 'ave(cels(X))'
3315	IF (hist_level < max_hist_level) THEN
3316	avecels(hist_level+1:max_hist_level) = 'never'
3317	ENDIF
3318	avescatter(1:max_hist_level) = 'ave(scatter(X))'
3319	IF (hist_level < max_hist_level) THEN
3320	avescatter(hist_level+1:max_hist_level) = 'never'
3321	ENDIF
3322	tmincels(1:max_hist_level) = 't_min(cels(X))'
3323	IF (hist_level < max_hist_level) THEN
3324	tmincels(hist_level+1:max_hist_level) = 'never'
3325	ENDIF
3326	tmaxcels(1:max_hist_level) = 't_max(cels(X))'
3327	IF (hist_level < max_hist_level) THEN
3328	tmaxcels(hist_level+1:max_hist_level) = 'never'
3329	ENDIF
3330	!!$ tmax(1:max_hist_level) = 't_max(X)'
3331	!!$ IF (hist_level < max_hist_level) THEN
3332	!!$ tmax(hist_level+1:max_hist_level) = 'never'
3333	!!$ ENDIF
3334	fluxop(1:max_hist_level) = flux_op
3335	IF (hist_level < max_hist_level) THEN
3336	fluxop(hist_level+1:max_hist_level) = 'never'
3337	ENDIF
3338	!!$ fluxop_sc(1:max_hist_level) = flux_sc
3339	!!$ IF (hist_level < max_hist_level) THEN
3340	!!$ fluxop_sc(hist_level+1:max_hist_level) = 'never'
3341	!!$ ENDIF
3342	!!$ fluxop_insec(1:max_hist_level) = flux_insec
3343	!!$ IF (hist_level < max_hist_level) THEN
3344	!!$ fluxop_insec(hist_level+1:max_hist_level) = 'never'
3345	!!$ ENDIF
3346	fluxop_scinsec(1:max_hist_level) = flux_scinsec
3347	IF (hist_level < max_hist_level) THEN
3348	fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
3349	ENDIF
3350	once(1:max_hist_level) = 'once(scatter(X))'
3351	IF (hist_level < max_hist_level) THEN
3352	once(hist_level+1:max_hist_level) = 'never'
3353	ENDIF
3354	!
3355	!-
3356	!- Check if we have by any change a rectilinear grid. This would allow us to
3357	!- simplify the output files.
3358	!
3359	rectilinear = .FALSE.
3360	IF ( ALL(lon(:,:) == SPREAD(lon(:,1), 2, SIZE(lon,2))) .AND. &
3361	& ALL(lat(:,:) == SPREAD(lat(1,:), 1, SIZE(lat,1))) ) THEN
3362	rectilinear = .TRUE.
3363	ALLOCATE(lon_rect(iim),stat=ier)
3364	IF (ier .NE. 0) THEN
3365	WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
3366	STOP 'intersurf_history'
3367	ENDIF
3368	ALLOCATE(lat_rect(jjm),stat=ier)
3369	IF (ier .NE. 0) THEN
3370	WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
3371	STOP 'intersurf_history'
3372	ENDIF
3373	lon_rect(:) = lon(:,1)
3374	lat_rect(:) = lat(1,:)
3375	ENDIF
3376	!-
3377	!-
3378	hist_id = -1
3379	!-
3380	IF ( .NOT. almaoutput ) THEN
3381	!-
3382	IF ( rectilinear ) THEN
3383	#ifdef CPP_PARA
3384	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3385	& istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
3386	#else
3387	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3388	& istp_old, date0, dt, hori_id, hist_id)
3389	#endif
3390	WRITE(numout,*) 'HISTBEG --->',istp_old,date0,dt,dw,hist_id
3391	ELSE
3392	#ifdef CPP_PARA
3393	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3394	& istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
3395	#else
3396	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3397	& istp_old, date0, dt, hori_id, hist_id)
3398	#endif
3399	ENDIF
3400	!-
3401	CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
3402	& nvm, veg, vegax_id)
3403	CALL histvert(hist_id, 'solth', 'Soil levels', 'm', &
3404	& ngrnd, sol, solax_id)
3405	CALL histvert(hist_id, 'soiltyp', 'Soil types', '1', &
3406	& nstm, soltyp, soltax_id)
3407	CALL histvert(hist_id, 'nobio', 'Other surface types', '1', &
3408	& nnobio, nobiotyp, nobioax_id)
3409	IF ( control_flags%hydrol_cwrr ) THEN
3410	CALL histvert(hist_id, 'solay', 'Hydrol soil levels', 'm', &
3411	& nslm, solay, solayax_id)
3412	ENDIF
3413	!-
3414	!- SECHIBA_HISTLEVEL = 1
3415	!-
3416	CALL histdef(hist_id, 'evap', 'Evaporation', 'mm/d', &
3417	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3418	CALL histdef(hist_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
3419	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3420	CALL histdef(hist_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
3421	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3422	CALL histdef(hist_id, 'temp_sol', 'Surface Temperature', 'C', &
3423	& iim,jjm, hori_id, 1,1,1, -99, 32, avecels(1), dt,dw)
3424	CALL histdef(hist_id, 'rain', 'Rainfall', 'mm/d', &
3425	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3426	CALL histdef(hist_id, 'snowf', 'Snowfall', 'mm/d', &
3427	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3428	CALL histdef(hist_id, 'netrad', 'Net radiation', 'W/m^2', &
3429	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3430	CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
3431	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
3432	IF ( control_flags%river_routing ) THEN
3433	CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
3434	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3435	CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
3436	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3437	ENDIF
3438	!-
3439	!- SECHIBA_HISTLEVEL = 2
3440	!-
3441	CALL histdef(hist_id, 'subli', 'Sublimation', 'mm/d', &
3442	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3443	CALL histdef(hist_id, 'evapnu', 'Bare soil evaporation', 'mm/d', &
3444	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3445	CALL histdef(hist_id, 'runoff', 'Surface runoff', 'mm/d', &
3446	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3447	CALL histdef(hist_id, 'drainage', 'Deep drainage', 'mm/d', &
3448	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3449	IF ( control_flags%river_routing ) THEN
3450	CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
3451	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3452	CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
3453	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
3454	ENDIF
3455	IF ( control_flags%hydrol_cwrr ) THEN
3456	CALL histdef(hist_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
3457	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3458	CALL histdef(hist_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
3459	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3460	CALL histdef(hist_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
3461	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3462	CALL histdef(hist_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
3463	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3464	ENDIF
3465	!
3466	CALL histdef(hist_id, 'tair', 'Air Temperature', 'K', &
3467	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3468	CALL histdef(hist_id, 'qair', 'Air humidity', 'g/g', &
3469	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3470	! Ajouts Nathalie - Juillet 2006
3471	CALL histdef(hist_id, 'q2m', '2m Air humidity', 'g/g', &
3472	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3473	CALL histdef(hist_id, 't2m', '2m Air Temperature', 'K', &
3474	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3475	! Fin ajouts Nathalie
3476	CALL histdef(hist_id, 'alb_vis', 'Albedo visible', '1', &
3477	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3478	CALL histdef(hist_id, 'alb_nir', 'Albedo near infrared', '1', &
3479	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3480	! Ajouts Nathalie - Septembre 2008
3481	CALL histdef(hist_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
3482	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3483	CALL histdef(hist_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
3484	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3485	CALL histdef(hist_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
3486	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3487	CALL histdef(hist_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
3488	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3489	! Fin ajouts Nathalie - Septembre 2008
3490	CALL histdef(hist_id, 'z0', 'Surface roughness', 'm', &
3491	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3492	CALL histdef(hist_id, 'roughheight', 'Effective roughness height', 'm', &
3493	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3494	CALL histdef(hist_id, 'transpir', 'Transpiration', 'mm/d', &
3495	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
3496	CALL histdef(hist_id, 'inter', 'Interception loss', 'mm/d', &
3497	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
3498	!-
3499	!- SECHIBA_HISTLEVEL = 3
3500	!-
3501	CALL histdef(hist_id, 'tsol_max', 'Maximum Surface Temperature',&
3502	& 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmaxcels(3), dt,dw)
3503	CALL histdef(hist_id, 'tsol_min', 'Minimum Surface Temperature',&
3504	& 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmincels(3), dt,dw)
3505	CALL histdef(hist_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2', &
3506	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
3507	CALL histdef(hist_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2', &
3508	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
3509	CALL histdef(hist_id, 'snow', 'Snow mass', 'kg/m^2', &
3510	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
3511	CALL histdef(hist_id, 'snowage', 'Snow age', '?', &
3512	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
3513	CALL histdef(hist_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
3514	& iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3515	CALL histdef(hist_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
3516	& iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3517	CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
3518	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3519	CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
3520	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3521	CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
3522	& iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3523	IF ( control_flags%hydrol_cwrr ) THEN
3524	DO jst=1,nstm
3525
3526	! var_name= "mc_1" ... "mc_3"
3527	WRITE (var_name,"('moistc_',i1)") jst
3528	CALL histdef(hist_id, var_name, 'Soil Moisture profile for soil type', '%', &
3529	& iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
3530
3531	! var_name= "vegetsoil_1" ... "vegetsoil_3"
3532	WRITE (var_name,"('vegetsoil_',i1)") jst
3533	CALL histdef(hist_id, var_name, 'Fraction of vegetation on soil types', '%', &
3534	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3535
3536	ENDDO
3537	ENDIF
3538	!-
3539	!- SECHIBA_HISTLEVEL = 4
3540	!-
3541	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3542	CALL histdef(hist_id, 'dss', 'Up-reservoir Height', 'm', &
3543	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3544	CALL histdef(hist_id, 'gqsb', 'Upper Soil Moisture', '1', &
3545	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3546	CALL histdef(hist_id, 'bqsb', 'Lower Soil Moisture', '1', &
3547	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3548	ELSE
3549	CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
3550	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3551	CALL histdef(hist_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m2', &
3552	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(4), dt,dw)
3553	ENDIF
3554	CALL histdef(hist_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
3555	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3556	CALL histdef(hist_id, 'rstruct', 'Structural resistance', 's/m', &
3557	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3558	IF ( control_flags%ok_co2 ) THEN
3559	CALL histdef(hist_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
3560	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3561	ENDIF
3562	IF ( control_flags%ok_stomate ) THEN
3563	CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
3564	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3565	CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
3566	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3567	CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
3568	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3569	CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
3570	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3571	CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
3572	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
3573	ENDIF
3574	CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d', &
3575	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
3576	CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1', &
3577	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
3578	CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d', &
3579	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
3580	CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d', &
3581	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
3582	!-
3583	!- SECHIBA_HISTLEVEL = 5
3584	!-
3585	CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2', &
3586	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
3587	CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2', &
3588	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
3589	CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2', &
3590	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3591	CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2', &
3592	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3593	CALL histdef(hist_id, 'temp_pheno', 'Temperature for Pheno', 'K', &
3594	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3595	!-
3596	!- SECHIBA_HISTLEVEL = 6
3597	!-
3598	CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
3599	& iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6), dt,dw)
3600	!-
3601	!- SECHIBA_HISTLEVEL = 7
3602	!-
3603	IF ( control_flags%river_routing ) THEN
3604	CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
3605	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3606	CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
3607	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3608	CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
3609	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3610	CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
3611	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3612	CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
3613	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
3614	CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
3615	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
3616	CALL histdef(hist_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
3617	& iim,jjm, hori_id, 1,1,1, -99, 32, once(7), dt,dw)
3618	ENDIF
3619	!-
3620	!- SECHIBA_HISTLEVEL = 8
3621	!-
3622	CALL histdef(hist_id, 'beta', 'Beta Function', '1', &
3623	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3624	CALL histdef(hist_id, 'raero', 'Aerodynamic resistance', 's/m', &
3625	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3626	! Ajouts Nathalie - Novembre 2006
3627	CALL histdef(hist_id, 'cdrag', 'Drag coefficient for LE and SH', '?', &
3628	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3629	CALL histdef(hist_id, 'Wind', 'Wind speed', 'm/s', &
3630	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3631	! Fin ajouts Nathalie
3632	!MM
3633	CALL histdef(hist_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
3634	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3635	CALL histdef(hist_id, 'vbeta1', 'Beta for sublimation', '1', &
3636	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3637	CALL histdef(hist_id, 'vbeta4', 'Beta for bare soil', '1', &
3638	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3639	CALL histdef(hist_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
3640	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
3641	CALL histdef(hist_id, 'soiltype', 'Fraction of soil textures', '%', &
3642	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(8), dt,dw)
3643	CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1', &
3644	& iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
3645	!-
3646	!- SECHIBA_HISTLEVEL = 9
3647	!-
3648	!-
3649	!- SECHIBA_HISTLEVEL = 10
3650	!-
3651	CALL histdef(hist_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
3652	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3653	CALL histdef(hist_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
3654	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3655	CALL histdef(hist_id, 'rveget', 'Canopy resistance', 's/m', &
3656	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3657	CALL histdef(hist_id, 'rsol', 'Soil resistance', 's/m', &
3658	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(10), dt,dw)
3659	CALL histdef(hist_id,'vbeta2','Beta for Interception loss','mm/d', &
3660	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3661	CALL histdef(hist_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
3662	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3663
3664	!- SECHIBA_HISTLEVEL = 11
3665	!-
3666
3667	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3668	CALL histdef(hist_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
3669	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3670
3671	CALL histdef(hist_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
3672	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3673
3674	CALL histdef(hist_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
3675	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3676
3677	CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
3678	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3679
3680	CALL histdef(hist_id, 'prveg', "Precipitation onto Canopy", "kg m-2 s-1", &
3681	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3682
3683	ENDIF
3684
3685
3686	CALL histdef(hist_id, 'evspsblveg', "Evaporation from Canopy", "kg m-2 s-1", &
3687	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3688
3689	CALL histdef(hist_id, 'evspsblsoi', "Water Evaporation from Soil", "kg m-2 s-1", &
3690	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3691
3692	CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
3693	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3694
3695	CALL histdef(hist_id, 'treeFrac', "Tree Cover Fraction", "%", &
3696	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3697
3698	CALL histdef(hist_id, 'grassFrac', "Natural Grass Fraction", "%", &
3699	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3700
3701	CALL histdef(hist_id, 'cropFrac', "Crop Fraction", "%", &
3702	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3703
3704	CALL histdef(hist_id, 'baresoilFrac', "Bare Soil Fraction", "%", &
3705	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3706
3707	CALL histdef(hist_id, 'residualFrac', &
3708	& "Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil", "%", &
3709	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3710
3711	ELSE
3712	!-
3713	!- This is the ALMA convention output now
3714	!-
3715	!-
3716	IF ( rectilinear ) THEN
3717	#ifdef CPP_PARA
3718	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3719	& istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
3720	#else
3721	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3722	& istp_old, date0, dt, hori_id, hist_id)
3723	#endif
3724	ELSE
3725	#ifdef CPP_PARA
3726	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3727	& istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
3728	#else
3729	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3730	& istp_old, date0, dt, hori_id, hist_id)
3731	#endif
3732	ENDIF
3733	!-
3734	CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
3735	& nvm, veg, vegax_id)
3736	CALL histvert(hist_id, 'solth', 'Soil levels', 'm', &
3737	& ngrnd, sol, solax_id)
3738	CALL histvert(hist_id, 'soiltyp', 'Soil types', '1', &
3739	& nstm, soltyp, soltax_id)
3740	CALL histvert(hist_id, 'nobio', 'Other surface types', '1', &
3741	& nnobio, nobiotyp, nobioax_id)
3742	IF ( control_flags%hydrol_cwrr ) THEN
3743	CALL histvert(hist_id, 'solay', 'Hydrol soil levels', 'm', &
3744	& nslm, solay, solayax_id)
3745	ENDIF
3746	!-
3747	!- Vegetation
3748	!-
3749	CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
3750	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3751	CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
3752	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3753	CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
3754	& iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3755	!-
3756	!- General energy balance
3757	!-
3758	CALL histdef(hist_id, 'SWnet', 'Net shortwave radiation', 'W/m^2', &
3759	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3760	CALL histdef(hist_id, 'LWnet', 'Net longwave radiation', 'W/m^2', &
3761	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3762	CALL histdef(hist_id, 'Qh', 'Sensible heat flux', 'W/m^2', &
3763	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3764	CALL histdef(hist_id, 'Qle', 'Latent heat flux', 'W/m^2', &
3765	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3766	CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2', &
3767	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3768	CALL histdef(hist_id, 'Qf', 'Energy of fusion', 'W/m^2', &
3769	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3770	CALL histdef(hist_id, 'Qv', 'Energy of sublimation', 'W/m^2', &
3771	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3772	CALL histdef(hist_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2', &
3773	& iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
3774	CALL histdef(hist_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2', &
3775	& iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
3776	!-
3777	!- General water balance
3778	!-
3779	CALL histdef(hist_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s', &
3780	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3781	CALL histdef(hist_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s', &
3782	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3783	CALL histdef(hist_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
3784	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3785	CALL histdef(hist_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
3786	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3787	CALL histdef(hist_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
3788	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3789	CALL histdef(hist_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
3790	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3791	CALL histdef(hist_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2', &
3792	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3793	CALL histdef(hist_id, 'DelSWE', 'Change in SWE','kg/m^2',&
3794	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3795	CALL histdef(hist_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2', &
3796	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3797	!-
3798	!- Surface state
3799	!-
3800	CALL histdef(hist_id, 'AvgSurfT', 'Average surface temperature', 'K', &
3801	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3802	CALL histdef(hist_id, 'RadT', 'Surface radiative temperature', 'K', &
3803	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3804	CALL histdef(hist_id, 'Albedo', 'Albedo', '1', &
3805	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3806	CALL histdef(hist_id, 'SWE', '3D soil water equivalent','kg/m^2', &
3807	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3808	!!-
3809	!- Sub-surface state
3810	!-
3811	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3812	CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
3813	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3814	ELSE
3815	CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
3816	& iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
3817	ENDIF
3818	CALL histdef(hist_id, 'SoilWet', 'Total soil wetness', 'kg/m^2', &
3819	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3820	CALL histdef(hist_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
3821	& iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1), dt,dw)
3822	!-
3823	!- Evaporation components
3824	!-
3825	CALL histdef(hist_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
3826	& iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
3827	CALL histdef(hist_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
3828	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3829	CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
3830	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3831	CALL histdef(hist_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
3832	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3833	CALL histdef(hist_id, 'RootMoist','Root zone soil water', 'kg/m^2', &
3834	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3835	CALL histdef(hist_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
3836	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3837	CALL histdef(hist_id, 'ACond', 'Aerodynamic conductance', 'm/s', &
3838	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3839	!-
3840	!-
3841	!- Cold Season Processes
3842	!-
3843	CALL histdef(hist_id, 'SnowFrac', 'Snow cover fraction', '1', &
3844	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3845	CALL histdef(hist_id, 'SAlbedo', 'Snow albedo', '1', &
3846	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3847	CALL histdef(hist_id, 'SnowDepth', '3D snow depth', 'm', &
3848	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3849	!-
3850	!- Hydrologic variables
3851	!-
3852	CALL histdef(hist_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
3853	& iim,jjm, hori_id, 1,1,1, -99, 32, once(7), dt,dw)
3854	CALL histdef(hist_id, 'dis', 'Simulated River Discharge', 'm^3/s', &
3855	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
3856	CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1', &
3857	& iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
3858	!-
3859	!- The carbon budget
3860	!-
3861	IF ( control_flags%ok_co2 ) THEN
3862	CALL histdef(hist_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
3863	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3864	ENDIF
3865	IF ( control_flags%ok_stomate ) THEN
3866	CALL histdef(hist_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
3867	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3868	CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
3869	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3870	CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
3871	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3872	CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
3873	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3874	CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
3875	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3876	ENDIF
3877	!
3878	ENDIF
3879	!-
3880	CALL histdef(hist_id, 'LandPoints', 'Land Points', '1', &
3881	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3882	CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
3883	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
3884	CALL histdef(hist_id, 'Contfrac', 'Continental fraction', '1', &
3885	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
3886	!-
3887	CALL histend(hist_id)
3888	!
3889	!
3890	! Second SECHIBA hist file
3891	!
3892	!-
3893	!Config Key = SECHIBA_HISTFILE2
3894	!Config Desc = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
3895	!Config Def = FALSE
3896	!Config Help = This Flag switch on the second SECHIBA writing for hi (or low)
3897	!Config frequency writing. This second output is optional and not written
3898	!Config by default.
3899	!Config MM is it right ? Second output file is produced with the same level
3900	!Config as the first one.
3901	!-
3902	ok_histfile2=.FALSE.
3903	CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
3904	WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
3905	!
3906	hist2_id = -1
3907	!
3908	IF (ok_histfile2) THEN
3909	!-
3910	!Config Key = SECHIBA_OUTPUT_FILE2
3911	!Config Desc = Name of file in which the output number 2 is going
3912	!Config to be written
3913	!Config If = SECHIBA_HISTFILE2
3914	!Config Def = sechiba_out_2.nc
3915	!Config Help = This file is going to be created by the model
3916	!Config and will contain the output 2 from the model.
3917	!-
3918	histname2='sechiba_out_2.nc'
3919	CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
3920	WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
3921	!-
3922	!Config Key = WRITE_STEP2
3923	!Config Desc = Frequency in seconds at which to WRITE output
3924	!Config If = SECHIBA_HISTFILE2
3925	!Config Def = 1800.0
3926	!Config Help = This variables gives the frequency the output 2 of
3927	!Config the model should be written into the netCDF file.
3928	!Config It does not affect the frequency at which the
3929	!Config operations such as averaging are done.
3930	!Config That is IF the coding of the calls to histdef
3931	!Config are correct !
3932	!-
3933	dw2 = 1800.0
3934	CALL getin_p('WRITE_STEP2', dw2)
3935	!-
3936	!Config Key = SECHIBA_HISTLEVEL2
3937	!Config Desc = SECHIBA history 2 output level (0..10)
3938	!Config If = SECHIBA_HISTFILE2
3939	!Config Def = 1
3940	!Config Help = Chooses the list of variables in the history file.
3941	!Config Values between 0: nothing is written; 10: everything is
3942	!Config written are available More details can be found on the web under documentation.
3943	!Config web under documentation.
3944	!Config First level contains all ORCHIDEE outputs.
3945	!-
3946	hist2_level = 1
3947	CALL getin_p('SECHIBA_HISTLEVEL2', hist2_level)
3948	!-
3949	WRITE(numout,*) 'SECHIBA history level 2 : ',hist2_level
3950	IF ( (hist2_level > max_hist_level).OR.(hist2_level < 0) ) THEN
3951	STOP 'This history level 2 is not allowed'
3952	ENDIF
3953	!
3954	!-
3955	!- define operations as a function of history level.
3956	!- Above hist2_level, operation='never'
3957	!-
3958	ave2(1:max_hist_level) = 'ave(X)'
3959	IF (hist2_level < max_hist_level) THEN
3960	ave2(hist2_level+1:max_hist_level) = 'never'
3961	ENDIF
3962	sumscatter2(1:max_hist_level) = 't_sum(scatter(X))'
3963	IF (hist2_level < max_hist_level) THEN
3964	sumscatter2(hist2_level+1:max_hist_level) = 'never'
3965	ENDIF
3966	avecels2(1:max_hist_level) = 'ave(cels(X))'
3967	IF (hist2_level < max_hist_level) THEN
3968	avecels2(hist2_level+1:max_hist_level) = 'never'
3969	ENDIF
3970	avescatter2(1:max_hist_level) = 'ave(scatter(X))'
3971	IF (hist2_level < max_hist_level) THEN
3972	avescatter2(hist2_level+1:max_hist_level) = 'never'
3973	ENDIF
3974	tmincels2(1:max_hist_level) = 't_min(cels(X))'
3975	IF (hist2_level < max_hist_level) THEN
3976	tmincels2(hist2_level+1:max_hist_level) = 'never'
3977	ENDIF
3978	tmaxcels2(1:max_hist_level) = 't_max(cels(X))'
3979	IF (hist2_level < max_hist_level) THEN
3980	tmaxcels2(hist2_level+1:max_hist_level) = 'never'
3981	ENDIF
3982	!!$ tmax2(1:max_hist_level) = 't_max(X)'
3983	!!$ IF (hist2_level < max_hist_level) THEN
3984	!!$ tmax2(hist2_level+1:max_hist_level) = 'never'
3985	!!$ ENDIF
3986	fluxop2(1:max_hist_level) = flux_op
3987	IF (hist2_level < max_hist_level) THEN
3988	fluxop2(hist2_level+1:max_hist_level) = 'never'
3989	ENDIF
3990	!!$ fluxop_sc2(1:max_hist_level) = flux_sc
3991	!!$ IF (hist2_level < max_hist_level) THEN
3992	!!$ fluxop_sc2(hist2_level+1:max_hist_level) = 'never'
3993	!!$ ENDIF
3994	!!$ fluxop_insec2(1:max_hist_level) = flux_insec
3995	!!$ IF (hist2_level < max_hist_level) THEN
3996	!!$ fluxop_insec2(hist2_level+1:max_hist_level) = 'never'
3997	!!$ ENDIF
3998	fluxop_scinsec2(1:max_hist_level) = flux_scinsec
3999	IF (hist2_level < max_hist_level) THEN
4000	fluxop_scinsec2(hist2_level+1:max_hist_level) = 'never'
4001	ENDIF
4002	once2(1:max_hist_level) = 'once(scatter(X))'
4003	IF (hist2_level < max_hist_level) THEN
4004	once2(hist2_level+1:max_hist_level) = 'never'
4005	ENDIF
4006	!
4007	IF ( .NOT. almaoutput ) THEN
4008	!-
4009	IF ( rectilinear ) THEN
4010	#ifdef CPP_PARA
4011	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4012	& istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
4013	#else
4014	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4015	& istp_old, date0, dt, hori_id2, hist2_id)
4016	#endif
4017	WRITE(numout,*) 'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
4018	ELSE
4019	#ifdef CPP_PARA
4020	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4021	& istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
4022	#else
4023	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4024	& istp_old, date0, dt, hori_id2, hist2_id)
4025	#endif
4026	ENDIF
4027	!-
4028	CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
4029	& nvm, veg, vegax_id2)
4030	CALL histvert(hist2_id, 'solth', 'Soil levels', 'm', &
4031	& ngrnd, sol, solax_id2)
4032	CALL histvert(hist2_id, 'soiltyp', 'Soil types', '1', &
4033	& nstm, soltyp, soltax_id2)
4034	CALL histvert(hist2_id, 'nobio', 'Other surface types', '1', &
4035	& nnobio, nobiotyp, nobioax_id2)
4036	CALL histvert(hist2_id, 'albtyp', 'Albedo Types', '1', &
4037	& 2, albtyp, albax_id2)
4038	IF ( control_flags%hydrol_cwrr ) THEN
4039	CALL histvert(hist2_id, 'solay', 'Hydrol soil levels', 'm', &
4040	& nslm, solay, solayax_id2)
4041	ENDIF
4042	!-
4043	!- SECHIBA_HISTLEVEL2 = 1
4044	!-
4045	CALL histdef(hist2_id, 'ptn', 'Deep ground temperature', 'K', &
4046	& iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(1), dt, dw2)
4047	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4048	CALL histdef(hist2_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
4049	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt,dw2)
4050
4051	CALL histdef(hist2_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
4052	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt,dw2)
4053	ENDIF
4054	!-
4055	!- SECHIBA_HISTLEVEL2 = 2
4056	!-
4057	CALL histdef(hist2_id, 'cdrag', 'Drag coefficient for LE and SH', '?', &
4058	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
4059	! Ajouts Nathalie - Septembre 2008
4060	CALL histdef(hist2_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
4061	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4062	CALL histdef(hist2_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
4063	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4064	CALL histdef(hist2_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
4065	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4066	CALL histdef(hist2_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
4067	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4068	! Fin ajouts Nathalie - Septembre 2008
4069	CALL histdef(hist2_id, 'z0', 'Surface roughness', 'm', &
4070	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
4071	CALL histdef(hist2_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
4072	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4073	CALL histdef(hist2_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
4074	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4075	CALL histdef(hist2_id, 'tsol_rad', 'Radiative surface temperature', 'C', &
4076	& iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
4077	CALL histdef(hist2_id, 'vevapnu', 'Bare soil evaporation', 'mm/d', &
4078	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
4079	CALL histdef(hist2_id, 'temp_sol', 'New Surface Temperature', 'C', &
4080	& iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
4081	CALL histdef(hist2_id, 'qsurf', 'Near surface specific humidity', 'g/g', &
4082	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4083	CALL histdef(hist2_id, 'albedo', 'Albedo', '1', &
4084	& iim,jjm, hori_id2, 2,1,2, albax_id2, 32, avescatter2(2), dt, dw2)
4085	CALL histdef(hist2_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2', &
4086	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4087	CALL histdef(hist2_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2', &
4088	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4089	CALL histdef(hist2_id, 'emis', 'Surface emissivity', '?', &
4090	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
4091	!-
4092	!- SECHIBA_HISTLEVEL2 = 3
4093	!-
4094	CALL histdef(hist2_id, 'evap', 'Evaporation', 'mm/d', &
4095	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4096	CALL histdef(hist2_id, 'rain', 'Rainfall', 'mm/d', &
4097	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4098	CALL histdef(hist2_id, 'snowf', 'Snowfall', 'mm/d', &
4099	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4100	CALL histdef(hist2_id, 'netrad', 'Net radiation', 'W/m^2', &
4101	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(3), dt, dw2)
4102	CALL histdef(hist2_id, 'lai', 'Leaf Area Index', '1', &
4103	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4104	IF ( control_flags%river_routing ) THEN
4105	CALL histdef(hist2_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
4106	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)
4107	CALL histdef(hist2_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
4108	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)
4109	ENDIF
4110	!-
4111	!- SECHIBA_HISTLEVEL2 = 4
4112	!-
4113	CALL histdef(hist2_id, 'subli', 'Sublimation', 'mm/d', &
4114	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4115	CALL histdef(hist2_id, 'runoff', 'Surface runoff', 'mm/d', &
4116	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4117	CALL histdef(hist2_id, 'drainage', 'Deep drainage', 'mm/d', &
4118	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4119	IF ( control_flags%river_routing ) THEN
4120	CALL histdef(hist2_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
4121	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4122	CALL histdef(hist2_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
4123	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(4), dt, dw2)
4124	ENDIF
4125	IF ( control_flags%hydrol_cwrr ) THEN
4126	CALL histdef(hist2_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
4127	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4128	CALL histdef(hist2_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
4129	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4130	CALL histdef(hist2_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
4131	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4132	CALL histdef(hist2_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
4133	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4134	ENDIF
4135	!
4136	CALL histdef(hist2_id, 'tair', 'Air Temperature', 'K', &
4137	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4138	CALL histdef(hist2_id, 'qair', 'Air humidity', 'g/g', &
4139	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4140	! Ajouts Nathalie - Juillet 2006
4141	CALL histdef(hist2_id, 'q2m', '2m Air humidity', 'g/g', &
4142	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4143	CALL histdef(hist2_id, 't2m', '2m Air Temperature', 'K', &
4144	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4145	! Fin ajouts Nathalie
4146	CALL histdef(hist2_id, 'alb_vis', 'Albedo visible', '1', &
4147	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4148	CALL histdef(hist2_id, 'alb_nir', 'Albedo near infrared', '1', &
4149	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4150	CALL histdef(hist2_id, 'roughheight', 'Effective roughness height', 'm', &
4151	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(4), dt, dw2)
4152	CALL histdef(hist2_id, 'transpir', 'Transpiration', 'mm/d', &
4153	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
4154	CALL histdef(hist2_id, 'inter', 'Interception loss', 'mm/d', &
4155	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
4156	!-
4157	!- SECHIBA_HISTLEVEL2 = 5
4158	!-
4159	CALL histdef(hist2_id, 'tsol_max', 'Maximum Surface Temperature',&
4160	& 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmaxcels2(5), dt, dw2)
4161	CALL histdef(hist2_id, 'tsol_min', 'Minimum Surface Temperature',&
4162	& 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmincels2(5), dt, dw2)
4163	CALL histdef(hist2_id, 'snow', 'Snow mass', 'kg/m^2', &
4164	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
4165	CALL histdef(hist2_id, 'snowage', 'Snow age', '?', &
4166	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
4167	CALL histdef(hist2_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
4168	& iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4169	CALL histdef(hist2_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
4170	& iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4171	CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
4172	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4173	CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
4174	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4175	CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
4176	& iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4177	IF ( control_flags%hydrol_cwrr ) THEN
4178	DO jst=1,nstm
4179
4180	! var_name= "mc_1" ... "mc_3"
4181	WRITE (var_name,"('moistc_',i1)") jst
4182	CALL histdef(hist2_id, var_name, 'Soil Moisture profile for soil type', '%', &
4183	& iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt, dw2)
4184
4185	! var_name= "vegetsoil_1" ... "vegetsoil_3"
4186	WRITE (var_name,"('vegetsoil_',i1)") jst
4187	CALL histdef(hist2_id, var_name, 'Fraction of vegetation on soil types', '%', &
4188	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4189
4190	ENDDO
4191	ENDIF
4192	!-
4193	!- SECHIBA_HISTLEVEL2 = 6
4194	!-
4195	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4196	CALL histdef(hist2_id, 'dss', 'Up-reservoir Height', 'm', &
4197	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter2(6), dt,dw)
4198	CALL histdef(hist2_id, 'gqsb', 'Upper Soil Moisture', '1', &
4199	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4200	CALL histdef(hist2_id, 'bqsb', 'Lower Soil Moisture', '1', &
4201	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4202	ELSE
4203	CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
4204	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4205	CALL histdef(hist2_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m2', &
4206	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, avescatter2(6), dt, dw2)
4207	ENDIF
4208	CALL histdef(hist2_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
4209	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
4210	CALL histdef(hist2_id, 'rstruct', 'Structural resistance', 's/m', &
4211	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
4212	IF ( control_flags%ok_co2 ) THEN
4213	CALL histdef(hist2_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
4214	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
4215	ENDIF
4216	IF ( control_flags%ok_stomate ) THEN
4217	CALL histdef(hist2_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
4218	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4219	CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
4220	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4221	CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
4222	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4223	CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
4224	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt, dw2)
4225	CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
4226	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt, dw2)
4227	ENDIF
4228	CALL histdef(hist2_id, 'precisol', 'Throughfall', 'mm/d', &
4229	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(6), dt, dw2)
4230	CALL histdef(hist2_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1', &
4231	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
4232	CALL histdef(hist2_id, 'evapot', 'Potential evaporation', 'mm/d', &
4233	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
4234	CALL histdef(hist2_id, 'evapot_corr', 'Potential evaporation', 'mm/d', &
4235	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
4236	!-
4237	!- SECHIBA_HISTLEVEL2 = 7
4238	!-
4239	CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2', &
4240	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
4241	CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2', &
4242	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
4243	CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2', &
4244	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4245	CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2', &
4246	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4247	CALL histdef(hist2_id, 'temp_pheno', 'Temperature for Pheno', 'K', &
4248	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4249	!-
4250	!- SECHIBA_HISTLEVEL2 = 8
4251	!-
4252	IF ( control_flags%river_routing ) THEN
4253	CALL histdef(hist2_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
4254	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4255	CALL histdef(hist2_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
4256	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4257	CALL histdef(hist2_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
4258	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4259	CALL histdef(hist2_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
4260	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4261	CALL histdef(hist2_id, 'irrigation', 'Net irrigation', 'mm/d', &
4262	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
4263	CALL histdef(hist2_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
4264	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
4265	CALL histdef(hist2_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
4266	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt, dw2)
4267	ENDIF
4268	!-
4269	!- SECHIBA_HISTLEVEL2 = 9
4270	!-
4271	CALL histdef(hist2_id, 'beta', 'Beta Function', '1', &
4272	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4273	CALL histdef(hist2_id, 'raero', 'Aerodynamic resistance', 's/m', &
4274	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4275	! Ajouts Nathalie - Novembre 2006
4276	CALL histdef(hist2_id, 'Wind', 'Wind speed', 'm/s', &
4277	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4278	! Fin ajouts Nathalie
4279	CALL histdef(hist2_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
4280	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4281	CALL histdef(hist2_id, 'vbeta1', 'Beta for sublimation', '1', &
4282	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4283	CALL histdef(hist2_id, 'vbeta4', 'Beta for bare soil', '1', &
4284	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4285	CALL histdef(hist2_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
4286	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4287	CALL histdef(hist2_id, 'soiltype', 'Fraction of soil textures', '%', &
4288	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, once2(9), dt, dw2)
4289	CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1', &
4290	& iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4291	!-
4292	!- SECHIBA_HISTLEVEL2 = 10
4293	!-
4294	CALL histdef(hist2_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
4295	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4296	CALL histdef(hist2_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
4297	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4298	CALL histdef(hist2_id, 'rveget', 'Canopy resistance', 's/m', &
4299	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4300	CALL histdef(hist2_id, 'rsol', 'Soil resistance', 's/m', &
4301	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt, dw2)
4302	CALL histdef(hist2_id,'vbeta2','Beta for Interception loss','mm/d', &
4303	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4304	CALL histdef(hist2_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
4305	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4306	!
4307	ELSE
4308	!-
4309	!- This is the ALMA convention output now
4310	!-
4311	!-
4312	IF ( rectilinear ) THEN
4313	#ifdef CPP_PARA
4314	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4315	& istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
4316	#else
4317	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4318	& istp_old, date0, dt, hori_id2, hist2_id)
4319	#endif
4320	WRITE(numout,*) 'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
4321	ELSE
4322	#ifdef CPP_PARA
4323	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4324	& istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
4325	#else
4326	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4327	& istp_old, date0, dt, hori_id2, hist2_id)
4328	#endif
4329	ENDIF
4330	!-
4331	CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
4332	& nvm, veg, vegax_id2)
4333	CALL histvert(hist2_id, 'solth', 'Soil levels', 'm', &
4334	& ngrnd, sol, solax_id2)
4335	CALL histvert(hist2_id, 'soiltyp', 'Soil types', '1', &
4336	& nstm, soltyp, soltax_id2)
4337	CALL histvert(hist2_id, 'nobio', 'Other surface types', '1', &
4338	& nnobio, nobiotyp, nobioax_id2)
4339	IF ( control_flags%hydrol_cwrr ) THEN
4340	CALL histvert(hist2_id, 'solay', 'Hydrol soil levels', 'm', &
4341	& nslm, solay, solayax_id2)
4342	ENDIF
4343	!-
4344	!- Vegetation
4345	!-
4346	CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
4347	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4348	CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
4349	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4350	CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
4351	& iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(3), dt, dw2)
4352	!-
4353	!- General energy balance
4354	!-
4355	CALL histdef(hist2_id, 'SWnet', 'Net shortwave radiation', 'W/m^2', &
4356	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4357	CALL histdef(hist2_id, 'LWnet', 'Net longwave radiation', 'W/m^2', &
4358	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4359	CALL histdef(hist2_id, 'Qh', 'Sensible heat flux', 'W/m^2', &
4360	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4361	CALL histdef(hist2_id, 'Qle', 'Latent heat flux', 'W/m^2', &
4362	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4363	CALL histdef(hist2_id, 'Qg', 'Ground heat flux', 'W/m^2', &
4364	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4365	CALL histdef(hist2_id, 'Qf', 'Energy of fusion', 'W/m^2', &
4366	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4367	CALL histdef(hist2_id, 'Qv', 'Energy of sublimation', 'W/m^2', &
4368	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4369	CALL histdef(hist2_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2', &
4370	& iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(1), dt, dw2)
4371	CALL histdef(hist2_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2', &
4372	& iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(1), dt, dw2)
4373	!-
4374	!- General water balance
4375	!-
4376	CALL histdef(hist2_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s', &
4377	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4378	CALL histdef(hist2_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s', &
4379	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4380	CALL histdef(hist2_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
4381	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4382	CALL histdef(hist2_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
4383	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4384	CALL histdef(hist2_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
4385	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4386	CALL histdef(hist2_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
4387	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4388	CALL histdef(hist2_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2', &
4389	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4390	CALL histdef(hist2_id, 'DelSWE', 'Change in SWE','kg/m^2',&
4391	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4392	CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2', &
4393	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4394	!-
4395	!- Surface state
4396	!-
4397	CALL histdef(hist2_id, 'AvgSurfT', 'Average surface temperature', 'K', &
4398	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4399	CALL histdef(hist2_id, 'RadT', 'Surface radiative temperature', 'K', &
4400	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4401	CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
4402	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4403	CALL histdef(hist2_id, 'SWE', '3D soil water equivalent','kg/m^2', &
4404	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4405	!!-
4406	!- Sub-surface state
4407	!-
4408	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4409	CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
4410	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4411	ELSE
4412	CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
4413	& iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(1), dt, dw2)
4414	ENDIF
4415	CALL histdef(hist2_id, 'SoilWet', 'Total soil wetness', 'kg/m^2', &
4416	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4417	CALL histdef(hist2_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
4418	& iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(1), dt, dw2)
4419	!-
4420	!- Evaporation components
4421	!-
4422	CALL histdef(hist2_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
4423	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4424	CALL histdef(hist2_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
4425	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4426	CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
4427	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4428	CALL histdef(hist2_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
4429	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4430	CALL histdef(hist2_id, 'RootMoist','Root zone soil water', 'kg/m^2', &
4431	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4432	CALL histdef(hist2_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
4433	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4434	CALL histdef(hist2_id, 'ACond', 'Aerodynamic conductance', 'm/s', &
4435	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4436	!-
4437	!-
4438	!- Cold Season Processes
4439	!-
4440	CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1', &
4441	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4442	CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
4443	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4444	CALL histdef(hist2_id, 'SnowDepth', '3D snow depth', 'm', &
4445	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4446	!-
4447	!- Hydrologic variables
4448	!-
4449	CALL histdef(hist2_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
4450	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(7), dt, dw2)
4451	CALL histdef(hist2_id, 'dis', 'Simulated River Discharge', 'm^3/s', &
4452	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4453	CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1', &
4454	& iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4455	!-
4456	!- The carbon budget
4457	!-
4458	IF ( control_flags%ok_co2 ) THEN
4459	CALL histdef(hist2_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
4460	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4461	ENDIF
4462	IF ( control_flags%ok_stomate ) THEN
4463	CALL histdef(hist2_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
4464	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4465	CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
4466	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4467	CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
4468	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4469	CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
4470	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4471	CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
4472	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4473	ENDIF
4474	!
4475	ENDIF
4476	!-
4477	CALL histdef(hist2_id, 'LandPoints', 'Land Points', '1', &
4478	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4479	CALL histdef(hist2_id, 'Areas', 'Mesh areas', 'm2', &
4480	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4481	CALL histdef(hist2_id, 'Contfrac', 'Continental fraction', '1', &
4482	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4483	!-
4484	CALL histend(hist2_id)
4485	ENDIF
4486	!-
4487	!=====================================================================
4488	!- 3.2 STOMATE's history file
4489	!=====================================================================
4490	IF ( control_flags%ok_stomate ) THEN
4491	!-
4492	! STOMATE IS ACTIVATED
4493	!-
4494	!Config Key = STOMATE_OUTPUT_FILE
4495	!Config Desc = Name of file in which STOMATE's output is going
4496	!Config to be written
4497	!Config Def = stomate_history.nc
4498	!Config Help = This file is going to be created by the model
4499	!Config and will contain the output from the model.
4500	!Config This file is a truly COADS compliant netCDF file.
4501	!Config It will be generated by the hist software from
4502	!Config the IOIPSL package.
4503	!-
4504	stom_histname='stomate_history.nc'
4505	CALL getin_p('STOMATE_OUTPUT_FILE', stom_histname)
4506	WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
4507	!-
4508	!Config Key = STOMATE_HIST_DT
4509	!Config Desc = STOMATE history time step (d)
4510	!Config Def = 10.
4511	!Config Help = Time step of the STOMATE history file
4512	!-
4513	hist_days_stom = 10.
4514	CALL getin_p('STOMATE_HIST_DT', hist_days_stom)
4515	IF ( hist_days_stom == moins_un ) THEN
4516	hist_dt_stom = moins_un
4517	WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
4518	ELSE
4519	hist_dt_stom = NINT( hist_days_stom ) * one_day
4520	WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
4521	hist_dt_stom/one_day
4522	ENDIF
4523
4524	! test consistency between STOMATE_HIST_DT and DT_SLOW parameters
4525	dt_slow_ = one_day
4526	CALL getin_p('DT_SLOW', dt_slow_)
4527	IF ( hist_days_stom /= moins_un ) THEN
4528	IF (dt_slow_ > hist_dt_stom) THEN
4529	WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_HIST_DT = ",hist_dt_stom
4530	CALL ipslerr (3,'intsurf_history', &
4531	& 'Problem with DT_SLOW > STOMATE_HIST_DT','', &
4532	& '(must be less or equal)')
4533	ENDIF
4534	ENDIF
4535	!-
4536	!- initialize
4537	IF ( rectilinear ) THEN
4538	#ifdef CPP_PARA
4539	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4540	& istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
4541	#else
4542	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4543	& istp_old, date0, dt, hori_id, hist_id_stom)
4544	#endif
4545	ELSE
4546	#ifdef CPP_PARA
4547	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4548	& istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
4549	#else
4550	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4551	& istp_old, date0, dt, hori_id, hist_id_stom)
4552	#endif
4553	ENDIF
4554	!- define PFT axis
4555	hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
4556	!- declare this axis
4557	CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
4558	& '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
4559	! deforestation
4560	!- define Pool_10 axis
4561	hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
4562	!- declare this axis
4563	CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
4564	& '1', 10, hist_pool_10axis, hist_pool_10axis_id)
4565
4566	!- define Pool_100 axis
4567	hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
4568	!- declare this axis
4569	CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
4570	& '1', 100, hist_pool_100axis, hist_pool_100axis_id)
4571
4572	!- define Pool_11 axis
4573	hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
4574	!- declare this axis
4575	CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
4576	& '1', 11, hist_pool_11axis, hist_pool_11axis_id)
4577
4578	!- define Pool_101 axis
4579	hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
4580	!- declare this axis
4581	CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
4582	& '1', 101, hist_pool_101axis, hist_pool_101axis_id)
4583
4584	!- define STOMATE history file
4585	CALL stom_define_history (hist_id_stom, nvm, iim, jjm, &
4586	& dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
4587	& hist_pool_10axis_id, hist_pool_100axis_id, &
4588	& hist_pool_11axis_id, hist_pool_101axis_id, control_flags)
4589	! deforestation axis added as arguments
4590
4591	!- end definition
4592	CALL histend(hist_id_stom)
4593	!-
4594	!-
4595	!-
4596	! STOMATE IPCC OUTPUTS IS ACTIVATED
4597	!-
4598	!Config Key = STOMATE_IPCC_OUTPUT_FILE
4599	!Config Desc = Name of file in which STOMATE's output is going
4600	!Config to be written
4601	!Config Def = stomate_ipcc_history.nc
4602	!Config Help = This file is going to be created by the model
4603	!Config and will contain the output from the model.
4604	!Config This file is a truly COADS compliant netCDF file.
4605	!Config It will be generated by the hist software from
4606	!Config the IOIPSL package.
4607	!-
4608	stom_ipcc_histname='stomate_ipcc_history.nc'
4609	CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)
4610	WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
4611	!-
4612	!Config Key = STOMATE_IPCC_HIST_DT
4613	!Config Desc = STOMATE IPCC history time step (d)
4614	!Config Def = 0.
4615	!Config Help = Time step of the STOMATE IPCC history file
4616	!-
4617	hist_days_stom_ipcc = zero
4618	CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)
4619	IF ( hist_days_stom_ipcc == moins_un ) THEN
4620	hist_dt_stom_ipcc = moins_un
4621	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
4622	ELSE
4623	hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
4624	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
4625	hist_dt_stom_ipcc/one_day
4626	ENDIF
4627
4628	! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters
4629	dt_slow_ = one_day
4630	CALL getin_p('DT_SLOW', dt_slow_)
4631	IF ( hist_days_stom_ipcc > zero ) THEN
4632	IF (dt_slow_ > hist_dt_stom_ipcc) THEN
4633	WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
4634	CALL ipslerr (3,'intsurf_history', &
4635	& 'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', &
4636	& '(must be less or equal)')
4637	ENDIF
4638	ENDIF
4639
4640	IF ( hist_dt_stom_ipcc == 0 ) THEN
4641	hist_id_stom_ipcc = -1
4642	ELSE
4643	!-
4644	!- initialize
4645	IF ( rectilinear ) THEN
4646	#ifdef CPP_PARA
4647	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4648	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
4649	#else
4650	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4651	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
4652	#endif
4653	ELSE
4654	#ifdef CPP_PARA
4655	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4656	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
4657	#else
4658	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4659	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
4660	#endif
4661	ENDIF
4662	!- declare this axis
4663	CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
4664	& '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
4665
4666	!- define STOMATE history file
4667	CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, &
4668	& dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
4669
4670	!- end definition
4671	CALL histend(hist_id_stom_IPCC)
4672
4673	ENDIF
4674	ENDIF
4675
4676
4677	RETURN
4678
4679	END SUBROUTINE intsurf_history
4680	!
4681	SUBROUTINE stom_define_history &
4682	& (hist_id_stom, nvm, iim, jjm, dt, &
4683	& hist_dt, hist_hori_id, hist_PFTaxis_id, &
4684	& hist_pool_10axis_id, hist_pool_100axis_id, &
4685	& hist_pool_11axis_id, hist_pool_101axis_id, control_flags)
4686	! deforestation axis added as arguments
4687
4688	!---------------------------------------------------------------------
4689	!- Tell ioipsl which variables are to be written
4690	!- and on which grid they are defined
4691	!---------------------------------------------------------------------
4692	IMPLICIT NONE
4693	!-
4694	!- Input
4695	!-
4696	!- File id
4697	INTEGER(i_std),INTENT(in) :: hist_id_stom
4698	!- number of PFTs
4699	INTEGER(i_std),INTENT(in) :: nvm
4700	!- Domain size
4701	INTEGER(i_std),INTENT(in) :: iim, jjm
4702	!- Time step of STOMATE (seconds)
4703	REAL(r_std),INTENT(in) :: dt
4704	!- Time step of history file (s)
4705	REAL(r_std),INTENT(in) :: hist_dt
4706	!- id horizontal grid
4707	INTEGER(i_std),INTENT(in) :: hist_hori_id
4708	!- id of PFT axis
4709	INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
4710	!- id of Deforestation axis
4711	INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
4712	INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
4713	!- Flags that (de)activate parts of the model
4714	TYPE(control_type), INTENT(in) :: control_flags
4715	!-
4716	!- 1 local
4717	!-
4718	!- maximum history level
4719	INTEGER(i_std), PARAMETER :: max_hist_level = 10
4720	!- output level (between 0 and 10)
4721	!- ( 0:nothing is written, 10:everything is written)
4722	INTEGER(i_std) :: hist_level
4723	!- Character strings to define operations for histdef
4724	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
4725
4726	!---------------------------------------------------------------------
4727	!=====================================================================
4728	!- 1 history level
4729	!=====================================================================
4730	!- 1.1 define history levelx
4731	!=====================================================================
4732	!Config Key = STOMATE_HISTLEVEL
4733	!Config Desc = STOMATE history output level (0..10)
4734	!Config Def = 10
4735	!Config Help = 0: nothing is written; 10: everything is written
4736	!-
4737	hist_level = 10
4738	CALL getin_p('STOMATE_HISTLEVEL', hist_level)
4739	!-
4740	WRITE(numout,*) 'STOMATE history level: ',hist_level
4741	IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
4742	STOP 'This history level is not allowed'
4743	ENDIF
4744	!=====================================================================
4745	!- 1.2 define operations according to output level
4746	!=====================================================================
4747	ave(1:hist_level) = 'ave(scatter(X))'
4748	ave(hist_level+1:max_hist_level) = 'never '
4749	!=====================================================================
4750	!- 2 surface fields (2d)
4751	!- 3 PFT: 3rd dimension
4752	!=====================================================================
4753
4754
4755	! structural litter above ground
4756	CALL histdef (hist_id_stom, &
4757	& TRIM("LITTER_STR_AB "), &
4758	& TRIM("structural litter above ground "), &
4759	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4760	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4761
4762	! metabolic litter above ground
4763	CALL histdef (hist_id_stom, &
4764	& TRIM("LITTER_MET_AB "), &
4765	& TRIM("metabolic litter above ground "), &
4766	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4767	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4768
4769	! structural litter below ground
4770	CALL histdef (hist_id_stom, &
4771	& TRIM("LITTER_STR_BE "), &
4772	& TRIM("structural litter below ground "), &
4773	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4774	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4775
4776	! metabolic litter below ground
4777	CALL histdef (hist_id_stom, &
4778	& TRIM("LITTER_MET_BE "), &
4779	& TRIM("metabolic litter below ground "), &
4780	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4781	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4782
4783	! fraction of soil covered by dead leaves
4784	CALL histdef (hist_id_stom, &
4785	& TRIM("DEADLEAF_COVER "), &
4786	& TRIM("fraction of soil covered by dead leaves "), &
4787	& TRIM("- "), iim,jjm, hist_hori_id, &
4788	& 1,1,1, -99,32, ave(5), dt, hist_dt)
4789
4790	! total soil and litter carbon
4791	CALL histdef (hist_id_stom, &
4792	& TRIM("TOTAL_SOIL_CARB "), &
4793	& TRIM("total soil and litter carbon "), &
4794	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4795	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4796
4797	! active soil carbon in ground
4798	CALL histdef (hist_id_stom, &
4799	& TRIM("CARBON_ACTIVE "), &
4800	& TRIM("active soil carbon in ground "), &
4801	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4802	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4803
4804	! slow soil carbon in ground
4805	CALL histdef (hist_id_stom, &
4806	& TRIM("CARBON_SLOW "), &
4807	& TRIM("slow soil carbon in ground "), &
4808	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4809	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4810
4811	! passive soil carbon in ground
4812	CALL histdef (hist_id_stom, &
4813	& TRIM("CARBON_PASSIVE "), &
4814	& TRIM("passive soil carbon in ground "), &
4815	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4816	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4817
4818	! Long term 2 m temperature
4819	CALL histdef (hist_id_stom, &
4820	& TRIM("T2M_LONGTERM "), &
4821	& TRIM("Longterm 2 m temperature "), &
4822	& TRIM("K "), iim,jjm, hist_hori_id, &
4823	& 1,1,1, -99,32, ave(9), dt, hist_dt)
4824
4825	! Monthly 2 m temperature
4826	CALL histdef (hist_id_stom, &
4827	& TRIM("T2M_MONTH "), &
4828	& TRIM("Monthly 2 m temperature "), &
4829	& TRIM("K "), iim,jjm, hist_hori_id, &
4830	& 1,1,1, -99,32, ave(1), dt, hist_dt)
4831
4832	! Weekly 2 m temperature
4833	CALL histdef (hist_id_stom, &
4834	& TRIM("T2M_WEEK "), &
4835	& TRIM("Weekly 2 m temperature "), &
4836	& TRIM("K "), iim,jjm, hist_hori_id, &
4837	& 1,1,1, -99,32, ave(1), dt, hist_dt)
4838
4839	! heterotr. resp. from ground
4840	CALL histdef (hist_id_stom, &
4841	& TRIM("HET_RESP "), &
4842	& TRIM("heterotr. resp. from ground "), &
4843	& TRIM("gC/m^2 tot/pft/day "), iim,jjm, hist_hori_id, &
4844	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4845
4846	! black carbon on average total ground
4847	CALL histdef (hist_id_stom, &
4848	& TRIM("BLACK_CARBON "), &
4849	& TRIM("black carbon on average total ground "), &
4850	& TRIM("gC/m^2 tot "), iim,jjm, hist_hori_id, &
4851	& 1,1,1, -99,32, ave(10), dt, hist_dt)
4852
4853	! Fire fraction on ground
4854	CALL histdef (hist_id_stom, &
4855	& TRIM("FIREFRAC "), &
4856	& TRIM("Fire fraction on ground "), &
4857	& TRIM("1/day "), iim,jjm, hist_hori_id, &
4858	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4859
4860	! Fire index on ground
4861	CALL histdef (hist_id_stom, &
4862	& TRIM("FIREINDEX "), &
4863	& TRIM("Fire index on ground "), &
4864	& TRIM("- "), iim,jjm, hist_hori_id, &
4865	& nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
4866
4867	! Litter humidity
4868	CALL histdef (hist_id_stom, &
4869	& TRIM("LITTERHUM "), &
4870	& TRIM("Litter humidity "), &
4871	& TRIM("- "), iim,jjm, hist_hori_id, &
4872	& 1,1,1, -99,32, ave(5), dt, hist_dt)
4873
4874	! CO2 flux
4875	CALL histdef (hist_id_stom, &
4876	& TRIM("CO2FLUX "), &
4877	& TRIM("CO2 flux "), &
4878	& TRIM("gC/m^2/pft/mth "), iim,jjm, hist_hori_id, &
4879	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4880
4881	!!$ CALL histdef(hist_id_stom, &
4882	!!$ & TRIM("CO2FLUX_MONTHLY_SUM "), &
4883	!!$ & TRIM("Monthly CO2 flux Sum "), &
4884	!!$ & TRIM("PgC/m^2/mth "), iim,jjm, hist_hori_id, &
4885	!!$ & 1,1,1, -99, 32, 'inst(scatter(X))', dt, hist_dt)
4886
4887	! Output CO2 flux from fire
4888	CALL histdef (hist_id_stom, &
4889	& TRIM("CO2_FIRE "), &
4890	& TRIM("Output CO2 flux from fire "), &
4891	& TRIM("gC/day/m^2/pft "), iim,jjm, hist_hori_id, &
4892	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4893
4894	! CO2 taken from atmosphere for initiate growth
4895	CALL histdef (hist_id_stom, &
4896	& TRIM("CO2_TAKEN "), &
4897	& TRIM("CO2 taken from atmosphere for initiate growth "), &
4898	& TRIM("gC/day/m^2/pft "), iim,jjm, hist_hori_id, &
4899	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4900
4901	! Leaf Area Index
4902	CALL histdef (hist_id_stom, &
4903	& TRIM("LAI "), &
4904	& TRIM("Leaf Area Index "), &
4905	& TRIM("- "), iim,jjm, hist_hori_id, &
4906	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4907
4908	! Vegetation fraction
4909	CALL histdef (hist_id_stom, &
4910	& TRIM("VEGET "), &
4911	& TRIM("Vegetation fraction "), &
4912	& TRIM("- "), iim,jjm, hist_hori_id, &
4913	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4914
4915	! Maximum vegetation fraction (LAI -> infinity)
4916	CALL histdef (hist_id_stom, &
4917	& TRIM("VEGET_MAX "), &
4918	& TRIM("Maximum vegetation fraction (LAI -> infinity) "), &
4919	& TRIM("- "), iim,jjm, hist_hori_id, &
4920	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4921
4922	! Net primary productivity
4923	CALL histdef (hist_id_stom, &
4924	& TRIM("NPP "), &
4925	& TRIM("Net primary productivity "), &
4926	& TRIM("gC/day/(m^2 tot) "), iim,jjm, hist_hori_id, &
4927	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4928
4929	! Gross primary productivity
4930	CALL histdef (hist_id_stom, &
4931	& TRIM("GPP "), &
4932	& TRIM("Gross primary productivity "), &
4933	& TRIM("gC/day/m^2 "), iim,jjm, hist_hori_id, &
4934	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4935
4936	! Density of individuals
4937	CALL histdef (hist_id_stom, &
4938	& TRIM("IND "), &
4939	& TRIM("Density of individuals "), &
4940	& TRIM("1/ m^2 "), iim,jjm, hist_hori_id, &
4941	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4942
4943	IF ( control_flags%ok_dgvm ) THEN
4944	! Adaptation to climate
4945	CALL histdef (hist_id_stom, &
4946	& TRIM("ADAPTATION "), &
4947	& TRIM("Adaptation to climate (DGVM) "), &
4948	& TRIM("- "), iim,jjm, hist_hori_id, &
4949	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4950
4951	! Probability from regenerative
4952	CALL histdef (hist_id_stom, &
4953	& TRIM("REGENERATION "), &
4954	& TRIM("Probability from regenerative (DGVM) "), &
4955	& TRIM("- "), iim,jjm, hist_hori_id, &
4956	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4957	ENDIF
4958
4959	! crown area of individuals (m**2)
4960	CALL histdef (hist_id_stom, &
4961	& TRIM("CN_IND "), &
4962	& TRIM("crown area of individuals "), &
4963	& TRIM("m^2 "), iim,jjm, hist_hori_id, &
4964	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4965
4966	! woodmass of individuals (gC)
4967	CALL histdef (hist_id_stom, &
4968	& TRIM("WOODMASS_IND "), &
4969	& TRIM("Woodmass of individuals "), &
4970	& TRIM("gC/pft "), iim,jjm, hist_hori_id, &
4971	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4972
4973	! total living biomass
4974	CALL histdef (hist_id_stom, &
4975	& TRIM("TOTAL_M "), &
4976	& TRIM("Total living biomass "), &
4977	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4978	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
4979
4980	! Leaf mass
4981	CALL histdef (hist_id_stom, &
4982	& TRIM("LEAF_M "), &
4983	& TRIM("Leaf mass "), &
4984	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4985	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
4986
4987	! Sap mass above ground
4988	CALL histdef (hist_id_stom, &
4989	& TRIM("SAP_M_AB "), &
4990	& TRIM("Sap mass above ground "), &
4991	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4992	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
4993
4994	! Sap mass below ground
4995	CALL histdef (hist_id_stom, &
4996	& TRIM("SAP_M_BE "), &
4997	& TRIM("Sap mass below ground "), &
4998	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4999	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5000
5001	! Heartwood mass above ground
5002	CALL histdef (hist_id_stom, &
5003	& TRIM("HEART_M_AB "), &
5004	& TRIM("Heartwood mass above ground "), &
5005	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
5006	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5007
5008	! Heartwood mass below ground
5009	CALL histdef (hist_id_stom, &
5010	& TRIM("HEART_M_BE "), &
5011	& TRIM("Heartwood mass below ground "), &
5012	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
5013	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5014
5015	! Root mass
5016	CALL histdef (hist_id_stom, &
5017	& TRIM("ROOT_M "), &
5018	& TRIM("Root mass "), &
5019	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
5020	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5021
5022	! Fruit mass
5023	CALL histdef (hist_id_stom, &
5024	& TRIM("FRUIT_M "), &
5025	& TRIM("Fruit mass "), &
5026	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
5027	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5028
5029	! Carbohydrate reserve mass
5030	CALL histdef (hist_id_stom, &
5031	& TRIM("RESERVE_M "), &
5032	& TRIM("Carbohydrate reserve mass "), &
5033	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
5034	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5035
5036	! total turnover rate
5037	CALL histdef (hist_id_stom, &
5038	& TRIM("TOTAL_TURN "), &
5039	& TRIM("total turnover rate "), &
5040	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5041	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5042
5043	! Leaf turnover
5044	CALL histdef (hist_id_stom, &
5045	& TRIM("LEAF_TURN "), &
5046	& TRIM("Leaf turnover "), &
5047	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5048	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5049
5050	! Sap turnover above
5051	CALL histdef (hist_id_stom, &
5052	& TRIM("SAP_AB_TURN "), &
5053	& TRIM("Sap turnover above "), &
5054	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5055	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5056
5057	! Root turnover
5058	CALL histdef (hist_id_stom, &
5059	& TRIM("ROOT_TURN "), &
5060	& TRIM("Root turnover "), &
5061	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5062	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5063
5064	! Fruit turnover
5065	CALL histdef (hist_id_stom, &
5066	& TRIM("FRUIT_TURN "), &
5067	& TRIM("Fruit turnover "), &
5068	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5069	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5070
5071	! total conversion of biomass to litter
5072	CALL histdef (hist_id_stom, &
5073	& TRIM("TOTAL_BM_LITTER "), &
5074	& TRIM("total conversion of biomass to litter "), &
5075	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5076	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5077
5078	! Leaf death
5079	CALL histdef (hist_id_stom, &
5080	& TRIM("LEAF_BM_LITTER "), &
5081	& TRIM("Leaf death "), &
5082	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5083	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5084
5085	! Sap death above ground
5086	CALL histdef (hist_id_stom, &
5087	& TRIM("SAP_AB_BM_LITTER "), &
5088	& TRIM("Sap death above ground "), &
5089	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5090	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5091
5092	! Sap death below ground
5093	CALL histdef (hist_id_stom, &
5094	& TRIM("SAP_BE_BM_LITTER "), &
5095	& TRIM("Sap death below ground "), &
5096	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5097	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5098
5099	! Heartwood death above ground
5100	CALL histdef (hist_id_stom, &
5101	& TRIM("HEART_AB_BM_LITTER "), &
5102	& TRIM("Heartwood death above ground "), &
5103	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5104	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5105
5106	! Heartwood death below ground
5107	CALL histdef (hist_id_stom, &
5108	& TRIM("HEART_BE_BM_LITTER "), &
5109	& TRIM("Heartwood death below ground "), &
5110	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5111	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5112
5113	! Root death
5114	CALL histdef (hist_id_stom, &
5115	& TRIM("ROOT_BM_LITTER "), &
5116	& TRIM("Root death "), &
5117	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5118	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5119
5120	! Fruit death
5121	CALL histdef (hist_id_stom, &
5122	& TRIM("FRUIT_BM_LITTER "), &
5123	& TRIM("Fruit death "), &
5124	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5125	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5126
5127	! Carbohydrate reserve death
5128	CALL histdef (hist_id_stom, &
5129	& TRIM("RESERVE_BM_LITTER "), &
5130	& TRIM("Carbohydrate reserve death "), &
5131	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5132	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5133
5134	! Maintenance respiration
5135	CALL histdef (hist_id_stom, &
5136	& TRIM("MAINT_RESP "), &
5137	& TRIM("Maintenance respiration "), &
5138	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5139	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5140
5141	! Growth respiration
5142	CALL histdef (hist_id_stom, &
5143	& TRIM("GROWTH_RESP "), &
5144	& TRIM("Growth respiration "), &
5145	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5146	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5147
5148	! age
5149	CALL histdef (hist_id_stom, &
5150	& TRIM("AGE "), &
5151	& TRIM("age "), &
5152	& TRIM("years "), iim,jjm, hist_hori_id, &
5153	& nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
5154
5155	! height
5156	CALL histdef (hist_id_stom, &
5157	& TRIM("HEIGHT "), &
5158	& TRIM("height "), &
5159	& TRIM("m "), iim,jjm, hist_hori_id, &
5160	& nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
5161
5162	! weekly moisture stress
5163	CALL histdef (hist_id_stom, &
5164	& TRIM("MOISTRESS "), &
5165	& TRIM("weekly moisture stress "), &
5166	& TRIM("- "), iim,jjm, hist_hori_id, &
5167	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
5168
5169	! Maximum rate of carboxylation
5170	CALL histdef (hist_id_stom, &
5171	& TRIM("VCMAX "), &
5172	& TRIM("Maximum rate of carboxylation "), &
5173	& TRIM("- "), iim,jjm, hist_hori_id, &
5174	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5175
5176	! leaf age
5177	CALL histdef (hist_id_stom, &
5178	& TRIM("LEAF_AGE "), &
5179	& TRIM("leaf age "), &
5180	& TRIM("days "), iim,jjm, hist_hori_id, &
5181	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5182
5183	! Fraction of trees that dies (gap)
5184	CALL histdef (hist_id_stom, &
5185	& TRIM("MORTALITY "), &
5186	& TRIM("Fraction of trees that dies (gap) "), &
5187	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5188	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5189
5190	! Fraction of plants killed by fire
5191	CALL histdef (hist_id_stom, &
5192	& TRIM("FIREDEATH "), &
5193	& TRIM("Fraction of plants killed by fire "), &
5194	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5195	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5196
5197	! Density of newly established saplings
5198	CALL histdef (hist_id_stom, &
5199	& TRIM("IND_ESTAB "), &
5200	& TRIM("Density of newly established saplings "), &
5201	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5202	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5203
5204	! Establish tree
5205	CALL histdef (hist_id_stom, &
5206	& TRIM("ESTABTREE "), &
5207	& TRIM("Rate of tree establishement "), &
5208	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5209	& 1,1,1, -99,32, ave(6), dt, hist_dt)
5210
5211	! Establish grass
5212	CALL histdef (hist_id_stom, &
5213	& TRIM("ESTABGRASS "), &
5214	& TRIM("Rate of grass establishement "), &
5215	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5216	& 1,1,1, -99,32, ave(6), dt, hist_dt)
5217
5218	! Fraction of plants that dies (light competition)
5219	CALL histdef (hist_id_stom, &
5220	& TRIM("LIGHT_DEATH "), &
5221	& TRIM("Fraction of plants that dies (light competition) "), &
5222	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5223	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5224
5225	! biomass allocated to leaves
5226	CALL histdef (hist_id_stom, &
5227	& TRIM("BM_ALLOC_LEAF "), &
5228	& TRIM("biomass allocated to leaves "), &
5229	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5230	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5231
5232	! biomass allocated to sapwood above ground
5233	CALL histdef (hist_id_stom, &
5234	& TRIM("BM_ALLOC_SAP_AB "), &
5235	& TRIM("biomass allocated to sapwood above ground "), &
5236	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5237	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5238
5239	! biomass allocated to sapwood below ground
5240	CALL histdef (hist_id_stom, &
5241	& TRIM("BM_ALLOC_SAP_BE "), &
5242	& TRIM("biomass allocated to sapwood below ground "), &
5243	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5244	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5245
5246	! biomass allocated to roots
5247	CALL histdef (hist_id_stom, &
5248	& TRIM("BM_ALLOC_ROOT "), &
5249	& TRIM("biomass allocated to roots "), &
5250	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5251	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5252
5253	! biomass allocated to fruits
5254	CALL histdef (hist_id_stom, &
5255	& TRIM("BM_ALLOC_FRUIT "), &
5256	& TRIM("biomass allocated to fruits "), &
5257	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5258	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5259
5260	! biomass allocated to carbohydrate reserve
5261	CALL histdef (hist_id_stom, &
5262	& TRIM("BM_ALLOC_RES "), &
5263	& TRIM("biomass allocated to carbohydrate reserve "), &
5264	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5265	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5266
5267	! time constant of herbivore activity
5268	CALL histdef (hist_id_stom, &
5269	& TRIM("HERBIVORES "), &
5270	& TRIM("time constant of herbivore activity "), &
5271	& TRIM("days "), iim,jjm, hist_hori_id, &
5272	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5273
5274	! turnover time for grass leaves
5275	CALL histdef (hist_id_stom, &
5276	& TRIM("TURNOVER_TIME "), &
5277	& TRIM("turnover time for grass leaves "), &
5278	& TRIM("days "), iim,jjm, hist_hori_id, &
5279	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5280
5281	! 10 year wood product pool
5282	CALL histdef (hist_id_stom, &
5283	& TRIM("PROD10 "), &
5284	& TRIM("10 year wood product pool "), &
5285	& TRIM("gC/m**2 "), iim,jjm, hist_hori_id, &
5286	& 11,1,11, hist_pool_11axis_id,32, ave(5), dt, hist_dt)
5287
5288	! annual flux for each 10 year wood product pool
5289	CALL histdef (hist_id_stom, &
5290	& TRIM("FLUX10 "), &
5291	& TRIM("annual flux for each 10 year wood product pool "), &
5292	& TRIM("gC/m**2/yr "), iim,jjm, hist_hori_id, &
5293	& 10,1,10, hist_pool_10axis_id,32, ave(5), dt, hist_dt)
5294
5295	! 100 year wood product pool
5296	CALL histdef (hist_id_stom, &
5297	& TRIM("PROD100 "), &
5298	& TRIM("100 year wood product pool "), &
5299	& TRIM("gC/m**2 "), iim,jjm, hist_hori_id, &
5300	& 101,1,101, hist_pool_101axis_id,32, ave(5), dt, hist_dt)
5301
5302	! annual flux for each 100 year wood product pool
5303	CALL histdef (hist_id_stom, &
5304	& TRIM("FLUX100 "), &
5305	& TRIM("annual flux for each 100 year wood product pool "), &
5306	& TRIM("gC/m**2/yr "), iim,jjm, hist_hori_id, &
5307	& 100,1,100, hist_pool_100axis_id,32, ave(5), dt, hist_dt)
5308
5309	! annual release right after deforestation
5310	CALL histdef (hist_id_stom, &
5311	& TRIM("CONVFLUX "), &
5312	& TRIM("annual release right after deforestation "), &
5313	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5314	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5315
5316	! annual release from all 10 year wood product pools
5317	CALL histdef (hist_id_stom, &
5318	& TRIM("CFLUX_PROD10 "), &
5319	& TRIM("annual release from all 10 year wood product pools"), &
5320	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5321	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5322
5323	! annual release from all 100year wood product pools
5324	CALL histdef (hist_id_stom, &
5325	& TRIM("CFLUX_PROD100 "), &
5326	& TRIM("annual release from all 100year wood product pools"), &
5327	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5328	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5329	! agriculure product
5330	CALL histdef (hist_id_stom, &
5331	& TRIM("HARVEST_ABOVE "), &
5332	& TRIM("annual release product after harvest "), &
5333	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5334	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5335
5336
5337	CALL histdef(hist_id_stom, 'RESOLUTION_X', 'E-W resolution', 'm', &
5338	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5339	CALL histdef(hist_id_stom, 'RESOLUTION_Y', 'N-S resolution', 'm', &
5340	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5341	CALL histdef(hist_id_stom, 'CONTFRAC', 'Continental fraction', '1', &
5342	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5343	CALL histdef(hist_id_stom, 'Areas', 'Mesh areas', 'm2', &
5344	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5345
5346	! Special outputs for phenology
5347	CALL histdef (hist_id_stom, &
5348	& TRIM("WHEN_GROWTHINIT "), &
5349	& TRIM("Time elapsed from season beginning "), &
5350	& TRIM("d "), iim,jjm, hist_hori_id, &
5351	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5352
5353	CALL histdef (hist_id_stom, &
5354	& TRIM("TIME_LOWGPP "), &
5355	& TRIM("Time elapsed since the end of GPP "), &
5356	& TRIM("d "), iim,jjm, hist_hori_id, &
5357	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5358
5359	CALL histdef (hist_id_stom, &
5360	& TRIM("PFTPRESENT "), &
5361	& TRIM("PFT exists "), &
5362	& TRIM("d "), iim,jjm, hist_hori_id, &
5363	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5364
5365	CALL histdef (hist_id_stom, &
5366	& TRIM("GDD_MIDWINTER "), &
5367	& TRIM("Growing degree days, since midwinter "), &
5368	& TRIM("degK "), iim,jjm, hist_hori_id, &
5369	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5370
5371	CALL histdef (hist_id_stom, &
5372	& TRIM("NCD_DORMANCE "), &
5373	& TRIM("Number of chilling days, since leaves were lost "), &
5374	& TRIM("d "), iim,jjm, hist_hori_id, &
5375	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5376
5377	CALL histdef (hist_id_stom, &
5378	& TRIM("ALLOW_INITPHENO "), &
5379	& TRIM("Allow to declare beginning of the growing season "), &
5380	& TRIM("- "), iim,jjm, hist_hori_id, &
5381	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5382
5383	CALL histdef (hist_id_stom, &
5384	& TRIM("BEGIN_LEAVES "), &
5385	& TRIM("Signal to start putting leaves on "), &
5386	& TRIM("- "), iim,jjm, hist_hori_id, &
5387	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5388
5389	!---------------------------------
5390	END SUBROUTINE stom_define_history
5391	!
5392	SUBROUTINE stom_IPCC_define_history &
5393	& (hist_id_stom_IPCC, nvm, iim, jjm, dt, &
5394	& hist_dt, hist_hori_id, hist_PFTaxis_id)
5395	! deforestation axis added as arguments
5396
5397	!---------------------------------------------------------------------
5398	!- Tell ioipsl which variables are to be written
5399	!- and on which grid they are defined
5400	!---------------------------------------------------------------------
5401	IMPLICIT NONE
5402	!-
5403	!- Input
5404	!-
5405	!- File id
5406	INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
5407	!- number of PFTs
5408	INTEGER(i_std),INTENT(in) :: nvm
5409	!- Domain size
5410	INTEGER(i_std),INTENT(in) :: iim, jjm
5411	!- Time step of STOMATE (seconds)
5412	REAL(r_std),INTENT(in) :: dt
5413	!- Time step of history file (s)
5414	REAL(r_std),INTENT(in) :: hist_dt
5415	!- id horizontal grid
5416	INTEGER(i_std),INTENT(in) :: hist_hori_id
5417	!- id of PFT axis
5418	INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
5419	!-
5420	!- 1 local
5421	!-
5422	!- Character strings to define operations for histdef
5423	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
5424
5425	!=====================================================================
5426	!- 1 define operations
5427	!=====================================================================
5428	ave(1) = 'ave(scatter(X))'
5429	!=====================================================================
5430	!- 2 surface fields (2d)
5431	!=====================================================================
5432	! Carbon in Vegetation
5433	CALL histdef (hist_id_stom_IPCC, &
5434	& TRIM("cVeg"), &
5435	& TRIM("Carbon in Vegetation"), &
5436	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5437	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5438	! Carbon in Litter Pool
5439	CALL histdef (hist_id_stom_IPCC, &
5440	& TRIM("cLitter"), &
5441	& TRIM("Carbon in Litter Pool"), &
5442	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5443	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5444	! Carbon in Soil Pool
5445	CALL histdef (hist_id_stom_IPCC, &
5446	& TRIM("cSoil"), &
5447	& TRIM("Carbon in Soil Pool"), &
5448	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5449	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5450	! Carbon in Products of Land Use Change
5451	CALL histdef (hist_id_stom_IPCC, &
5452	& TRIM("cProduct"), &
5453	& TRIM("Carbon in Products of Land Use Change"), &
5454	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5455	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5456	! Leaf Area Fraction
5457	CALL histdef (hist_id_stom_IPCC, &
5458	& TRIM("lai"), &
5459	& TRIM("Leaf Area Fraction"), &
5460	& TRIM("1"), iim,jjm, hist_hori_id, &
5461	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5462	! Gross Primary Production
5463	CALL histdef (hist_id_stom_IPCC, &
5464	& TRIM("gpp"), &
5465	& TRIM("Gross Primary Production"), &
5466	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5467	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5468	! Autotrophic Respiration
5469	CALL histdef (hist_id_stom_IPCC, &
5470	& TRIM("ra"), &
5471	& TRIM("Autotrophic Respiration"), &
5472	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5473	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5474	! Net Primary Production
5475	CALL histdef (hist_id_stom_IPCC, &
5476	& TRIM("npp"), &
5477	& TRIM("Net Primary Production"), &
5478	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5479	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5480	! Heterotrophic Respiration
5481	CALL histdef (hist_id_stom_IPCC, &
5482	& TRIM("rh"), &
5483	& TRIM("Heterotrophic Respiration"), &
5484	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5485	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5486	! CO2 Emission from Fire
5487	CALL histdef (hist_id_stom_IPCC, &
5488	& TRIM("fFire"), &
5489	& TRIM("CO2 Emission from Fire"), &
5490	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5491	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5492
5493	! CO2 Flux to Atmosphere from Crop Harvesting
5494	CALL histdef (hist_id_stom_IPCC, &
5495	& TRIM("fHarvest"), &
5496	& TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
5497	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5498	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5499	! CO2 Flux to Atmosphere from Land Use Change
5500	CALL histdef (hist_id_stom_IPCC, &
5501	& TRIM("fLuc"), &
5502	& TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
5503	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5504	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5505	! Net Biospheric Production
5506	CALL histdef (hist_id_stom_IPCC, &
5507	& TRIM("nbp"), &
5508	& TRIM("Net Biospheric Production"), &
5509	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5510	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5511	! Total Carbon Flux from Vegetation to Litter
5512	CALL histdef (hist_id_stom_IPCC, &
5513	& TRIM("fVegLitter"), &
5514	& TRIM("Total Carbon Flux from Vegetation to Litter"), &
5515	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5516	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5517	! Total Carbon Flux from Litter to Soil
5518	CALL histdef (hist_id_stom_IPCC, &
5519	& TRIM("fLitterSoil"), &
5520	& TRIM("Total Carbon Flux from Litter to Soil"), &
5521	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5522	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5523
5524	! Carbon in Leaves
5525	CALL histdef (hist_id_stom_IPCC, &
5526	& TRIM("cLeaf"), &
5527	& TRIM("Carbon in Leaves"), &
5528	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5529	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5530	! Carbon in Wood
5531	CALL histdef (hist_id_stom_IPCC, &
5532	& TRIM("cWood"), &
5533	& TRIM("Carbon in Wood"), &
5534	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5535	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5536	! Carbon in Roots
5537	CALL histdef (hist_id_stom_IPCC, &
5538	& TRIM("cRoot"), &
5539	& TRIM("Carbon in Roots"), &
5540	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5541	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5542	! Carbon in Other Living Compartments
5543	CALL histdef (hist_id_stom_IPCC, &
5544	& TRIM("cMisc"), &
5545	& TRIM("Carbon in Other Living Compartments"), &
5546	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5547	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5548
5549	! Carbon in Above-Ground Litter
5550	CALL histdef (hist_id_stom_IPCC, &
5551	& TRIM("cLitterAbove"), &
5552	& TRIM("Carbon in Above-Ground Litter"), &
5553	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5554	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5555	! Carbon in Below-Ground Litter
5556	CALL histdef (hist_id_stom_IPCC, &
5557	& TRIM("cLitterBelow"), &
5558	& TRIM("Carbon in Below-Ground Litter"), &
5559	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5560	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5561	! Carbon in Fast Soil Pool
5562	CALL histdef (hist_id_stom_IPCC, &
5563	& TRIM("cSoilFast"), &
5564	& TRIM("Carbon in Fast Soil Pool"), &
5565	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5566	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5567	! Carbon in Medium Soil Pool
5568	CALL histdef (hist_id_stom_IPCC, &
5569	& TRIM("cSoilMedium"), &
5570	& TRIM("Carbon in Medium Soil Pool"), &
5571	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5572	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5573	! Carbon in Slow Soil Pool
5574	CALL histdef (hist_id_stom_IPCC, &
5575	& TRIM("cSoilSlow"), &
5576	& TRIM("Carbon in Slow Soil Pool"), &
5577	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5578	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5579
5580	!- 3 PFT: 3rd dimension
5581	! Fractional Land Cover of PFT
5582	CALL histdef (hist_id_stom_IPCC, &
5583	& TRIM("landCoverFrac"), &
5584	& TRIM("Fractional Land Cover of PFT"), &
5585	& TRIM("%"), iim,jjm, hist_hori_id, &
5586	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
5587
5588
5589	! Total Primary Deciduous Tree Cover Fraction
5590	CALL histdef (hist_id_stom_IPCC, &
5591	& TRIM("treeFracPrimDec"), &
5592	& TRIM("Total Primary Deciduous Tree Cover Fraction"), &
5593	& TRIM("%"), iim,jjm, hist_hori_id, &
5594	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5595
5596	! Total Primary Evergreen Tree Cover Fraction
5597	CALL histdef (hist_id_stom_IPCC, &
5598	& TRIM("treeFracPrimEver"), &
5599	& TRIM("Total Primary Evergreen Tree Cover Fraction"), &
5600	& TRIM("%"), iim,jjm, hist_hori_id, &
5601	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5602
5603	! Total C3 PFT Cover Fraction
5604	CALL histdef (hist_id_stom_IPCC, &
5605	& TRIM("c3PftFrac"), &
5606	& TRIM("Total C3 PFT Cover Fraction"), &
5607	& TRIM("%"), iim,jjm, hist_hori_id, &
5608	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5609	! Total C4 PFT Cover Fraction
5610	CALL histdef (hist_id_stom_IPCC, &
5611	& TRIM("c4PftFrac"), &
5612	& TRIM("Total C4 PFT Cover Fraction"), &
5613	& TRIM("%"), iim,jjm, hist_hori_id, &
5614	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5615	! Growth Autotrophic Respiration
5616	CALL histdef (hist_id_stom_IPCC, &
5617	& TRIM("rGrowth"), &
5618	& TRIM("Growth Autotrophic Respiration"), &
5619	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5620	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5621	! Maintenance Autotrophic Respiration
5622	CALL histdef (hist_id_stom_IPCC, &
5623	& TRIM("rMaint"), &
5624	& TRIM("Maintenance Autotrophic Respiration"), &
5625	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5626	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5627	! CO2 Flux from Atmosphere due to NPP Allocation to Leaf
5628	CALL histdef (hist_id_stom_IPCC, &
5629	& TRIM("nppLeaf"), &
5630	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Leaf"), &
5631	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5632	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5633	! CO2 Flux from Atmosphere due to NPP Allocation to Wood
5634	CALL histdef (hist_id_stom_IPCC, &
5635	& TRIM("nppWood"), &
5636	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Wood"), &
5637	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5638	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5639	! CO2 Flux from Atmosphere due to NPP Allocation to Root
5640	CALL histdef (hist_id_stom_IPCC, &
5641	& TRIM("nppRoot"), &
5642	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Root"), &
5643	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5644	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5645	! Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity on Land.
5646	CALL histdef (hist_id_stom_IPCC, &
5647	& TRIM("nep"), &
5648	& TRIM("Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity."), &
5649	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5650	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5651
5652	CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_X', 'E-W resolution', 'm', &
5653	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5654	CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_Y', 'N-S resolution', 'm', &
5655	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5656	CALL histdef(hist_id_stom_IPCC, 'CONTFRAC', 'Continental fraction', '1', &
5657	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5658	CALL histdef(hist_id_stom_IPCC, 'Areas', 'Mesh areas', 'm2', &
5659	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5660
5661	!---------------------------------
5662	END SUBROUTINE stom_IPCC_define_history
5663	END MODULE intersurf

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

Download in other formats: