Context Navigation

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

Last change on this file since 326 was 326, checked in by didier.solyga, 13 years ago
Synchronize intersurf.f90 and slowproc.f90 with the revisions 314 and 317 of the trunk
File size: 277.4 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	!
2906	! control initialisation with sechiba
2907	!
2908	control_flags%ok_sechiba = .TRUE.
2909	!!$ DS : reading of parameters associated to ok_sechiba
2910	IF ( control_flags%ok_sechiba ) THEN
2911	CALL getin_sechiba_parameters
2912	IF ( impose_param ) THEN
2913	CALL getin_sechiba_pft_parameters
2914	WRITE(numout,*)' some sechiba_pft_parameters have been imposed '
2915	ELSE
2916	WRITE(numout,*)' all sechiba_pft_parameters are set to default values'
2917	ENDIF
2918	ENDIF
2919
2920	!
2921	!
2922	! Ensure consistency
2923	!
2924	IF ( control_flags%ok_dgvm ) control_flags%ok_stomate = .TRUE.
2925	IF ( control_flags%ok_stomate ) control_flags%ok_co2 = .TRUE.
2926	!
2927	!Config Key = STOMATE_WATCHOUT
2928	!Config Desc = STOMATE does minimum service
2929	!Config Def = n
2930	!Config Help = set to TRUE if you want STOMATE to read
2931	!Config and write its start files and keep track
2932	!Config of longer-term biometeorological variables.
2933	!Config This is useful if OK_STOMATE is not set,
2934	!Config but if you intend to activate STOMATE later.
2935	!Config In that case, this run can serve as a
2936	!Config spinup for longer-term biometeorological
2937	!Config variables.
2938	!
2939	control_flags%stomate_watchout = .FALSE.
2940	CALL getin_p('STOMATE_WATCHOUT',control_flags%stomate_watchout)
2941	WRITE(numout,*) 'STOMATE keeps an eye open: ',control_flags%stomate_watchout
2942	!
2943	! Here we need the same initialisation as above
2944	!
2945	control_flags%ok_pheno = .TRUE.
2946	!
2947	!>> july 2011
2948	! DS: activation of sub-models of ORCHIDEE
2949	CALL activate_sub_models(control_flags%ok_sechiba, control_flags%river_routing,control_flags%ok_stomate)
2950	! Vegetation configuration(impose_veg, land_use, lcchnage...previously in slowproc)
2951	CALL veget_config
2952	!
2953	RETURN
2954	!
2955	END SUBROUTINE intsurf_config
2956	!
2957	!
2958	!
2959	SUBROUTINE intsurf_restart(istp, iim, jjm, lon, lat, date0, dt, control_flags, rest_id, rest_id_stom, itau_offset)
2960	!
2961	! This subroutine initialized the restart file for the land-surface scheme
2962	!
2963	IMPLICIT NONE
2964	!
2965	INTEGER(i_std), INTENT(in) :: istp !! Time step of the restart file
2966	INTEGER(i_std), INTENT(in) :: iim, jjm !! Size in x and y of the data to be handeled
2967	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Logitude and latitude of the data points
2968	REAL(r_std) :: date0 !! The date at which itau = 0
2969	REAL(r_std) :: dt !! Time step
2970	INTEGER(i_std), INTENT(out) :: rest_id, rest_id_stom !! ID of the restart file
2971	INTEGER(i_std), INTENT(out) :: itau_offset
2972	!
2973	TYPE(control_type), INTENT(in) :: control_flags !! Flags that (de)activate parts of the model
2974	!
2975	! LOCAL
2976	!
2977	CHARACTER(LEN=80) :: restname_in, restname_out, stom_restname_in, stom_restname_out
2978	REAL(r_std) :: dt_rest, date0_rest
2979	INTEGER(i_std) :: itau_dep
2980	INTEGER(i_std),PARAMETER :: llm=1
2981	REAL(r_std), DIMENSION(llm) :: lev
2982	LOGICAL :: overwrite_time
2983	REAL(r_std) :: in_julian, rest_julian
2984	INTEGER(i_std) :: yy, mm, dd
2985	REAL(r_std) :: ss
2986	!
2987	!Config Key = SECHIBA_restart_in
2988	!Config Desc = Name of restart to READ for initial conditions
2989	!Config Def = NONE
2990	!Config Help = This is the name of the file which will be opened
2991	!Config to extract the initial values of all prognostic
2992	!Config values of the model. This has to be a netCDF file.
2993	!Config Not truly COADS compliant. NONE will mean that
2994	!Config no restart file is to be expected.
2995	!-
2996	restname_in = 'NONE'
2997	CALL getin_p('SECHIBA_restart_in',restname_in)
2998	WRITE(numout,*) 'INPUT RESTART_FILE', restname_in
2999	!-
3000	!Config Key = SECHIBA_rest_out
3001	!Config Desc = Name of restart files to be created by SECHIBA
3002	!Config Def = sechiba_rest_out.nc
3003	!Config Help = This variable give the name for
3004	!Config the restart files. The restart software within
3005	!Config IOIPSL will add .nc if needed.
3006	!
3007	restname_out = 'restart_out.nc'
3008	CALL getin_p('SECHIBA_rest_out', restname_out)
3009	!
3010	!Config Key = SECHIBA_reset_time
3011	!Config Desc = Option to overrides the time of the restart
3012	!Config Def = n
3013	!Config Help = This option allows the model to override the time
3014	!Config found in the restart file of SECHIBA with the time
3015	!Config of the first call. That is the restart time of the GCM.
3016	!
3017	overwrite_time = .FALSE.
3018	CALL getin_p('SECHIBA_reset_time', overwrite_time)
3019	!
3020	lev(:) = zero
3021	itau_dep = istp
3022	in_julian = itau2date(istp, date0, dt)
3023	date0_rest = date0
3024	dt_rest = dt
3025	!
3026	IF (is_root_prc) THEN
3027	CALL restini( restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
3028	& restname_out, itau_dep, date0_rest, dt_rest, rest_id, overwrite_time)
3029	ELSE
3030	rest_id=0
3031	ENDIF
3032	CALL bcast (itau_dep)
3033	CALL bcast (date0_rest)
3034	CALL bcast (dt_rest)
3035	!
3036	! itau_dep of SECHIBA is phased with the GCM if needed
3037	!
3038	rest_julian = itau2date(itau_dep, date0_rest, dt_rest)
3039	!
3040	IF ( ABS( in_julian - rest_julian) .GT. dt/one_day .AND. .NOT. OFF_LINE_MODE ) THEN
3041	IF ( overwrite_time ) THEN
3042	WRITE(numout,*) 'The SECHIBA restart is not for the same timestep as the GCM,'
3043	WRITE(numout,*) 'the two are synchronized. The land-surface conditions can not impose'
3044	WRITE(numout,*) 'the chronology of the simulation.'
3045	WRITE(numout,*) 'Time step of the GCM :', istp, 'Julian day : ', in_julian
3046	CALL ju2ymds(in_julian, yy, mm, dd, ss)
3047	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3048	WRITE(numout,*) 'Time step of SECHIBA :', itau_dep, 'Julian day : ', rest_julian
3049	CALL ju2ymds(rest_julian, yy, mm, dd, ss)
3050	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3051
3052	itau_offset = itau_dep - istp
3053	date0_shifted = date0 - itau_offset*dt/one_day
3054	!MM_ A VOIR : dans le TAG 1.4 :
3055	! date0_shifted = in_julian - itau_dep*dt/one_day
3056	!MM_ Bon calcul ?
3057
3058	WRITE(numout,*) 'The new starting date is :', date0_shifted
3059	CALL ju2ymds(date0_shifted, yy, mm, dd, ss)
3060	WRITE(numout,*) 'In other word (yy,mm,dd,ss) : ', yy, mm, dd, ss
3061	ELSE
3062	WRITE(numout,*) 'IN -> OUT :', istp, '->', itau_dep
3063	WRITE(numout,*) 'IN -> OUT :', in_julian, '->', rest_julian
3064	WRITE(numout,*) 'SECHIBA''s restart file is not consistent with the one of the GCM'
3065	WRITE(numout,*) 'Correct the time axis of the restart file or force the code to change it.'
3066	STOP
3067	ENDIF
3068	ELSE
3069	itau_offset = 0
3070	date0_shifted = date0
3071	ENDIF
3072	!
3073	!!! CALL ioconf_startdate(date0_shifted)
3074	!
3075	!=====================================================================
3076	!- 1.5 Restart file for STOMATE
3077	!=====================================================================
3078	IF ( control_flags%ok_stomate .OR. control_flags%stomate_watchout ) THEN
3079	!-
3080	! STOMATE IS ACTIVATED
3081	!-
3082	!Config Key = STOMATE_RESTART_FILEIN
3083	!Config Desc = Name of restart to READ for initial conditions
3084	!Config of STOMATE
3085	!Config If = STOMATE_OK_STOMATE \|\| STOMATE_WATCHOUT
3086	!Config Def = NONE
3087	!Config Help = This is the name of the file which will be opened
3088	!Config to extract the initial values of all prognostic
3089	!Config values of STOMATE.
3090	!-
3091	stom_restname_in = 'NONE'
3092	CALL getin_p('STOMATE_RESTART_FILEIN',stom_restname_in)
3093	WRITE(numout,*) 'STOMATE INPUT RESTART_FILE', stom_restname_in
3094	!-
3095	!Config Key = STOMATE_RESTART_FILEOUT
3096	!Config Desc = Name of restart files to be created by STOMATE
3097	!Config If = STOMATE_OK_STOMATE \|\| STOMATE_WATCHOUT
3098	!Config Def = stomate_restart.nc
3099	!Config Help = This is the name of the file which will be opened
3100	!Config to write the final values of all prognostic values
3101	!Config of STOMATE.
3102	!-
3103	stom_restname_out = 'stomate_restart.nc'
3104	CALL getin_p('STOMATE_RESTART_FILEOUT', stom_restname_out)
3105	WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE', stom_restname_out
3106	!-
3107	IF (is_root_prc) THEN
3108	CALL restini (stom_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
3109	& stom_restname_out, itau_dep, date0_rest, dt_rest, rest_id_stom, overwrite_time)
3110	ELSE
3111	rest_id_stom=0
3112	ENDIF
3113	CALL bcast (itau_dep)
3114	CALL bcast (date0_rest)
3115	CALL bcast (dt_rest)
3116	!-
3117	ENDIF
3118	!
3119	END SUBROUTINE intsurf_restart
3120
3121	SUBROUTINE intsurf_history(iim, jjm, lon, lat, istp_old, date0, dt, control_flags, hist_id, hist2_id, &
3122	& hist_id_stom, hist_id_stom_IPCC)
3123	!
3124	!
3125	! This subroutine initialized the history files for the land-surface scheme
3126	!
3127	IMPLICIT NONE
3128	!
3129	INTEGER(i_std), INTENT(in) :: iim, jjm !! Size in x and y of the data to be handeled
3130	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Longitude and latitude of the data points
3131	INTEGER(i_std), INTENT(in) :: istp_old !! Time step counter
3132	REAL(r_std), INTENT(in) :: date0 !! Julian day at which istp=0
3133	REAL(r_std), INTENT(in) :: dt !! Time step of the counter in seconds
3134	!
3135	TYPE(control_type), INTENT(in) :: control_flags !! Flags that (de)activate parts of the model
3136	!
3137	INTEGER(i_std), INTENT(out) :: hist_id !! History file identification for SECHIBA
3138	INTEGER(i_std), INTENT(out) :: hist2_id !! History file 2 identification for SECHIBA (Hi-frequency ?)
3139	!! History file identification for STOMATE and IPCC
3140	INTEGER(i_std), INTENT(out) :: hist_id_stom, hist_id_stom_IPCC
3141	!
3142	! LOCAL
3143	!
3144	CHARACTER(LEN=80) :: histname,histname2 !! Name of history files for SECHIBA
3145	CHARACTER(LEN=80) :: stom_histname, stom_ipcc_histname !! Name of history files for STOMATE
3146	LOGICAL :: ok_histfile2 !! Flag to switch on histfile 2 for SECHIBA
3147	REAL(r_std) :: dw2 !! frequency of history write (sec.)
3148	CHARACTER(LEN=30) :: flux_op !! Operations to be performed on fluxes
3149	CHARACTER(LEN=30) :: flux_sc !! Operations which do not include a scatter
3150	CHARACTER(LEN=30) :: flux_insec, flux_scinsec !! Operation in seconds
3151	INTEGER(i_std) :: hist_level, hist2_level !! history output level (default is 10 => maximum output)
3152	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
3153	& ave, avecels, avescatter, fluxop, &
3154	& fluxop_scinsec, tmincels, tmaxcels, once, sumscatter !! The various operation to be performed
3155	!!, tmax, fluxop_sc, fluxop_insec, &
3156	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: &
3157	& ave2, avecels2, avescatter2, fluxop2, &
3158	& fluxop_scinsec2, tmincels2, tmaxcels2, once2, sumscatter2 !! The various operation to be performed
3159	!!, tmax2, fluxop_sc2, fluxop_insec2, &
3160	INTEGER(i_std) :: i, jst
3161	! SECHIBA AXIS
3162	INTEGER(i_std) :: hori_id !! ID of the default horizontal longitude and latitude map.
3163	INTEGER(i_std) :: vegax_id, solax_id, soltax_id, nobioax_id !! ID's for two vertical coordinates
3164	INTEGER(i_std) :: solayax_id !! ID for the vertical axis of the CWRR hydrology
3165	INTEGER(i_std) :: hori_id2 !! ID of the default horizontal longitude and latitude map.
3166	INTEGER(i_std) :: vegax_id2, solax_id2, soltax_id2, nobioax_id2, albax_id2 !! ID's for two vertical coordinates
3167	INTEGER(i_std) :: solayax_id2 !! ID for the vertical axis of the CWRR hydrology
3168	! STOMATE AXIS
3169	INTEGER(i_std) :: hist_PFTaxis_id
3170	! deforestation
3171	INTEGER(i_std) :: hist_pool_10axis_id
3172	INTEGER(i_std) :: hist_pool_100axis_id
3173	INTEGER(i_std) :: hist_pool_11axis_id
3174	INTEGER(i_std) :: hist_pool_101axis_id
3175	! STOMATE IPCC AXIS
3176	INTEGER(i_std) :: hist_IPCC_PFTaxis_id
3177	!
3178	LOGICAL :: rectilinear
3179	INTEGER(i_std) :: ier
3180	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect
3181	!
3182	REAL(r_std),DIMENSION(nvm) :: veg
3183	REAL(r_std),DIMENSION(ngrnd) :: sol
3184	REAL(r_std),DIMENSION(nstm) :: soltyp
3185	REAL(r_std),DIMENSION(nnobio):: nobiotyp
3186	REAL(r_std),DIMENSION(2) :: albtyp
3187	REAL(r_std),DIMENSION(nslm) :: solay
3188	!
3189	CHARACTER(LEN=80) :: var_name !! To store variables names
3190	!
3191	! STOMATE history file
3192	REAL(r_std) :: hist_days_stom !!- GK time step in days for this history file
3193	REAL(r_std) :: hist_dt_stom !!- GK time step in seconds for this history file
3194	REAL(r_std) :: dt_slow_ !! for test : time step of slow processes and STOMATE
3195	REAL(r_std),DIMENSION(nvm) :: hist_PFTaxis !!- GK An axis we need for the history files
3196	!
3197	REAL(r_std),DIMENSION(10) :: hist_pool_10axis !! Deforestation axis
3198	REAL(r_std),DIMENSION(100) :: hist_pool_100axis !! Deforestation axis
3199	REAL(r_std),DIMENSION(11) :: hist_pool_11axis !! Deforestation axis
3200	REAL(r_std),DIMENSION(101) :: hist_pool_101axis !! Deforestation axis
3201	!
3202	! IPCC history file
3203	REAL(r_std) :: hist_days_stom_ipcc !!- GK time step in days for this history file
3204	REAL(r_std) :: hist_dt_stom_ipcc !!- GK time step in seconds for this history file
3205	!
3206	!
3207	!
3208	!=====================================================================
3209	!- 3.0 Setting up the history files
3210	!=====================================================================
3211	!- 3.1 SECHIBA
3212	!=====================================================================
3213	!Config Key = ALMA_OUTPUT
3214	!Config Desc = Should the output follow the ALMA convention
3215	!Config Def = n
3216	!Config Help = If this logical flag is set to true the model
3217	!Config will output all its data according to the ALMA
3218	!Config convention. It is the recommended way to write
3219	!Config data out of ORCHIDEE.
3220	!-
3221	almaoutput = .FALSE.
3222	CALL getin_p('ALMA_OUTPUT', almaoutput)
3223	WRITE(numout,*) 'ALMA_OUTPUT', almaoutput
3224	!-
3225	!Config Key = OUTPUT_FILE
3226	!Config Desc = Name of file in which the output is going
3227	!Config to be written
3228	!Config Def = cabauw_out.nc
3229	!Config Help = This file is going to be created by the model
3230	!Config and will contain the output from the model.
3231	!Config This file is a truly COADS compliant netCDF file.
3232	!Config It will be generated by the hist software from
3233	!Config the IOIPSL package.
3234	!-
3235	histname='cabauw_out.nc'
3236	CALL getin_p('OUTPUT_FILE', histname)
3237	WRITE(numout,*) 'OUTPUT_FILE', histname
3238	!-
3239	!Config Key = WRITE_STEP
3240	!Config Desc = Frequency in seconds at which to WRITE output
3241	!Config Def = one_day
3242	!Config Help = This variables gives the frequency the output of
3243	!Config the model should be written into the netCDF file.
3244	!Config It does not affect the frequency at which the
3245	!Config operations such as averaging are done.
3246	!Config That is IF the coding of the calls to histdef
3247	!Config are correct !
3248	!-
3249	dw = one_day
3250	CALL getin_p('WRITE_STEP', dw)
3251	!
3252	veg(1:nvm) = (/ (REAL(i,r_std),i=1,nvm) /)
3253	sol(1:ngrnd) = (/ (REAL(i,r_std),i=1,ngrnd) /)
3254	soltyp(1:nstm) = (/ (REAL(i,r_std),i=1,nstm) /)
3255	nobiotyp(1:nnobio) = (/ (REAL(i,r_std),i=1,nnobio) /)
3256	albtyp(1:2) = (/ (REAL(i,r_std),i=1,2) /)
3257	solay(1:nslm) = (/ (REAL(i,r_std),i=1,nslm) /)
3258	!
3259	!- We need to flux averaging operation as when the data is written
3260	!- from within SECHIBA a scatter is needed. In the driver on the other
3261	!- hand the data is 2D and can be written is it is.
3262	!-
3263	WRITE(flux_op,'("ave(scatter(X*",F8.1,"))")') one_day/dt
3264	! WRITE(flux_op,'("(ave(scatter(X))*",F8.1,")")') one_day/dt
3265	WRITE(flux_sc,'("ave(X*",F8.1,")")') one_day/dt
3266	!WRITE(flux_sc,'("(ave(X)*",F8.1,")")') one_day/dt
3267	WRITE(flux_insec,'("ave(X*",F8.6,")")') un/dt
3268	WRITE(flux_scinsec,'("ave(scatter(X*",F8.6,"))")') un/dt
3269	WRITE(numout,*) flux_op, one_day/dt, dt, dw
3270	!-
3271	!Config Key = SECHIBA_HISTLEVEL
3272	!Config Desc = SECHIBA history output level (0..10)
3273	!Config Def = 5
3274	!Config Help = Chooses the list of variables in the history file.
3275	!Config Values between 0: nothing is written; 10: everything is
3276	!Config written are available More details can be found on the web under documentation.
3277	!Config web under documentation.
3278	!-
3279	hist_level = 5
3280	CALL getin_p('SECHIBA_HISTLEVEL', hist_level)
3281	!-
3282	WRITE(numout,*) 'SECHIBA history level: ',hist_level
3283	IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
3284	STOP 'This history level is not allowed'
3285	ENDIF
3286	!-
3287	!- define operations as a function of history level.
3288	!- Above hist_level, operation='never'
3289	!-
3290	ave(1:max_hist_level) = 'ave(X)'
3291	IF (hist_level < max_hist_level) THEN
3292	ave(hist_level+1:max_hist_level) = 'never'
3293	ENDIF
3294	sumscatter(1:max_hist_level) = 't_sum(scatter(X))'
3295	IF (hist_level < max_hist_level) THEN
3296	sumscatter(hist_level+1:max_hist_level) = 'never'
3297	ENDIF
3298	avecels(1:max_hist_level) = 'ave(cels(X))'
3299	IF (hist_level < max_hist_level) THEN
3300	avecels(hist_level+1:max_hist_level) = 'never'
3301	ENDIF
3302	avescatter(1:max_hist_level) = 'ave(scatter(X))'
3303	IF (hist_level < max_hist_level) THEN
3304	avescatter(hist_level+1:max_hist_level) = 'never'
3305	ENDIF
3306	tmincels(1:max_hist_level) = 't_min(cels(X))'
3307	IF (hist_level < max_hist_level) THEN
3308	tmincels(hist_level+1:max_hist_level) = 'never'
3309	ENDIF
3310	tmaxcels(1:max_hist_level) = 't_max(cels(X))'
3311	IF (hist_level < max_hist_level) THEN
3312	tmaxcels(hist_level+1:max_hist_level) = 'never'
3313	ENDIF
3314	!!$ tmax(1:max_hist_level) = 't_max(X)'
3315	!!$ IF (hist_level < max_hist_level) THEN
3316	!!$ tmax(hist_level+1:max_hist_level) = 'never'
3317	!!$ ENDIF
3318	fluxop(1:max_hist_level) = flux_op
3319	IF (hist_level < max_hist_level) THEN
3320	fluxop(hist_level+1:max_hist_level) = 'never'
3321	ENDIF
3322	!!$ fluxop_sc(1:max_hist_level) = flux_sc
3323	!!$ IF (hist_level < max_hist_level) THEN
3324	!!$ fluxop_sc(hist_level+1:max_hist_level) = 'never'
3325	!!$ ENDIF
3326	!!$ fluxop_insec(1:max_hist_level) = flux_insec
3327	!!$ IF (hist_level < max_hist_level) THEN
3328	!!$ fluxop_insec(hist_level+1:max_hist_level) = 'never'
3329	!!$ ENDIF
3330	fluxop_scinsec(1:max_hist_level) = flux_scinsec
3331	IF (hist_level < max_hist_level) THEN
3332	fluxop_scinsec(hist_level+1:max_hist_level) = 'never'
3333	ENDIF
3334	once(1:max_hist_level) = 'once(scatter(X))'
3335	IF (hist_level < max_hist_level) THEN
3336	once(hist_level+1:max_hist_level) = 'never'
3337	ENDIF
3338	!
3339	!-
3340	!- Check if we have by any change a rectilinear grid. This would allow us to
3341	!- simplify the output files.
3342	!
3343	rectilinear = .FALSE.
3344	IF ( ALL(lon(:,:) == SPREAD(lon(:,1), 2, SIZE(lon,2))) .AND. &
3345	& ALL(lat(:,:) == SPREAD(lat(1,:), 1, SIZE(lat,1))) ) THEN
3346	rectilinear = .TRUE.
3347	ALLOCATE(lon_rect(iim),stat=ier)
3348	IF (ier .NE. 0) THEN
3349	WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
3350	STOP 'intersurf_history'
3351	ENDIF
3352	ALLOCATE(lat_rect(jjm),stat=ier)
3353	IF (ier .NE. 0) THEN
3354	WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
3355	STOP 'intersurf_history'
3356	ENDIF
3357	lon_rect(:) = lon(:,1)
3358	lat_rect(:) = lat(1,:)
3359	ENDIF
3360	!-
3361	!-
3362	hist_id = -1
3363	!-
3364	IF ( .NOT. almaoutput ) THEN
3365	!-
3366	IF ( rectilinear ) THEN
3367	#ifdef CPP_PARA
3368	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3369	& istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
3370	#else
3371	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3372	& istp_old, date0, dt, hori_id, hist_id)
3373	#endif
3374	WRITE(numout,*) 'HISTBEG --->',istp_old,date0,dt,dw,hist_id
3375	ELSE
3376	#ifdef CPP_PARA
3377	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3378	& istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
3379	#else
3380	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3381	& istp_old, date0, dt, hori_id, hist_id)
3382	#endif
3383	ENDIF
3384	!-
3385	CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
3386	& nvm, veg, vegax_id)
3387	CALL histvert(hist_id, 'solth', 'Soil levels', 'm', &
3388	& ngrnd, sol, solax_id)
3389	CALL histvert(hist_id, 'soiltyp', 'Soil types', '1', &
3390	& nstm, soltyp, soltax_id)
3391	CALL histvert(hist_id, 'nobio', 'Other surface types', '1', &
3392	& nnobio, nobiotyp, nobioax_id)
3393	IF ( control_flags%hydrol_cwrr ) THEN
3394	CALL histvert(hist_id, 'solay', 'Hydrol soil levels', 'm', &
3395	& nslm, solay, solayax_id)
3396	ENDIF
3397	!-
3398	!- SECHIBA_HISTLEVEL = 1
3399	!-
3400	CALL histdef(hist_id, 'evap', 'Evaporation', 'mm/d', &
3401	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3402	CALL histdef(hist_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
3403	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3404	CALL histdef(hist_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
3405	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3406	CALL histdef(hist_id, 'temp_sol', 'Surface Temperature', 'C', &
3407	& iim,jjm, hori_id, 1,1,1, -99, 32, avecels(1), dt,dw)
3408	CALL histdef(hist_id, 'rain', 'Rainfall', 'mm/d', &
3409	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3410	CALL histdef(hist_id, 'snowf', 'Snowfall', 'mm/d', &
3411	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(1), dt,dw)
3412	CALL histdef(hist_id, 'netrad', 'Net radiation', 'W/m^2', &
3413	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3414	CALL histdef(hist_id, 'lai', 'Leaf Area Index', '1', &
3415	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(1), dt,dw)
3416	IF ( control_flags%river_routing ) THEN
3417	CALL histdef(hist_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
3418	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3419	CALL histdef(hist_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
3420	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3421	ENDIF
3422	!-
3423	!- SECHIBA_HISTLEVEL = 2
3424	!-
3425	CALL histdef(hist_id, 'subli', 'Sublimation', 'mm/d', &
3426	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3427	CALL histdef(hist_id, 'evapnu', 'Bare soil evaporation', 'mm/d', &
3428	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3429	CALL histdef(hist_id, 'runoff', 'Surface runoff', 'mm/d', &
3430	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3431	CALL histdef(hist_id, 'drainage', 'Deep drainage', 'mm/d', &
3432	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3433	IF ( control_flags%river_routing ) THEN
3434	CALL histdef(hist_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
3435	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(2), dt,dw)
3436	CALL histdef(hist_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
3437	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
3438	ENDIF
3439	IF ( control_flags%hydrol_cwrr ) THEN
3440	CALL histdef(hist_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
3441	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3442	CALL histdef(hist_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
3443	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3444	CALL histdef(hist_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
3445	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3446	CALL histdef(hist_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
3447	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, fluxop(2), dt,dw)
3448	ENDIF
3449	!
3450	CALL histdef(hist_id, 'tair', 'Air Temperature', 'K', &
3451	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3452	CALL histdef(hist_id, 'qair', 'Air humidity', 'g/g', &
3453	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3454	! Ajouts Nathalie - Juillet 2006
3455	CALL histdef(hist_id, 'q2m', '2m Air humidity', 'g/g', &
3456	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3457	CALL histdef(hist_id, 't2m', '2m Air Temperature', 'K', &
3458	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3459	! Fin ajouts Nathalie
3460	CALL histdef(hist_id, 'alb_vis', 'Albedo visible', '1', &
3461	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3462	CALL histdef(hist_id, 'alb_nir', 'Albedo near infrared', '1', &
3463	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3464	! Ajouts Nathalie - Septembre 2008
3465	CALL histdef(hist_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
3466	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3467	CALL histdef(hist_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
3468	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3469	CALL histdef(hist_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
3470	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3471	CALL histdef(hist_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
3472	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3473	! Fin ajouts Nathalie - Septembre 2008
3474	CALL histdef(hist_id, 'z0', 'Surface roughness', 'm', &
3475	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3476	CALL histdef(hist_id, 'roughheight', 'Effective roughness height', 'm', &
3477	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(2), dt,dw)
3478	CALL histdef(hist_id, 'transpir', 'Transpiration', 'mm/d', &
3479	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
3480	CALL histdef(hist_id, 'inter', 'Interception loss', 'mm/d', &
3481	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(2), dt,dw)
3482	!-
3483	!- SECHIBA_HISTLEVEL = 3
3484	!-
3485	CALL histdef(hist_id, 'tsol_max', 'Maximum Surface Temperature',&
3486	& 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmaxcels(3), dt,dw)
3487	CALL histdef(hist_id, 'tsol_min', 'Minimum Surface Temperature',&
3488	& 'C', iim,jjm, hori_id, 1,1,1, -99, 32, tmincels(3), dt,dw)
3489	CALL histdef(hist_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2', &
3490	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
3491	CALL histdef(hist_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2', &
3492	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(3), dt,dw)
3493	CALL histdef(hist_id, 'snow', 'Snow mass', 'kg/m^2', &
3494	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
3495	CALL histdef(hist_id, 'snowage', 'Snow age', '?', &
3496	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(3), dt,dw)
3497	CALL histdef(hist_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
3498	& iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3499	CALL histdef(hist_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
3500	& iim,jjm, hori_id, nnobio,1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3501	CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
3502	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3503	CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
3504	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3505	CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
3506	& iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3507	IF ( control_flags%hydrol_cwrr ) THEN
3508	DO jst=1,nstm
3509
3510	! var_name= "mc_1" ... "mc_3"
3511	WRITE (var_name,"('moistc_',i1)") jst
3512	CALL histdef(hist_id, var_name, 'Soil Moisture profile for soil type', '%', &
3513	& iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(3), dt,dw)
3514
3515	! var_name= "vegetsoil_1" ... "vegetsoil_3"
3516	WRITE (var_name,"('vegetsoil_',i1)") jst
3517	CALL histdef(hist_id, var_name, 'Fraction of vegetation on soil types', '%', &
3518	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3519
3520	ENDDO
3521	ENDIF
3522	!-
3523	!- SECHIBA_HISTLEVEL = 4
3524	!-
3525	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3526	CALL histdef(hist_id, 'dss', 'Up-reservoir Height', 'm', &
3527	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3528	CALL histdef(hist_id, 'gqsb', 'Upper Soil Moisture', '1', &
3529	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3530	CALL histdef(hist_id, 'bqsb', 'Lower Soil Moisture', '1', &
3531	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3532	ELSE
3533	CALL histdef(hist_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
3534	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(4), dt,dw)
3535	CALL histdef(hist_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m2', &
3536	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, avescatter(4), dt,dw)
3537	ENDIF
3538	CALL histdef(hist_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
3539	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3540	CALL histdef(hist_id, 'rstruct', 'Structural resistance', 's/m', &
3541	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(4), dt,dw)
3542	IF ( control_flags%ok_co2 ) THEN
3543	CALL histdef(hist_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
3544	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3545	ENDIF
3546	IF ( control_flags%ok_stomate ) THEN
3547	CALL histdef(hist_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
3548	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3549	CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
3550	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3551	CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
3552	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3553	CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
3554	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(4), dt,dw)
3555	CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
3556	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt, dw)
3557	ENDIF
3558	CALL histdef(hist_id, 'precisol', 'Throughfall', 'mm/d', &
3559	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop(4), dt,dw)
3560	CALL histdef(hist_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1', &
3561	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(4), dt,dw)
3562	CALL histdef(hist_id, 'evapot', 'Potential evaporation', 'mm/d', &
3563	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
3564	CALL histdef(hist_id, 'evapot_corr', 'Potential evaporation', 'mm/d', &
3565	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(4), dt,dw)
3566	!-
3567	!- SECHIBA_HISTLEVEL = 5
3568	!-
3569	CALL histdef(hist_id, 'swnet', 'Net solar radiation', 'W/m^2', &
3570	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
3571	CALL histdef(hist_id, 'swdown', 'Incident solar radiation', 'W/m^2', &
3572	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(5), dt,dw)
3573	CALL histdef(hist_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2', &
3574	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3575	CALL histdef(hist_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2', &
3576	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3577	CALL histdef(hist_id, 'temp_pheno', 'Temperature for Pheno', 'K', &
3578	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(5), dt,dw)
3579	!-
3580	!- SECHIBA_HISTLEVEL = 6
3581	!-
3582	CALL histdef(hist_id, 'ptn', 'Deep ground temperature', 'K', &
3583	& iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(6), dt,dw)
3584	!-
3585	!- SECHIBA_HISTLEVEL = 7
3586	!-
3587	IF ( control_flags%river_routing ) THEN
3588	CALL histdef(hist_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
3589	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3590	CALL histdef(hist_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
3591	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3592	CALL histdef(hist_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
3593	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3594	CALL histdef(hist_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
3595	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(7), dt,dw)
3596	CALL histdef(hist_id, 'irrigation', 'Net irrigation', 'mm/d', &
3597	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
3598	CALL histdef(hist_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
3599	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop(7), dt,dw)
3600	CALL histdef(hist_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
3601	& iim,jjm, hori_id, 1,1,1, -99, 32, once(7), dt,dw)
3602	ENDIF
3603	!-
3604	!- SECHIBA_HISTLEVEL = 8
3605	!-
3606	CALL histdef(hist_id, 'beta', 'Beta Function', '1', &
3607	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3608	CALL histdef(hist_id, 'raero', 'Aerodynamic resistance', 's/m', &
3609	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3610	! Ajouts Nathalie - Novembre 2006
3611	CALL histdef(hist_id, 'cdrag', 'Drag coefficient for LE and SH', '?', &
3612	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3613	CALL histdef(hist_id, 'Wind', 'Wind speed', 'm/s', &
3614	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3615	! Fin ajouts Nathalie
3616	!MM
3617	CALL histdef(hist_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
3618	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3619	CALL histdef(hist_id, 'vbeta1', 'Beta for sublimation', '1', &
3620	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3621	CALL histdef(hist_id, 'vbeta4', 'Beta for bare soil', '1', &
3622	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(8), dt,dw)
3623	CALL histdef(hist_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
3624	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(8), dt,dw)
3625	CALL histdef(hist_id, 'soiltype', 'Fraction of soil textures', '%', &
3626	& iim,jjm, hori_id, nstm, 1, nstm, soltax_id, 32, once(8), dt,dw)
3627	CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1', &
3628	& iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
3629	!-
3630	!- SECHIBA_HISTLEVEL = 9
3631	!-
3632	!-
3633	!- SECHIBA_HISTLEVEL = 10
3634	!-
3635	CALL histdef(hist_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
3636	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3637	CALL histdef(hist_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
3638	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3639	CALL histdef(hist_id, 'rveget', 'Canopy resistance', 's/m', &
3640	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3641	CALL histdef(hist_id, 'rsol', 'Soil resistance', 's/m', &
3642	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(10), dt,dw)
3643	CALL histdef(hist_id,'vbeta2','Beta for Interception loss','mm/d', &
3644	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3645	CALL histdef(hist_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
3646	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(10), dt,dw)
3647
3648	!- SECHIBA_HISTLEVEL = 11
3649	!-
3650
3651	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3652	CALL histdef(hist_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
3653	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3654
3655	CALL histdef(hist_id, 'mrso', "Total Soil Moisture Content", "kg m-2", &
3656	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3657
3658	CALL histdef(hist_id, 'mrros', "Surface Runoff", "kg m-2 s-1", &
3659	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3660
3661	CALL histdef(hist_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
3662	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3663
3664	CALL histdef(hist_id, 'prveg', "Precipitation onto Canopy", "kg m-2 s-1", &
3665	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3666
3667	ENDIF
3668
3669
3670	CALL histdef(hist_id, 'evspsblveg', "Evaporation from Canopy", "kg m-2 s-1", &
3671	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3672
3673	CALL histdef(hist_id, 'evspsblsoi', "Water Evaporation from Soil", "kg m-2 s-1", &
3674	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3675
3676	CALL histdef(hist_id, 'tran', "Transpiration", "kg m-2 s-1", &
3677	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3678
3679	CALL histdef(hist_id, 'treeFrac', "Tree Cover Fraction", "%", &
3680	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3681
3682	CALL histdef(hist_id, 'grassFrac', "Natural Grass Fraction", "%", &
3683	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3684
3685	CALL histdef(hist_id, 'cropFrac', "Crop Fraction", "%", &
3686	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3687
3688	CALL histdef(hist_id, 'baresoilFrac', "Bare Soil Fraction", "%", &
3689	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3690
3691	CALL histdef(hist_id, 'residualFrac', &
3692	& "Fraction of Grid Cell that is Land but Neither Vegetation-Covered nor Bare Soil", "%", &
3693	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(11), dt,dw)
3694
3695	ELSE
3696	!-
3697	!- This is the ALMA convention output now
3698	!-
3699	!-
3700	IF ( rectilinear ) THEN
3701	#ifdef CPP_PARA
3702	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3703	& istp_old, date0, dt, hori_id, hist_id,orch_domain_id)
3704	#else
3705	CALL histbeg(histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3706	& istp_old, date0, dt, hori_id, hist_id)
3707	#endif
3708	ELSE
3709	#ifdef CPP_PARA
3710	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3711	& istp_old, date0, dt, hori_id, hist_id,domain_id=orch_domain_id)
3712	#else
3713	CALL histbeg(histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
3714	& istp_old, date0, dt, hori_id, hist_id)
3715	#endif
3716	ENDIF
3717	!-
3718	CALL histvert(hist_id, 'veget', 'Vegetation types', '1', &
3719	& nvm, veg, vegax_id)
3720	CALL histvert(hist_id, 'solth', 'Soil levels', 'm', &
3721	& ngrnd, sol, solax_id)
3722	CALL histvert(hist_id, 'soiltyp', 'Soil types', '1', &
3723	& nstm, soltyp, soltax_id)
3724	CALL histvert(hist_id, 'nobio', 'Other surface types', '1', &
3725	& nnobio, nobiotyp, nobioax_id)
3726	IF ( control_flags%hydrol_cwrr ) THEN
3727	CALL histvert(hist_id, 'solay', 'Hydrol soil levels', 'm', &
3728	& nslm, solay, solayax_id)
3729	ENDIF
3730	!-
3731	!- Vegetation
3732	!-
3733	CALL histdef(hist_id, 'vegetfrac', 'Fraction of vegetation', '1', &
3734	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3735	CALL histdef(hist_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
3736	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter(3), dt,dw)
3737	CALL histdef(hist_id, 'nobiofrac', 'Fraction of other surface types', '1', &
3738	& iim,jjm, hori_id, nnobio, 1, nnobio, nobioax_id, 32, avescatter(3), dt,dw)
3739	!-
3740	!- General energy balance
3741	!-
3742	CALL histdef(hist_id, 'SWnet', 'Net shortwave radiation', 'W/m^2', &
3743	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3744	CALL histdef(hist_id, 'LWnet', 'Net longwave radiation', 'W/m^2', &
3745	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3746	CALL histdef(hist_id, 'Qh', 'Sensible heat flux', 'W/m^2', &
3747	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3748	CALL histdef(hist_id, 'Qle', 'Latent heat flux', 'W/m^2', &
3749	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3750	CALL histdef(hist_id, 'Qg', 'Ground heat flux', 'W/m^2', &
3751	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3752	CALL histdef(hist_id, 'Qf', 'Energy of fusion', 'W/m^2', &
3753	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(2), dt,dw)
3754	CALL histdef(hist_id, 'Qv', 'Energy of sublimation', 'W/m^2', &
3755	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3756	CALL histdef(hist_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2', &
3757	& iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
3758	CALL histdef(hist_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2', &
3759	& iim,jjm, hori_id, 1,1,1, -99, 32, sumscatter(1), dt,dw)
3760	!-
3761	!- General water balance
3762	!-
3763	CALL histdef(hist_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s', &
3764	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3765	CALL histdef(hist_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s', &
3766	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3767	CALL histdef(hist_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
3768	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3769	CALL histdef(hist_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
3770	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3771	CALL histdef(hist_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
3772	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3773	CALL histdef(hist_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
3774	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3775	CALL histdef(hist_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2', &
3776	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3777	CALL histdef(hist_id, 'DelSWE', 'Change in SWE','kg/m^2',&
3778	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3779	CALL histdef(hist_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2', &
3780	& iim,jjm, hori_id, 1, 1, 1, -99, 32, sumscatter(1), dt,dw)
3781	!-
3782	!- Surface state
3783	!-
3784	CALL histdef(hist_id, 'AvgSurfT', 'Average surface temperature', 'K', &
3785	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3786	CALL histdef(hist_id, 'RadT', 'Surface radiative temperature', 'K', &
3787	& iim,jjm, hori_id, 1,1,1, -99, 32, ave(1), dt,dw)
3788	CALL histdef(hist_id, 'Albedo', 'Albedo', '1', &
3789	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3790	CALL histdef(hist_id, 'SWE', '3D soil water equivalent','kg/m^2', &
3791	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3792	!!-
3793	!- Sub-surface state
3794	!-
3795	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
3796	CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
3797	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3798	ELSE
3799	CALL histdef(hist_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
3800	& iim,jjm, hori_id, nslm, 1, nslm, solayax_id, 32, avescatter(1), dt,dw)
3801	ENDIF
3802	CALL histdef(hist_id, 'SoilWet', 'Total soil wetness', 'kg/m^2', &
3803	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3804	CALL histdef(hist_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
3805	& iim,jjm, hori_id, ngrnd, 1, ngrnd, solax_id, 32, avescatter(1), dt,dw)
3806	!-
3807	!- Evaporation components
3808	!-
3809	CALL histdef(hist_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
3810	& iim,jjm, hori_id, 1, 1, 1, -99, 32, fluxop_scinsec(1), dt,dw)
3811	CALL histdef(hist_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
3812	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3813	CALL histdef(hist_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
3814	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3815	CALL histdef(hist_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
3816	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3817	CALL histdef(hist_id, 'RootMoist','Root zone soil water', 'kg/m^2', &
3818	& iim,jjm, hori_id, 1, 1, 1, -99, 32, avescatter(1), dt,dw)
3819	CALL histdef(hist_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
3820	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(1), dt,dw)
3821	CALL histdef(hist_id, 'ACond', 'Aerodynamic conductance', 'm/s', &
3822	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3823	!-
3824	!-
3825	!- Cold Season Processes
3826	!-
3827	CALL histdef(hist_id, 'SnowFrac', 'Snow cover fraction', '1', &
3828	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3829	CALL histdef(hist_id, 'SAlbedo', 'Snow albedo', '1', &
3830	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3831	CALL histdef(hist_id, 'SnowDepth', '3D snow depth', 'm', &
3832	& iim,jjm, hori_id, 1,1,1, -99, 32, avescatter(1), dt,dw)
3833	!-
3834	!- Hydrologic variables
3835	!-
3836	CALL histdef(hist_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
3837	& iim,jjm, hori_id, 1,1,1, -99, 32, once(7), dt,dw)
3838	CALL histdef(hist_id, 'dis', 'Simulated River Discharge', 'm^3/s', &
3839	& iim,jjm, hori_id, 1,1,1, -99, 32, fluxop_scinsec(2), dt,dw)
3840	CALL histdef(hist_id, 'humrel', 'Soil moisture stress', '1', &
3841	& iim,jjm, hori_id, nvm,1,nvm, vegax_id, 32, avescatter(8), dt,dw)
3842	!-
3843	!- The carbon budget
3844	!-
3845	IF ( control_flags%ok_co2 ) THEN
3846	CALL histdef(hist_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
3847	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3848	ENDIF
3849	IF ( control_flags%ok_stomate ) THEN
3850	CALL histdef(hist_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
3851	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3852	CALL histdef(hist_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
3853	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3854	CALL histdef(hist_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
3855	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3856	CALL histdef(hist_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
3857	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3858	CALL histdef(hist_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
3859	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, fluxop_scinsec(1), dt,dw)
3860	ENDIF
3861	!
3862	ENDIF
3863	!-
3864	CALL histdef(hist_id, 'LandPoints', 'Land Points', '1', &
3865	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt,dw)
3866	CALL histdef(hist_id, 'Areas', 'Mesh areas', 'm2', &
3867	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
3868	CALL histdef(hist_id, 'Contfrac', 'Continental fraction', '1', &
3869	& iim,jjm, hori_id, 1,1,1, -99, 32, once(1), dt, dw)
3870	!-
3871	CALL histend(hist_id)
3872	!
3873	!
3874	! Second SECHIBA hist file
3875	!
3876	!-
3877	!Config Key = SECHIBA_HISTFILE2
3878	!Config Desc = Flag to switch on histfile 2 for SECHIBA (hi-frequency ?)
3879	!Config Def = FALSE
3880	!Config Help = This Flag switch on the second SECHIBA writing for hi (or low)
3881	!Config frequency writing. This second output is optional and not written
3882	!Config by default.
3883	!Config MM is it right ? Second output file is produced with the same level
3884	!Config as the first one.
3885	!-
3886	ok_histfile2=.FALSE.
3887	CALL getin_p('SECHIBA_HISTFILE2', ok_histfile2)
3888	WRITE(numout,*) 'SECHIBA_HISTFILE2 ', ok_histfile2
3889	!
3890	hist2_id = -1
3891	!
3892	IF (ok_histfile2) THEN
3893	!-
3894	!Config Key = SECHIBA_OUTPUT_FILE2
3895	!Config Desc = Name of file in which the output number 2 is going
3896	!Config to be written
3897	!Config If = SECHIBA_HISTFILE2
3898	!Config Def = sechiba_out_2.nc
3899	!Config Help = This file is going to be created by the model
3900	!Config and will contain the output 2 from the model.
3901	!-
3902	histname2='sechiba_out_2.nc'
3903	CALL getin_p('SECHIBA_OUTPUT_FILE2', histname2)
3904	WRITE(numout,*) 'SECHIBA_OUTPUT_FILE2 ', histname2
3905	!-
3906	!Config Key = WRITE_STEP2
3907	!Config Desc = Frequency in seconds at which to WRITE output
3908	!Config If = SECHIBA_HISTFILE2
3909	!Config Def = 1800.0
3910	!Config Help = This variables gives the frequency the output 2 of
3911	!Config the model should be written into the netCDF file.
3912	!Config It does not affect the frequency at which the
3913	!Config operations such as averaging are done.
3914	!Config That is IF the coding of the calls to histdef
3915	!Config are correct !
3916	!-
3917	dw2 = 1800.0
3918	CALL getin_p('WRITE_STEP2', dw2)
3919	!-
3920	!Config Key = SECHIBA_HISTLEVEL2
3921	!Config Desc = SECHIBA history 2 output level (0..10)
3922	!Config If = SECHIBA_HISTFILE2
3923	!Config Def = 1
3924	!Config Help = Chooses the list of variables in the history file.
3925	!Config Values between 0: nothing is written; 10: everything is
3926	!Config written are available More details can be found on the web under documentation.
3927	!Config web under documentation.
3928	!Config First level contains all ORCHIDEE outputs.
3929	!-
3930	hist2_level = 1
3931	CALL getin_p('SECHIBA_HISTLEVEL2', hist2_level)
3932	!-
3933	WRITE(numout,*) 'SECHIBA history level 2 : ',hist2_level
3934	IF ( (hist2_level > max_hist_level).OR.(hist2_level < 0) ) THEN
3935	STOP 'This history level 2 is not allowed'
3936	ENDIF
3937	!
3938	!-
3939	!- define operations as a function of history level.
3940	!- Above hist2_level, operation='never'
3941	!-
3942	ave2(1:max_hist_level) = 'ave(X)'
3943	IF (hist2_level < max_hist_level) THEN
3944	ave2(hist2_level+1:max_hist_level) = 'never'
3945	ENDIF
3946	sumscatter2(1:max_hist_level) = 't_sum(scatter(X))'
3947	IF (hist2_level < max_hist_level) THEN
3948	sumscatter2(hist2_level+1:max_hist_level) = 'never'
3949	ENDIF
3950	avecels2(1:max_hist_level) = 'ave(cels(X))'
3951	IF (hist2_level < max_hist_level) THEN
3952	avecels2(hist2_level+1:max_hist_level) = 'never'
3953	ENDIF
3954	avescatter2(1:max_hist_level) = 'ave(scatter(X))'
3955	IF (hist2_level < max_hist_level) THEN
3956	avescatter2(hist2_level+1:max_hist_level) = 'never'
3957	ENDIF
3958	tmincels2(1:max_hist_level) = 't_min(cels(X))'
3959	IF (hist2_level < max_hist_level) THEN
3960	tmincels2(hist2_level+1:max_hist_level) = 'never'
3961	ENDIF
3962	tmaxcels2(1:max_hist_level) = 't_max(cels(X))'
3963	IF (hist2_level < max_hist_level) THEN
3964	tmaxcels2(hist2_level+1:max_hist_level) = 'never'
3965	ENDIF
3966	!!$ tmax2(1:max_hist_level) = 't_max(X)'
3967	!!$ IF (hist2_level < max_hist_level) THEN
3968	!!$ tmax2(hist2_level+1:max_hist_level) = 'never'
3969	!!$ ENDIF
3970	fluxop2(1:max_hist_level) = flux_op
3971	IF (hist2_level < max_hist_level) THEN
3972	fluxop2(hist2_level+1:max_hist_level) = 'never'
3973	ENDIF
3974	!!$ fluxop_sc2(1:max_hist_level) = flux_sc
3975	!!$ IF (hist2_level < max_hist_level) THEN
3976	!!$ fluxop_sc2(hist2_level+1:max_hist_level) = 'never'
3977	!!$ ENDIF
3978	!!$ fluxop_insec2(1:max_hist_level) = flux_insec
3979	!!$ IF (hist2_level < max_hist_level) THEN
3980	!!$ fluxop_insec2(hist2_level+1:max_hist_level) = 'never'
3981	!!$ ENDIF
3982	fluxop_scinsec2(1:max_hist_level) = flux_scinsec
3983	IF (hist2_level < max_hist_level) THEN
3984	fluxop_scinsec2(hist2_level+1:max_hist_level) = 'never'
3985	ENDIF
3986	once2(1:max_hist_level) = 'once(scatter(X))'
3987	IF (hist2_level < max_hist_level) THEN
3988	once2(hist2_level+1:max_hist_level) = 'never'
3989	ENDIF
3990	!
3991	IF ( .NOT. almaoutput ) THEN
3992	!-
3993	IF ( rectilinear ) THEN
3994	#ifdef CPP_PARA
3995	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3996	& istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
3997	#else
3998	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
3999	& istp_old, date0, dt, hori_id2, hist2_id)
4000	#endif
4001	WRITE(numout,*) 'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
4002	ELSE
4003	#ifdef CPP_PARA
4004	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4005	& istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
4006	#else
4007	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4008	& istp_old, date0, dt, hori_id2, hist2_id)
4009	#endif
4010	ENDIF
4011	!-
4012	CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
4013	& nvm, veg, vegax_id2)
4014	CALL histvert(hist2_id, 'solth', 'Soil levels', 'm', &
4015	& ngrnd, sol, solax_id2)
4016	CALL histvert(hist2_id, 'soiltyp', 'Soil types', '1', &
4017	& nstm, soltyp, soltax_id2)
4018	CALL histvert(hist2_id, 'nobio', 'Other surface types', '1', &
4019	& nnobio, nobiotyp, nobioax_id2)
4020	CALL histvert(hist2_id, 'albtyp', 'Albedo Types', '1', &
4021	& 2, albtyp, albax_id2)
4022	IF ( control_flags%hydrol_cwrr ) THEN
4023	CALL histvert(hist2_id, 'solay', 'Hydrol soil levels', 'm', &
4024	& nslm, solay, solayax_id2)
4025	ENDIF
4026	!-
4027	!- SECHIBA_HISTLEVEL2 = 1
4028	!-
4029	CALL histdef(hist2_id, 'ptn', 'Deep ground temperature', 'K', &
4030	& iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(1), dt, dw2)
4031	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4032	CALL histdef(hist2_id, 'mrsos', "Moisture in Upper 0.1 m of Soil Column", "kg m-2", &
4033	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt,dw2)
4034
4035	CALL histdef(hist2_id, 'mrro', "Total Runoff", "kg m-2 s-1", &
4036	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt,dw2)
4037	ENDIF
4038	!-
4039	!- SECHIBA_HISTLEVEL2 = 2
4040	!-
4041	CALL histdef(hist2_id, 'cdrag', 'Drag coefficient for LE and SH', '?', &
4042	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
4043	! Ajouts Nathalie - Septembre 2008
4044	CALL histdef(hist2_id, 'soilalb_vis', 'Soil Albedo visible', '1', &
4045	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4046	CALL histdef(hist2_id, 'soilalb_nir', 'Soil Albedo near infrared', '1', &
4047	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4048	CALL histdef(hist2_id, 'vegalb_vis', 'Vegetation Albedo visible', '1', &
4049	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4050	CALL histdef(hist2_id, 'vegalb_nir', 'Vegetation Albedo near infrared', '1', &
4051	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt,dw2)
4052	! Fin ajouts Nathalie - Septembre 2008
4053	CALL histdef(hist2_id, 'z0', 'Surface roughness', 'm', &
4054	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(2), dt, dw2)
4055	CALL histdef(hist2_id, 'coastalflow', 'Diffuse coastal flow', 'm^3/s', &
4056	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4057	CALL histdef(hist2_id, 'riverflow', 'River flow to the oceans', 'm^3/s', &
4058	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4059	CALL histdef(hist2_id, 'tsol_rad', 'Radiative surface temperature', 'C', &
4060	& iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
4061	CALL histdef(hist2_id, 'vevapnu', 'Bare soil evaporation', 'mm/d', &
4062	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
4063	CALL histdef(hist2_id, 'temp_sol', 'New Surface Temperature', 'C', &
4064	& iim,jjm, hori_id2, 1,1,1, -99, 32, avecels2(2), dt, dw2)
4065	CALL histdef(hist2_id, 'qsurf', 'Near surface specific humidity', 'g/g', &
4066	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4067	CALL histdef(hist2_id, 'albedo', 'Albedo', '1', &
4068	& iim,jjm, hori_id2, 2,1,2, albax_id2, 32, avescatter2(2), dt, dw2)
4069	CALL histdef(hist2_id, 'fluxsens', 'Sensible Heat Flux', 'W/m^2', &
4070	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4071	CALL histdef(hist2_id, 'fluxlat', 'Latent Heat Flux', 'W/m^2', &
4072	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4073	CALL histdef(hist2_id, 'emis', 'Surface emissivity', '?', &
4074	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(2), dt, dw2)
4075	!-
4076	!- SECHIBA_HISTLEVEL2 = 3
4077	!-
4078	CALL histdef(hist2_id, 'evap', 'Evaporation', 'mm/d', &
4079	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4080	CALL histdef(hist2_id, 'rain', 'Rainfall', 'mm/d', &
4081	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4082	CALL histdef(hist2_id, 'snowf', 'Snowfall', 'mm/d', &
4083	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(3), dt, dw2)
4084	CALL histdef(hist2_id, 'netrad', 'Net radiation', 'W/m^2', &
4085	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(3), dt, dw2)
4086	CALL histdef(hist2_id, 'lai', 'Leaf Area Index', '1', &
4087	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4088	IF ( control_flags%river_routing ) THEN
4089	CALL histdef(hist2_id, 'basinmap', 'Aproximate map of the river basins', ' ', &
4090	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)
4091	CALL histdef(hist2_id, 'nbrivers', 'Number or rivers in the outflow grid box', ' ', &
4092	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(3), dt, dw2)
4093	ENDIF
4094	!-
4095	!- SECHIBA_HISTLEVEL2 = 4
4096	!-
4097	CALL histdef(hist2_id, 'subli', 'Sublimation', 'mm/d', &
4098	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4099	CALL histdef(hist2_id, 'runoff', 'Surface runoff', 'mm/d', &
4100	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4101	CALL histdef(hist2_id, 'drainage', 'Deep drainage', 'mm/d', &
4102	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4103	IF ( control_flags%river_routing ) THEN
4104	CALL histdef(hist2_id, 'riversret', 'Return from endorheic rivers', 'mm/d', &
4105	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(4), dt, dw2)
4106	CALL histdef(hist2_id, 'hydrographs', 'Hydrographs of gridbox outflow', 'm^3/s', &
4107	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(4), dt, dw2)
4108	ENDIF
4109	IF ( control_flags%hydrol_cwrr ) THEN
4110	CALL histdef(hist2_id, 'evapnu_soil', 'Bare soil evap for soil type', 'mm/d', &
4111	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4112	CALL histdef(hist2_id, 'drainage_soil', 'Drainage for soil type', 'mm/d', &
4113	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4114	CALL histdef(hist2_id, 'transpir_soil', 'Transpir for soil type', 'mm/d', &
4115	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4116	CALL histdef(hist2_id, 'runoff_soil', 'Runoff for soil type', 'mm/d', &
4117	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, fluxop2(4), dt, dw2)
4118	ENDIF
4119	!
4120	CALL histdef(hist2_id, 'tair', 'Air Temperature', 'K', &
4121	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4122	CALL histdef(hist2_id, 'qair', 'Air humidity', 'g/g', &
4123	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4124	! Ajouts Nathalie - Juillet 2006
4125	CALL histdef(hist2_id, 'q2m', '2m Air humidity', 'g/g', &
4126	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4127	CALL histdef(hist2_id, 't2m', '2m Air Temperature', 'K', &
4128	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4129	! Fin ajouts Nathalie
4130	CALL histdef(hist2_id, 'alb_vis', 'Albedo visible', '1', &
4131	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4132	CALL histdef(hist2_id, 'alb_nir', 'Albedo near infrared', '1', &
4133	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(4), dt, dw2)
4134	CALL histdef(hist2_id, 'roughheight', 'Effective roughness height', 'm', &
4135	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(4), dt, dw2)
4136	CALL histdef(hist2_id, 'transpir', 'Transpiration', 'mm/d', &
4137	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
4138	CALL histdef(hist2_id, 'inter', 'Interception loss', 'mm/d', &
4139	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(4), dt, dw2)
4140	!-
4141	!- SECHIBA_HISTLEVEL2 = 5
4142	!-
4143	CALL histdef(hist2_id, 'tsol_max', 'Maximum Surface Temperature',&
4144	& 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmaxcels2(5), dt, dw2)
4145	CALL histdef(hist2_id, 'tsol_min', 'Minimum Surface Temperature',&
4146	& 'C', iim,jjm, hori_id2, 1,1,1, -99, 32, tmincels2(5), dt, dw2)
4147	CALL histdef(hist2_id, 'snow', 'Snow mass', 'kg/m^2', &
4148	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
4149	CALL histdef(hist2_id, 'snowage', 'Snow age', '?', &
4150	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(5), dt, dw2)
4151	CALL histdef(hist2_id, 'snownobio', 'Snow on other surfaces', 'kg/m^2', &
4152	& iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4153	CALL histdef(hist2_id, 'snownobioage', 'Snow age on other surfaces', 'd', &
4154	& iim,jjm, hori_id2, nnobio,1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4155	CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
4156	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4157	CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
4158	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4159	CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
4160	& iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(5), dt, dw2)
4161	IF ( control_flags%hydrol_cwrr ) THEN
4162	DO jst=1,nstm
4163
4164	! var_name= "mc_1" ... "mc_3"
4165	WRITE (var_name,"('moistc_',i1)") jst
4166	CALL histdef(hist2_id, var_name, 'Soil Moisture profile for soil type', '%', &
4167	& iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(5), dt, dw2)
4168
4169	! var_name= "vegetsoil_1" ... "vegetsoil_3"
4170	WRITE (var_name,"('vegetsoil_',i1)") jst
4171	CALL histdef(hist2_id, var_name, 'Fraction of vegetation on soil types', '%', &
4172	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(5), dt, dw2)
4173
4174	ENDDO
4175	ENDIF
4176	!-
4177	!- SECHIBA_HISTLEVEL2 = 6
4178	!-
4179	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4180	CALL histdef(hist2_id, 'dss', 'Up-reservoir Height', 'm', &
4181	& iim,jjm, hori_id, nvm, 1, nvm, vegax_id, 32, avescatter2(6), dt,dw)
4182	CALL histdef(hist2_id, 'gqsb', 'Upper Soil Moisture', '1', &
4183	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4184	CALL histdef(hist2_id, 'bqsb', 'Lower Soil Moisture', '1', &
4185	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4186	ELSE
4187	CALL histdef(hist2_id, 'humtot', 'Total Soil Moisture', 'Kg/m2', &
4188	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(6), dt, dw2)
4189	CALL histdef(hist2_id, 'humtot_soil', 'Soil Moisture for soil type', 'Kg/m2', &
4190	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, avescatter2(6), dt, dw2)
4191	ENDIF
4192	CALL histdef(hist2_id, 'qsintveg', 'Water on canopy', 'Kg/m^2', &
4193	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
4194	CALL histdef(hist2_id, 'rstruct', 'Structural resistance', 's/m', &
4195	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(6), dt, dw2)
4196	IF ( control_flags%ok_co2 ) THEN
4197	CALL histdef(hist2_id, 'gpp', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
4198	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(6), dt,dw2)
4199	ENDIF
4200	IF ( control_flags%ok_stomate ) THEN
4201	CALL histdef(hist2_id, 'nee', 'Net Ecosystem Exchange', 'gC/m^2/s', &
4202	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4203	CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
4204	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4205	CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
4206	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt,dw2)
4207	CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
4208	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt, dw2)
4209	CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
4210	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(2), dt, dw2)
4211	ENDIF
4212	CALL histdef(hist2_id, 'precisol', 'Throughfall', 'mm/d', &
4213	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop2(6), dt, dw2)
4214	CALL histdef(hist2_id, 'drysoil_frac', 'Fraction of visibly dry soil', '1', &
4215	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(6), dt, dw2)
4216	CALL histdef(hist2_id, 'evapot', 'Potential evaporation', 'mm/d', &
4217	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
4218	CALL histdef(hist2_id, 'evapot_corr', 'Potential evaporation', 'mm/d', &
4219	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(6), dt, dw2)
4220	!-
4221	!- SECHIBA_HISTLEVEL2 = 7
4222	!-
4223	CALL histdef(hist2_id, 'swnet', 'Net solar radiation', 'W/m^2', &
4224	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
4225	CALL histdef(hist2_id, 'swdown', 'Incident solar radiation', 'W/m^2', &
4226	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(7), dt, dw2)
4227	CALL histdef(hist2_id, 'lwdown', 'Absorbed downward longwave radiation', 'W/m^2', &
4228	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4229	CALL histdef(hist2_id, 'lwnet', 'Net surface longwave radiation', 'W/m^2', &
4230	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4231	CALL histdef(hist2_id, 'temp_pheno', 'Temperature for Pheno', 'K', &
4232	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(7), dt, dw2)
4233	!-
4234	!- SECHIBA_HISTLEVEL2 = 8
4235	!-
4236	IF ( control_flags%river_routing ) THEN
4237	CALL histdef(hist2_id, 'fastr', 'Fast flow reservoir', 'kg/m^2', &
4238	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4239	CALL histdef(hist2_id, 'slowr', 'Slow flow reservoir', 'kg/m^2', &
4240	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4241	CALL histdef(hist2_id, 'streamr', 'Stream flow reservoir', 'kg/m^2', &
4242	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4243	CALL histdef(hist2_id, 'lakevol', 'Volume in lake reservoir', 'kg/m^2', &
4244	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(8), dt, dw2)
4245	CALL histdef(hist2_id, 'irrigation', 'Net irrigation', 'mm/d', &
4246	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
4247	CALL histdef(hist2_id, 'netirrig', 'Net irrigation requirement', 'mm/d', &
4248	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop2(8), dt, dw2)
4249	CALL histdef(hist2_id, 'irrigmap', 'Map of irrigated areas', 'm^2', &
4250	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(8), dt, dw2)
4251	ENDIF
4252	!-
4253	!- SECHIBA_HISTLEVEL2 = 9
4254	!-
4255	CALL histdef(hist2_id, 'beta', 'Beta Function', '1', &
4256	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4257	CALL histdef(hist2_id, 'raero', 'Aerodynamic resistance', 's/m', &
4258	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4259	! Ajouts Nathalie - Novembre 2006
4260	CALL histdef(hist2_id, 'Wind', 'Wind speed', 'm/s', &
4261	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4262	! Fin ajouts Nathalie
4263	CALL histdef(hist2_id, 'qsatt' , 'Surface saturated humidity', 'g/g', &
4264	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4265	CALL histdef(hist2_id, 'vbeta1', 'Beta for sublimation', '1', &
4266	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4267	CALL histdef(hist2_id, 'vbeta4', 'Beta for bare soil', '1', &
4268	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(9), dt, dw2)
4269	CALL histdef(hist2_id, 'vbetaco2', 'beta for CO2', 'mm/d', &
4270	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4271	CALL histdef(hist2_id, 'soiltype', 'Fraction of soil textures', '%', &
4272	& iim,jjm, hori_id2, nstm, 1, nstm, soltax_id2, 32, once2(9), dt, dw2)
4273	CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1', &
4274	& iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4275	!-
4276	!- SECHIBA_HISTLEVEL2 = 10
4277	!-
4278	CALL histdef(hist2_id, 'cimean', 'Stomatal CO2 concentation', 'mmole/m2/s', &
4279	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4280	CALL histdef(hist2_id, 'vbeta3', 'Beta for Transpiration', 'mm/d', &
4281	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4282	CALL histdef(hist2_id, 'rveget', 'Canopy resistance', 's/m', &
4283	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4284	CALL histdef(hist2_id, 'rsol', 'Soil resistance', 's/m', &
4285	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(10), dt, dw2)
4286	CALL histdef(hist2_id,'vbeta2','Beta for Interception loss','mm/d', &
4287	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4288	CALL histdef(hist2_id, 'qsintmax', 'Maximum Interception capacity', 'Kg/m^2', &
4289	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(10), dt, dw2)
4290	!
4291	ELSE
4292	!-
4293	!- This is the ALMA convention output now
4294	!-
4295	!-
4296	IF ( rectilinear ) THEN
4297	#ifdef CPP_PARA
4298	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4299	& istp_old, date0, dt, hori_id2, hist2_id,orch_domain_id)
4300	#else
4301	CALL histbeg(histname2, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4302	& istp_old, date0, dt, hori_id2, hist2_id)
4303	#endif
4304	WRITE(numout,*) 'HISTBEG2 --->',istp_old,date0,dt,dw2,hist2_id
4305	ELSE
4306	#ifdef CPP_PARA
4307	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4308	& istp_old, date0, dt, hori_id2, hist2_id,domain_id=orch_domain_id)
4309	#else
4310	CALL histbeg(histname2, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4311	& istp_old, date0, dt, hori_id2, hist2_id)
4312	#endif
4313	ENDIF
4314	!-
4315	CALL histvert(hist2_id, 'veget', 'Vegetation types', '1', &
4316	& nvm, veg, vegax_id2)
4317	CALL histvert(hist2_id, 'solth', 'Soil levels', 'm', &
4318	& ngrnd, sol, solax_id2)
4319	CALL histvert(hist2_id, 'soiltyp', 'Soil types', '1', &
4320	& nstm, soltyp, soltax_id2)
4321	CALL histvert(hist2_id, 'nobio', 'Other surface types', '1', &
4322	& nnobio, nobiotyp, nobioax_id2)
4323	IF ( control_flags%hydrol_cwrr ) THEN
4324	CALL histvert(hist2_id, 'solay', 'Hydrol soil levels', 'm', &
4325	& nslm, solay, solayax_id2)
4326	ENDIF
4327	!-
4328	!- Vegetation
4329	!-
4330	CALL histdef(hist2_id, 'vegetfrac', 'Fraction of vegetation', '1', &
4331	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4332	CALL histdef(hist2_id, 'maxvegetfrac', 'Maximum fraction of vegetation', '1', &
4333	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, avescatter2(3), dt, dw2)
4334	CALL histdef(hist2_id, 'nobiofrac', 'Fraction of other surface types', '1', &
4335	& iim,jjm, hori_id2, nnobio, 1, nnobio, nobioax_id2, 32, avescatter2(3), dt, dw2)
4336	!-
4337	!- General energy balance
4338	!-
4339	CALL histdef(hist2_id, 'SWnet', 'Net shortwave radiation', 'W/m^2', &
4340	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4341	CALL histdef(hist2_id, 'LWnet', 'Net longwave radiation', 'W/m^2', &
4342	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4343	CALL histdef(hist2_id, 'Qh', 'Sensible heat flux', 'W/m^2', &
4344	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4345	CALL histdef(hist2_id, 'Qle', 'Latent heat flux', 'W/m^2', &
4346	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4347	CALL histdef(hist2_id, 'Qg', 'Ground heat flux', 'W/m^2', &
4348	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4349	CALL histdef(hist2_id, 'Qf', 'Energy of fusion', 'W/m^2', &
4350	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(2), dt, dw2)
4351	CALL histdef(hist2_id, 'Qv', 'Energy of sublimation', 'W/m^2', &
4352	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4353	CALL histdef(hist2_id, 'DelSurfHeat', 'Change in surface layer heat', 'J/m^2', &
4354	& iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(1), dt, dw2)
4355	CALL histdef(hist2_id, 'DelColdCont', 'Change in snow surface layer cold content', 'J/m^2', &
4356	& iim,jjm, hori_id2, 1,1,1, -99, 32, sumscatter2(1), dt, dw2)
4357	!-
4358	!- General water balance
4359	!-
4360	CALL histdef(hist2_id, 'Snowf', 'Snowfall rate', 'kg/m^2/s', &
4361	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4362	CALL histdef(hist2_id, 'Rainf', 'Rainfall rate', 'kg/m^2/s', &
4363	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4364	CALL histdef(hist2_id, 'Evap', 'Total Evapotranspiration', 'kg/m^2/s', &
4365	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4366	CALL histdef(hist2_id, 'Qs', 'Surface runoff', 'kg/m^2/s', &
4367	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4368	CALL histdef(hist2_id, 'Qsb', 'Sub-surface runoff', 'kg/m^2/s', &
4369	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4370	CALL histdef(hist2_id, 'Qsm', 'Snowmelt', 'kg/m^2/s', &
4371	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4372	CALL histdef(hist2_id, 'DelSoilMoist', 'Change in soil moisture', 'kg/m^2', &
4373	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4374	CALL histdef(hist2_id, 'DelSWE', 'Change in SWE','kg/m^2',&
4375	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4376	CALL histdef(hist2_id, 'DelIntercept', 'Change in interception storage', 'kg/m^2', &
4377	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, sumscatter2(1), dt, dw2)
4378	!-
4379	!- Surface state
4380	!-
4381	CALL histdef(hist2_id, 'AvgSurfT', 'Average surface temperature', 'K', &
4382	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4383	CALL histdef(hist2_id, 'RadT', 'Surface radiative temperature', 'K', &
4384	& iim,jjm, hori_id2, 1,1,1, -99, 32, ave2(1), dt, dw2)
4385	CALL histdef(hist2_id, 'Albedo', 'Albedo', '1', &
4386	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4387	CALL histdef(hist2_id, 'SWE', '3D soil water equivalent','kg/m^2', &
4388	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4389	!!-
4390	!- Sub-surface state
4391	!-
4392	IF ( .NOT. control_flags%hydrol_cwrr ) THEN
4393	CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
4394	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4395	ELSE
4396	CALL histdef(hist2_id, 'SoilMoist', '3D average layer soil moisture', 'kg/m^2', &
4397	& iim,jjm, hori_id2, nslm, 1, nslm, solayax_id2, 32, avescatter2(1), dt, dw2)
4398	ENDIF
4399	CALL histdef(hist2_id, 'SoilWet', 'Total soil wetness', 'kg/m^2', &
4400	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4401	CALL histdef(hist2_id, 'SoilTemp', '3D layer average soil temperature', 'K', &
4402	& iim,jjm, hori_id2, ngrnd, 1, ngrnd, solax_id2, 32, avescatter2(1), dt, dw2)
4403	!-
4404	!- Evaporation components
4405	!-
4406	CALL histdef(hist2_id, 'PotEvap', 'Potential evapotranspiration', 'kg/m^2/s', &
4407	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4408	CALL histdef(hist2_id, 'ECanop', 'Interception evaporation', 'kg/m^2/s', &
4409	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4410	CALL histdef(hist2_id, 'TVeg', 'Transpiration', 'kg/m^2/s', &
4411	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4412	CALL histdef(hist2_id, 'ESoil', 'Bare soil evaporation', 'kg/m^2/s', &
4413	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4414	CALL histdef(hist2_id, 'RootMoist','Root zone soil water', 'kg/m^2', &
4415	& iim,jjm, hori_id2, 1, 1, 1, -99, 32, avescatter2(1), dt, dw2)
4416	CALL histdef(hist2_id, 'SubSnow','Snow sublimation','kg/m^2/s', &
4417	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(1), dt, dw2)
4418	CALL histdef(hist2_id, 'ACond', 'Aerodynamic conductance', 'm/s', &
4419	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4420	!-
4421	!-
4422	!- Cold Season Processes
4423	!-
4424	CALL histdef(hist2_id, 'SnowFrac', 'Snow cover fraction', '1', &
4425	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4426	CALL histdef(hist2_id, 'SAlbedo', 'Snow albedo', '1', &
4427	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4428	CALL histdef(hist2_id, 'SnowDepth', '3D snow depth', 'm', &
4429	& iim,jjm, hori_id2, 1,1,1, -99, 32, avescatter2(1), dt, dw2)
4430	!-
4431	!- Hydrologic variables
4432	!-
4433	CALL histdef(hist2_id, 'IrrigationMap', 'Map of irrigated areas', 'm^2', &
4434	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(7), dt, dw2)
4435	CALL histdef(hist2_id, 'dis', 'Simulated River Discharge', 'm^3/s', &
4436	& iim,jjm, hori_id2, 1,1,1, -99, 32, fluxop_scinsec2(2), dt, dw2)
4437	CALL histdef(hist2_id, 'humrel', 'Soil moisture stress', '1', &
4438	& iim,jjm, hori_id2, nvm,1,nvm, vegax_id2, 32, avescatter2(9), dt, dw2)
4439	!-
4440	!- The carbon budget
4441	!-
4442	IF ( control_flags%ok_co2 ) THEN
4443	CALL histdef(hist2_id, 'GPP', 'Net assimilation of carbon by the vegetation', 'gC/m^2/s', &
4444	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4445	ENDIF
4446	IF ( control_flags%ok_stomate ) THEN
4447	CALL histdef(hist2_id, 'NEE', 'Net Ecosystem Exchange', 'gC/m^2/s', &
4448	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4449	CALL histdef(hist2_id, 'maint_resp', 'Maintenance respiration', 'gC/m^2/s', &
4450	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4451	CALL histdef(hist2_id, 'hetero_resp', 'Heterotrophic respiration', 'gC/m^2/s', &
4452	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt,dw2)
4453	CALL histdef(hist2_id, 'growth_resp', 'Growth respiration', 'gC/m^2/s', &
4454	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4455	CALL histdef(hist2_id, 'npp', 'Net Primary Production', 'gC/m^2/s', &
4456	& iim,jjm, hori_id2, nvm, 1, nvm, vegax_id2, 32, fluxop_scinsec2(1), dt, dw2)
4457	ENDIF
4458	!
4459	ENDIF
4460	!-
4461	CALL histdef(hist2_id, 'LandPoints', 'Land Points', '1', &
4462	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4463	CALL histdef(hist2_id, 'Areas', 'Mesh areas', 'm2', &
4464	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4465	CALL histdef(hist2_id, 'Contfrac', 'Continental fraction', '1', &
4466	& iim,jjm, hori_id2, 1,1,1, -99, 32, once2(1), dt, dw2)
4467	!-
4468	CALL histend(hist2_id)
4469	ENDIF
4470	!-
4471	!=====================================================================
4472	!- 3.2 STOMATE's history file
4473	!=====================================================================
4474	IF ( control_flags%ok_stomate ) THEN
4475	!-
4476	! STOMATE IS ACTIVATED
4477	!-
4478	!Config Key = STOMATE_OUTPUT_FILE
4479	!Config Desc = Name of file in which STOMATE's output is going
4480	!Config to be written
4481	!Config Def = stomate_history.nc
4482	!Config Help = This file is going to be created by the model
4483	!Config and will contain the output from the model.
4484	!Config This file is a truly COADS compliant netCDF file.
4485	!Config It will be generated by the hist software from
4486	!Config the IOIPSL package.
4487	!-
4488	stom_histname='stomate_history.nc'
4489	CALL getin_p('STOMATE_OUTPUT_FILE', stom_histname)
4490	WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
4491	!-
4492	!Config Key = STOMATE_HIST_DT
4493	!Config Desc = STOMATE history time step (d)
4494	!Config Def = 10.
4495	!Config Help = Time step of the STOMATE history file
4496	!-
4497	hist_days_stom = 10.
4498	CALL getin_p('STOMATE_HIST_DT', hist_days_stom)
4499	IF ( hist_days_stom == moins_un ) THEN
4500	hist_dt_stom = moins_un
4501	WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
4502	ELSE
4503	hist_dt_stom = NINT( hist_days_stom ) * one_day
4504	WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
4505	hist_dt_stom/one_day
4506	ENDIF
4507
4508	! test consistency between STOMATE_HIST_DT and DT_SLOW parameters
4509	dt_slow_ = one_day
4510	CALL getin_p('DT_SLOW', dt_slow_)
4511	IF ( hist_days_stom /= moins_un ) THEN
4512	IF (dt_slow_ > hist_dt_stom) THEN
4513	WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_HIST_DT = ",hist_dt_stom
4514	CALL ipslerr (3,'intsurf_history', &
4515	& 'Problem with DT_SLOW > STOMATE_HIST_DT','', &
4516	& '(must be less or equal)')
4517	ENDIF
4518	ENDIF
4519	!-
4520	!- initialize
4521	IF ( rectilinear ) THEN
4522	#ifdef CPP_PARA
4523	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4524	& istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
4525	#else
4526	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4527	& istp_old, date0, dt, hori_id, hist_id_stom)
4528	#endif
4529	ELSE
4530	#ifdef CPP_PARA
4531	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4532	& istp_old, date0, dt, hori_id, hist_id_stom,domain_id=orch_domain_id)
4533	#else
4534	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4535	& istp_old, date0, dt, hori_id, hist_id_stom)
4536	#endif
4537	ENDIF
4538	!- define PFT axis
4539	hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
4540	!- declare this axis
4541	CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
4542	& '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
4543	! deforestation
4544	!- define Pool_10 axis
4545	hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
4546	!- declare this axis
4547	CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
4548	& '1', 10, hist_pool_10axis, hist_pool_10axis_id)
4549
4550	!- define Pool_100 axis
4551	hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
4552	!- declare this axis
4553	CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
4554	& '1', 100, hist_pool_100axis, hist_pool_100axis_id)
4555
4556	!- define Pool_11 axis
4557	hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
4558	!- declare this axis
4559	CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
4560	& '1', 11, hist_pool_11axis, hist_pool_11axis_id)
4561
4562	!- define Pool_101 axis
4563	hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
4564	!- declare this axis
4565	CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
4566	& '1', 101, hist_pool_101axis, hist_pool_101axis_id)
4567
4568	!- define STOMATE history file
4569	CALL stom_define_history (hist_id_stom, nvm, iim, jjm, &
4570	& dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
4571	& hist_pool_10axis_id, hist_pool_100axis_id, &
4572	& hist_pool_11axis_id, hist_pool_101axis_id)
4573
4574	!- end definition
4575	CALL histend(hist_id_stom)
4576	!-
4577	!-
4578	!-
4579	! STOMATE IPCC OUTPUTS IS ACTIVATED
4580	!-
4581	!Config Key = STOMATE_IPCC_OUTPUT_FILE
4582	!Config Desc = Name of file in which STOMATE's output is going
4583	!Config to be written
4584	!Config Def = stomate_ipcc_history.nc
4585	!Config Help = This file is going to be created by the model
4586	!Config and will contain the output from the model.
4587	!Config This file is a truly COADS compliant netCDF file.
4588	!Config It will be generated by the hist software from
4589	!Config the IOIPSL package.
4590	!-
4591	stom_ipcc_histname='stomate_ipcc_history.nc'
4592	CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)
4593	WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
4594	!-
4595	!Config Key = STOMATE_IPCC_HIST_DT
4596	!Config Desc = STOMATE IPCC history time step (d)
4597	!Config Def = 0.
4598	!Config Help = Time step of the STOMATE IPCC history file
4599	!-
4600	hist_days_stom_ipcc = zero
4601	CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)
4602	IF ( hist_days_stom_ipcc == moins_un ) THEN
4603	hist_dt_stom_ipcc = moins_un
4604	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
4605	ELSE
4606	hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
4607	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
4608	hist_dt_stom_ipcc/one_day
4609	ENDIF
4610
4611	! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters
4612	dt_slow_ = one_day
4613	CALL getin_p('DT_SLOW', dt_slow_)
4614	IF ( hist_days_stom_ipcc > zero ) THEN
4615	IF (dt_slow_ > hist_dt_stom_ipcc) THEN
4616	WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
4617	CALL ipslerr (3,'intsurf_history', &
4618	& 'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', &
4619	& '(must be less or equal)')
4620	ENDIF
4621	ENDIF
4622
4623	IF ( hist_dt_stom_ipcc == 0 ) THEN
4624	hist_id_stom_ipcc = -1
4625	ELSE
4626	!-
4627	!- initialize
4628	IF ( rectilinear ) THEN
4629	#ifdef CPP_PARA
4630	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4631	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
4632	#else
4633	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
4634	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
4635	#endif
4636	ELSE
4637	#ifdef CPP_PARA
4638	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4639	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
4640	#else
4641	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
4642	& istp_old, date0, dt, hori_id, hist_id_stom_ipcc)
4643	#endif
4644	ENDIF
4645	!- declare this axis
4646	CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
4647	& '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
4648
4649	!- define STOMATE history file
4650	CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, &
4651	& dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
4652
4653	!- end definition
4654	CALL histend(hist_id_stom_IPCC)
4655
4656	ENDIF
4657	ENDIF
4658
4659
4660	RETURN
4661
4662	END SUBROUTINE intsurf_history
4663	!
4664	SUBROUTINE stom_define_history &
4665	& (hist_id_stom, nvm, iim, jjm, dt, &
4666	& hist_dt, hist_hori_id, hist_PFTaxis_id, &
4667	& hist_pool_10axis_id, hist_pool_100axis_id, &
4668	& hist_pool_11axis_id, hist_pool_101axis_id)
4669	! deforestation axis added as arguments
4670
4671	!---------------------------------------------------------------------
4672	!- Tell ioipsl which variables are to be written
4673	!- and on which grid they are defined
4674	!---------------------------------------------------------------------
4675	IMPLICIT NONE
4676	!-
4677	!- Input
4678	!-
4679	!- File id
4680	INTEGER(i_std),INTENT(in) :: hist_id_stom
4681	!- number of PFTs
4682	INTEGER(i_std),INTENT(in) :: nvm
4683	!- Domain size
4684	INTEGER(i_std),INTENT(in) :: iim, jjm
4685	!- Time step of STOMATE (seconds)
4686	REAL(r_std),INTENT(in) :: dt
4687	!- Time step of history file (s)
4688	REAL(r_std),INTENT(in) :: hist_dt
4689	!- id horizontal grid
4690	INTEGER(i_std),INTENT(in) :: hist_hori_id
4691	!- id of PFT axis
4692	INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
4693	!- id of Deforestation axis
4694	INTEGER(i_std),INTENT(in) :: hist_pool_10axis_id,hist_pool_100axis_id
4695	INTEGER(i_std),INTENT(in) :: hist_pool_11axis_id,hist_pool_101axis_id
4696	!-
4697	!- 1 local
4698	!-
4699	!- maximum history level
4700	INTEGER(i_std), PARAMETER :: max_hist_level = 10
4701	!- output level (between 0 and 10)
4702	!- ( 0:nothing is written, 10:everything is written)
4703	INTEGER(i_std) :: hist_level
4704	!- Character strings to define operations for histdef
4705	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
4706
4707	!---------------------------------------------------------------------
4708	!=====================================================================
4709	!- 1 history level
4710	!=====================================================================
4711	!- 1.1 define history levelx
4712	!=====================================================================
4713	!Config Key = STOMATE_HISTLEVEL
4714	!Config Desc = STOMATE history output level (0..10)
4715	!Config Def = 10
4716	!Config Help = 0: nothing is written; 10: everything is written
4717	!-
4718	hist_level = 10
4719	CALL getin_p('STOMATE_HISTLEVEL', hist_level)
4720	!-
4721	WRITE(numout,*) 'STOMATE history level: ',hist_level
4722	IF ( (hist_level > max_hist_level).OR.(hist_level < 0) ) THEN
4723	STOP 'This history level is not allowed'
4724	ENDIF
4725	!=====================================================================
4726	!- 1.2 define operations according to output level
4727	!=====================================================================
4728	ave(1:hist_level) = 'ave(scatter(X))'
4729	ave(hist_level+1:max_hist_level) = 'never '
4730	!=====================================================================
4731	!- 2 surface fields (2d)
4732	!- 3 PFT: 3rd dimension
4733	!=====================================================================
4734
4735
4736	! structural litter above ground
4737	CALL histdef (hist_id_stom, &
4738	& TRIM("LITTER_STR_AB "), &
4739	& TRIM("structural litter above ground "), &
4740	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4741	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4742
4743	! metabolic litter above ground
4744	CALL histdef (hist_id_stom, &
4745	& TRIM("LITTER_MET_AB "), &
4746	& TRIM("metabolic litter above ground "), &
4747	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4748	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4749
4750	! structural litter below ground
4751	CALL histdef (hist_id_stom, &
4752	& TRIM("LITTER_STR_BE "), &
4753	& TRIM("structural litter below ground "), &
4754	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4755	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4756
4757	! metabolic litter below ground
4758	CALL histdef (hist_id_stom, &
4759	& TRIM("LITTER_MET_BE "), &
4760	& TRIM("metabolic litter below ground "), &
4761	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4762	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4763
4764	! fraction of soil covered by dead leaves
4765	CALL histdef (hist_id_stom, &
4766	& TRIM("DEADLEAF_COVER "), &
4767	& TRIM("fraction of soil covered by dead leaves "), &
4768	& TRIM("- "), iim,jjm, hist_hori_id, &
4769	& 1,1,1, -99,32, ave(5), dt, hist_dt)
4770
4771	! total soil and litter carbon
4772	CALL histdef (hist_id_stom, &
4773	& TRIM("TOTAL_SOIL_CARB "), &
4774	& TRIM("total soil and litter carbon "), &
4775	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4776	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4777
4778	! active soil carbon in ground
4779	CALL histdef (hist_id_stom, &
4780	& TRIM("CARBON_ACTIVE "), &
4781	& TRIM("active soil carbon in ground "), &
4782	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4783	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4784
4785	! slow soil carbon in ground
4786	CALL histdef (hist_id_stom, &
4787	& TRIM("CARBON_SLOW "), &
4788	& TRIM("slow soil carbon in ground "), &
4789	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4790	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4791
4792	! passive soil carbon in ground
4793	CALL histdef (hist_id_stom, &
4794	& TRIM("CARBON_PASSIVE "), &
4795	& TRIM("passive soil carbon in ground "), &
4796	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4797	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
4798
4799	! Long term 2 m temperature
4800	CALL histdef (hist_id_stom, &
4801	& TRIM("T2M_LONGTERM "), &
4802	& TRIM("Longterm 2 m temperature "), &
4803	& TRIM("K "), iim,jjm, hist_hori_id, &
4804	& 1,1,1, -99,32, ave(9), dt, hist_dt)
4805
4806	! Monthly 2 m temperature
4807	CALL histdef (hist_id_stom, &
4808	& TRIM("T2M_MONTH "), &
4809	& TRIM("Monthly 2 m temperature "), &
4810	& TRIM("K "), iim,jjm, hist_hori_id, &
4811	& 1,1,1, -99,32, ave(1), dt, hist_dt)
4812
4813	! Weekly 2 m temperature
4814	CALL histdef (hist_id_stom, &
4815	& TRIM("T2M_WEEK "), &
4816	& TRIM("Weekly 2 m temperature "), &
4817	& TRIM("K "), iim,jjm, hist_hori_id, &
4818	& 1,1,1, -99,32, ave(1), dt, hist_dt)
4819
4820	! heterotr. resp. from ground
4821	CALL histdef (hist_id_stom, &
4822	& TRIM("HET_RESP "), &
4823	& TRIM("heterotr. resp. from ground "), &
4824	& TRIM("gC/m^2 tot/pft/day "), iim,jjm, hist_hori_id, &
4825	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4826
4827	! black carbon on average total ground
4828	CALL histdef (hist_id_stom, &
4829	& TRIM("BLACK_CARBON "), &
4830	& TRIM("black carbon on average total ground "), &
4831	& TRIM("gC/m^2 tot "), iim,jjm, hist_hori_id, &
4832	& 1,1,1, -99,32, ave(10), dt, hist_dt)
4833
4834	! Fire fraction on ground
4835	CALL histdef (hist_id_stom, &
4836	& TRIM("FIREFRAC "), &
4837	& TRIM("Fire fraction on ground "), &
4838	& TRIM("1/day "), iim,jjm, hist_hori_id, &
4839	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4840
4841	! Fire index on ground
4842	CALL histdef (hist_id_stom, &
4843	& TRIM("FIREINDEX "), &
4844	& TRIM("Fire index on ground "), &
4845	& TRIM("- "), iim,jjm, hist_hori_id, &
4846	& nvm,1,nvm, hist_PFTaxis_id,32, ave(10), dt, hist_dt)
4847
4848	! Litter humidity
4849	CALL histdef (hist_id_stom, &
4850	& TRIM("LITTERHUM "), &
4851	& TRIM("Litter humidity "), &
4852	& TRIM("- "), iim,jjm, hist_hori_id, &
4853	& 1,1,1, -99,32, ave(5), dt, hist_dt)
4854
4855	! CO2 flux
4856	CALL histdef (hist_id_stom, &
4857	& TRIM("CO2FLUX "), &
4858	& TRIM("CO2 flux "), &
4859	& TRIM("gC/m^2/pft/mth "), iim,jjm, hist_hori_id, &
4860	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4861
4862	!!$ CALL histdef(hist_id_stom, &
4863	!!$ & TRIM("CO2FLUX_MONTHLY_SUM "), &
4864	!!$ & TRIM("Monthly CO2 flux Sum "), &
4865	!!$ & TRIM("PgC/m^2/mth "), iim,jjm, hist_hori_id, &
4866	!!$ & 1,1,1, -99, 32, 'inst(scatter(X))', dt, hist_dt)
4867
4868	! Output CO2 flux from fire
4869	CALL histdef (hist_id_stom, &
4870	& TRIM("CO2_FIRE "), &
4871	& TRIM("Output CO2 flux from fire "), &
4872	& TRIM("gC/day/m^2/pft "), iim,jjm, hist_hori_id, &
4873	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4874
4875	! CO2 taken from atmosphere for initiate growth
4876	CALL histdef (hist_id_stom, &
4877	& TRIM("CO2_TAKEN "), &
4878	& TRIM("CO2 taken from atmosphere for initiate growth "), &
4879	& TRIM("gC/day/m^2/pft "), iim,jjm, hist_hori_id, &
4880	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4881
4882	! Leaf Area Index
4883	CALL histdef (hist_id_stom, &
4884	& TRIM("LAI "), &
4885	& TRIM("Leaf Area Index "), &
4886	& TRIM("- "), iim,jjm, hist_hori_id, &
4887	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4888
4889	! Vegetation fraction
4890	CALL histdef (hist_id_stom, &
4891	& TRIM("VEGET "), &
4892	& TRIM("Vegetation fraction "), &
4893	& TRIM("- "), iim,jjm, hist_hori_id, &
4894	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4895
4896	! Maximum vegetation fraction (LAI -> infinity)
4897	CALL histdef (hist_id_stom, &
4898	& TRIM("VEGET_MAX "), &
4899	& TRIM("Maximum vegetation fraction (LAI -> infinity) "), &
4900	& TRIM("- "), iim,jjm, hist_hori_id, &
4901	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4902
4903	! Net primary productivity
4904	CALL histdef (hist_id_stom, &
4905	& TRIM("NPP "), &
4906	& TRIM("Net primary productivity "), &
4907	& TRIM("gC/day/(m^2 tot) "), iim,jjm, hist_hori_id, &
4908	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4909
4910	! Gross primary productivity
4911	CALL histdef (hist_id_stom, &
4912	& TRIM("GPP "), &
4913	& TRIM("Gross primary productivity "), &
4914	& TRIM("gC/day/m^2 "), iim,jjm, hist_hori_id, &
4915	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
4916
4917	! Density of individuals
4918	CALL histdef (hist_id_stom, &
4919	& TRIM("IND "), &
4920	& TRIM("Density of individuals "), &
4921	& TRIM("1/ m^2 "), iim,jjm, hist_hori_id, &
4922	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4923
4924	! Adaptation to climate
4925	CALL histdef (hist_id_stom, &
4926	& TRIM("ADAPTATION "), &
4927	& TRIM("Adaptation to climate (DGVM) "), &
4928	& TRIM("- "), iim,jjm, hist_hori_id, &
4929	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4930
4931	! Probability from regenerative
4932	CALL histdef (hist_id_stom, &
4933	& TRIM("REGENERATION "), &
4934	& TRIM("Probability from regenerative (DGVM) "), &
4935	& TRIM("- "), iim,jjm, hist_hori_id, &
4936	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4937
4938	! crown area of individuals (m**2)
4939	CALL histdef (hist_id_stom, &
4940	& TRIM("CN_IND "), &
4941	& TRIM("crown area of individuals "), &
4942	& TRIM("m^2 "), iim,jjm, hist_hori_id, &
4943	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4944
4945	! woodmass of individuals (gC)
4946	CALL histdef (hist_id_stom, &
4947	& TRIM("WOODMASS_IND "), &
4948	& TRIM("Woodmass of individuals "), &
4949	& TRIM("gC/pft "), iim,jjm, hist_hori_id, &
4950	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
4951
4952	! total living biomass
4953	CALL histdef (hist_id_stom, &
4954	& TRIM("TOTAL_M "), &
4955	& TRIM("Total living biomass "), &
4956	& TRIM("gC/m^2/pft "), iim,jjm, hist_hori_id, &
4957	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
4958
4959	! Leaf mass
4960	CALL histdef (hist_id_stom, &
4961	& TRIM("LEAF_M "), &
4962	& TRIM("Leaf mass "), &
4963	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4964	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
4965
4966	! Sap mass above ground
4967	CALL histdef (hist_id_stom, &
4968	& TRIM("SAP_M_AB "), &
4969	& TRIM("Sap mass above ground "), &
4970	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4971	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
4972
4973	! Sap mass below ground
4974	CALL histdef (hist_id_stom, &
4975	& TRIM("SAP_M_BE "), &
4976	& TRIM("Sap mass below ground "), &
4977	& TRIM("gC/m^2 "), iim,jjm, hist_hori_id, &
4978	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
4979
4980	! Heartwood mass above ground
4981	CALL histdef (hist_id_stom, &
4982	& TRIM("HEART_M_AB "), &
4983	& TRIM("Heartwood mass above ground "), &
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	! Heartwood mass below ground
4988	CALL histdef (hist_id_stom, &
4989	& TRIM("HEART_M_BE "), &
4990	& TRIM("Heartwood mass below 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	! Root mass
4995	CALL histdef (hist_id_stom, &
4996	& TRIM("ROOT_M "), &
4997	& TRIM("Root mass "), &
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	! Fruit mass
5002	CALL histdef (hist_id_stom, &
5003	& TRIM("FRUIT_M "), &
5004	& TRIM("Fruit mass "), &
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	! Carbohydrate reserve mass
5009	CALL histdef (hist_id_stom, &
5010	& TRIM("RESERVE_M "), &
5011	& TRIM("Carbohydrate reserve mass "), &
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	! total turnover rate
5016	CALL histdef (hist_id_stom, &
5017	& TRIM("TOTAL_TURN "), &
5018	& TRIM("total turnover rate "), &
5019	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5020	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5021
5022	! Leaf turnover
5023	CALL histdef (hist_id_stom, &
5024	& TRIM("LEAF_TURN "), &
5025	& TRIM("Leaf turnover "), &
5026	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5027	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5028
5029	! Sap turnover above
5030	CALL histdef (hist_id_stom, &
5031	& TRIM("SAP_AB_TURN "), &
5032	& TRIM("Sap turnover above "), &
5033	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5034	& nvm,1,nvm, hist_PFTaxis_id,32, ave(4), dt, hist_dt)
5035
5036	! Root turnover
5037	CALL histdef (hist_id_stom, &
5038	& TRIM("ROOT_TURN "), &
5039	& TRIM("Root turnover "), &
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	! Fruit turnover
5044	CALL histdef (hist_id_stom, &
5045	& TRIM("FRUIT_TURN "), &
5046	& TRIM("Fruit 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	! total conversion of biomass to litter
5051	CALL histdef (hist_id_stom, &
5052	& TRIM("TOTAL_BM_LITTER "), &
5053	& TRIM("total conversion of biomass to litter "), &
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	! Leaf death
5058	CALL histdef (hist_id_stom, &
5059	& TRIM("LEAF_BM_LITTER "), &
5060	& TRIM("Leaf death "), &
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	! Sap death above ground
5065	CALL histdef (hist_id_stom, &
5066	& TRIM("SAP_AB_BM_LITTER "), &
5067	& TRIM("Sap death above ground "), &
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	! Sap death below ground
5072	CALL histdef (hist_id_stom, &
5073	& TRIM("SAP_BE_BM_LITTER "), &
5074	& TRIM("Sap death below ground "), &
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	! Heartwood death above ground
5079	CALL histdef (hist_id_stom, &
5080	& TRIM("HEART_AB_BM_LITTER "), &
5081	& TRIM("Heartwood death above ground "), &
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	! Heartwood death below ground
5086	CALL histdef (hist_id_stom, &
5087	& TRIM("HEART_BE_BM_LITTER "), &
5088	& TRIM("Heartwood death below 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	! Root death
5093	CALL histdef (hist_id_stom, &
5094	& TRIM("ROOT_BM_LITTER "), &
5095	& TRIM("Root death "), &
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	! Fruit death
5100	CALL histdef (hist_id_stom, &
5101	& TRIM("FRUIT_BM_LITTER "), &
5102	& TRIM("Fruit death "), &
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	! Carbohydrate reserve death
5107	CALL histdef (hist_id_stom, &
5108	& TRIM("RESERVE_BM_LITTER "), &
5109	& TRIM("Carbohydrate reserve death "), &
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	! Maintenance respiration
5114	CALL histdef (hist_id_stom, &
5115	& TRIM("MAINT_RESP "), &
5116	& TRIM("Maintenance respiration "), &
5117	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5118	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5119
5120	! Growth respiration
5121	CALL histdef (hist_id_stom, &
5122	& TRIM("GROWTH_RESP "), &
5123	& TRIM("Growth respiration "), &
5124	& TRIM("gC/m^2/day "), iim,jjm, hist_hori_id, &
5125	& nvm,1,nvm, hist_PFTaxis_id,32, ave(2), dt, hist_dt)
5126
5127	! age
5128	CALL histdef (hist_id_stom, &
5129	& TRIM("AGE "), &
5130	& TRIM("age "), &
5131	& TRIM("years "), iim,jjm, hist_hori_id, &
5132	& nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
5133
5134	! height
5135	CALL histdef (hist_id_stom, &
5136	& TRIM("HEIGHT "), &
5137	& TRIM("height "), &
5138	& TRIM("m "), iim,jjm, hist_hori_id, &
5139	& nvm,1,nvm, hist_PFTaxis_id,32, ave(7), dt, hist_dt)
5140
5141	! weekly moisture stress
5142	CALL histdef (hist_id_stom, &
5143	& TRIM("MOISTRESS "), &
5144	& TRIM("weekly moisture stress "), &
5145	& TRIM("- "), iim,jjm, hist_hori_id, &
5146	& nvm,1,nvm, hist_PFTaxis_id,32, ave(3), dt, hist_dt)
5147
5148	! Maximum rate of carboxylation
5149	CALL histdef (hist_id_stom, &
5150	& TRIM("VCMAX "), &
5151	& TRIM("Maximum rate of carboxylation "), &
5152	& TRIM("- "), iim,jjm, hist_hori_id, &
5153	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5154
5155	! leaf age
5156	CALL histdef (hist_id_stom, &
5157	& TRIM("LEAF_AGE "), &
5158	& TRIM("leaf age "), &
5159	& TRIM("days "), iim,jjm, hist_hori_id, &
5160	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5161
5162	! Fraction of trees that dies (gap)
5163	CALL histdef (hist_id_stom, &
5164	& TRIM("MORTALITY "), &
5165	& TRIM("Fraction of trees that dies (gap) "), &
5166	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5167	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5168
5169	! Fraction of plants killed by fire
5170	CALL histdef (hist_id_stom, &
5171	& TRIM("FIREDEATH "), &
5172	& TRIM("Fraction of plants killed by fire "), &
5173	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5174	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5175
5176	! Density of newly established saplings
5177	CALL histdef (hist_id_stom, &
5178	& TRIM("IND_ESTAB "), &
5179	& TRIM("Density of newly established saplings "), &
5180	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5181	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5182
5183	! Establish tree
5184	CALL histdef (hist_id_stom, &
5185	& TRIM("ESTABTREE "), &
5186	& TRIM("Rate of tree establishement "), &
5187	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5188	& 1,1,1, -99,32, ave(6), dt, hist_dt)
5189
5190	! Establish grass
5191	CALL histdef (hist_id_stom, &
5192	& TRIM("ESTABGRASS "), &
5193	& TRIM("Rate of grass establishement "), &
5194	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5195	& 1,1,1, -99,32, ave(6), dt, hist_dt)
5196
5197	! Fraction of plants that dies (light competition)
5198	CALL histdef (hist_id_stom, &
5199	& TRIM("LIGHT_DEATH "), &
5200	& TRIM("Fraction of plants that dies (light competition) "), &
5201	& TRIM("1/day "), iim,jjm, hist_hori_id, &
5202	& nvm,1,nvm, hist_PFTaxis_id,32, ave(6), dt, hist_dt)
5203
5204	! biomass allocated to leaves
5205	CALL histdef (hist_id_stom, &
5206	& TRIM("BM_ALLOC_LEAF "), &
5207	& TRIM("biomass allocated to leaves "), &
5208	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5209	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5210
5211	! biomass allocated to sapwood above ground
5212	CALL histdef (hist_id_stom, &
5213	& TRIM("BM_ALLOC_SAP_AB "), &
5214	& TRIM("biomass allocated to sapwood above ground "), &
5215	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5216	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5217
5218	! biomass allocated to sapwood below ground
5219	CALL histdef (hist_id_stom, &
5220	& TRIM("BM_ALLOC_SAP_BE "), &
5221	& TRIM("biomass allocated to sapwood below ground "), &
5222	& TRIM("gC/m**2/pft/dt "), iim,jjm, hist_hori_id, &
5223	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5224
5225	! biomass allocated to roots
5226	CALL histdef (hist_id_stom, &
5227	& TRIM("BM_ALLOC_ROOT "), &
5228	& TRIM("biomass allocated to roots "), &
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 fruits
5233	CALL histdef (hist_id_stom, &
5234	& TRIM("BM_ALLOC_FRUIT "), &
5235	& TRIM("biomass allocated to fruits "), &
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 carbohydrate reserve
5240	CALL histdef (hist_id_stom, &
5241	& TRIM("BM_ALLOC_RES "), &
5242	& TRIM("biomass allocated to carbohydrate reserve "), &
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	! time constant of herbivore activity
5247	CALL histdef (hist_id_stom, &
5248	& TRIM("HERBIVORES "), &
5249	& TRIM("time constant of herbivore activity "), &
5250	& TRIM("days "), iim,jjm, hist_hori_id, &
5251	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5252
5253	! turnover time for grass leaves
5254	CALL histdef (hist_id_stom, &
5255	& TRIM("TURNOVER_TIME "), &
5256	& TRIM("turnover time for grass leaves "), &
5257	& TRIM("days "), iim,jjm, hist_hori_id, &
5258	& nvm,1,nvm, hist_PFTaxis_id,32, ave(5), dt, hist_dt)
5259
5260	! 10 year wood product pool
5261	CALL histdef (hist_id_stom, &
5262	& TRIM("PROD10 "), &
5263	& TRIM("10 year wood product pool "), &
5264	& TRIM("gC/m**2 "), iim,jjm, hist_hori_id, &
5265	& 11,1,11, hist_pool_11axis_id,32, ave(5), dt, hist_dt)
5266
5267	! annual flux for each 10 year wood product pool
5268	CALL histdef (hist_id_stom, &
5269	& TRIM("FLUX10 "), &
5270	& TRIM("annual flux for each 10 year wood product pool "), &
5271	& TRIM("gC/m**2/yr "), iim,jjm, hist_hori_id, &
5272	& 10,1,10, hist_pool_10axis_id,32, ave(5), dt, hist_dt)
5273
5274	! 100 year wood product pool
5275	CALL histdef (hist_id_stom, &
5276	& TRIM("PROD100 "), &
5277	& TRIM("100 year wood product pool "), &
5278	& TRIM("gC/m**2 "), iim,jjm, hist_hori_id, &
5279	& 101,1,101, hist_pool_101axis_id,32, ave(5), dt, hist_dt)
5280
5281	! annual flux for each 100 year wood product pool
5282	CALL histdef (hist_id_stom, &
5283	& TRIM("FLUX100 "), &
5284	& TRIM("annual flux for each 100 year wood product pool "), &
5285	& TRIM("gC/m**2/yr "), iim,jjm, hist_hori_id, &
5286	& 100,1,100, hist_pool_100axis_id,32, ave(5), dt, hist_dt)
5287
5288	! annual release right after deforestation
5289	CALL histdef (hist_id_stom, &
5290	& TRIM("CONVFLUX "), &
5291	& TRIM("annual release right after deforestation "), &
5292	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5293	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5294
5295	! annual release from all 10 year wood product pools
5296	CALL histdef (hist_id_stom, &
5297	& TRIM("CFLUX_PROD10 "), &
5298	& TRIM("annual release from all 10 year wood product pools"), &
5299	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5300	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5301
5302	! annual release from all 100year wood product pools
5303	CALL histdef (hist_id_stom, &
5304	& TRIM("CFLUX_PROD100 "), &
5305	& TRIM("annual release from all 100year wood product pools"), &
5306	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5307	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5308	! agriculure product
5309	CALL histdef (hist_id_stom, &
5310	& TRIM("HARVEST_ABOVE "), &
5311	& TRIM("annual release product after harvest "), &
5312	& TRIM("gC/m**2/day "), iim,jjm, hist_hori_id, &
5313	& 1,1,1, -99,32, ave(5), dt, hist_dt)
5314
5315
5316	CALL histdef(hist_id_stom, 'RESOLUTION_X', 'E-W resolution', 'm', &
5317	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5318	CALL histdef(hist_id_stom, 'RESOLUTION_Y', 'N-S resolution', 'm', &
5319	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5320	CALL histdef(hist_id_stom, 'CONTFRAC', 'Continental fraction', '1', &
5321	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5322	CALL histdef(hist_id_stom, 'Areas', 'Mesh areas', 'm2', &
5323	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5324
5325	! Special outputs for phenology
5326	CALL histdef (hist_id_stom, &
5327	& TRIM("WHEN_GROWTHINIT "), &
5328	& TRIM("Time elapsed from season beginning "), &
5329	& TRIM("d "), iim,jjm, hist_hori_id, &
5330	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5331
5332	CALL histdef (hist_id_stom, &
5333	& TRIM("TIME_LOWGPP "), &
5334	& TRIM("Time elapsed since the end of GPP "), &
5335	& TRIM("d "), iim,jjm, hist_hori_id, &
5336	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5337
5338	CALL histdef (hist_id_stom, &
5339	& TRIM("PFTPRESENT "), &
5340	& TRIM("PFT exists "), &
5341	& TRIM("d "), iim,jjm, hist_hori_id, &
5342	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5343
5344	CALL histdef (hist_id_stom, &
5345	& TRIM("GDD_MIDWINTER "), &
5346	& TRIM("Growing degree days, since midwinter "), &
5347	& TRIM("degK "), iim,jjm, hist_hori_id, &
5348	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5349
5350	CALL histdef (hist_id_stom, &
5351	& TRIM("NCD_DORMANCE "), &
5352	& TRIM("Number of chilling days, since leaves were lost "), &
5353	& TRIM("d "), iim,jjm, hist_hori_id, &
5354	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5355
5356	CALL histdef (hist_id_stom, &
5357	& TRIM("ALLOW_INITPHENO "), &
5358	& TRIM("Allow to declare beginning of the growing season "), &
5359	& TRIM("- "), iim,jjm, hist_hori_id, &
5360	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5361
5362	CALL histdef (hist_id_stom, &
5363	& TRIM("BEGIN_LEAVES "), &
5364	& TRIM("Signal to start putting leaves on "), &
5365	& TRIM("- "), iim,jjm, hist_hori_id, &
5366	& nvm,1,nvm, hist_PFTaxis_id,32, ave(9), dt, hist_dt)
5367
5368	!---------------------------------
5369	END SUBROUTINE stom_define_history
5370	!
5371	SUBROUTINE stom_IPCC_define_history &
5372	& (hist_id_stom_IPCC, nvm, iim, jjm, dt, &
5373	& hist_dt, hist_hori_id, hist_PFTaxis_id)
5374	! deforestation axis added as arguments
5375
5376	!---------------------------------------------------------------------
5377	!- Tell ioipsl which variables are to be written
5378	!- and on which grid they are defined
5379	!---------------------------------------------------------------------
5380	IMPLICIT NONE
5381	!-
5382	!- Input
5383	!-
5384	!- File id
5385	INTEGER(i_std),INTENT(in) :: hist_id_stom_IPCC
5386	!- number of PFTs
5387	INTEGER(i_std),INTENT(in) :: nvm
5388	!- Domain size
5389	INTEGER(i_std),INTENT(in) :: iim, jjm
5390	!- Time step of STOMATE (seconds)
5391	REAL(r_std),INTENT(in) :: dt
5392	!- Time step of history file (s)
5393	REAL(r_std),INTENT(in) :: hist_dt
5394	!- id horizontal grid
5395	INTEGER(i_std),INTENT(in) :: hist_hori_id
5396	!- id of PFT axis
5397	INTEGER(i_std),INTENT(in) :: hist_PFTaxis_id
5398	!-
5399	!- 1 local
5400	!-
5401	!- Character strings to define operations for histdef
5402	CHARACTER(LEN=40),DIMENSION(max_hist_level) :: ave
5403
5404	!=====================================================================
5405	!- 1 define operations
5406	!=====================================================================
5407	ave(1) = 'ave(scatter(X))'
5408	!=====================================================================
5409	!- 2 surface fields (2d)
5410	!=====================================================================
5411	! Carbon in Vegetation
5412	CALL histdef (hist_id_stom_IPCC, &
5413	& TRIM("cVeg"), &
5414	& TRIM("Carbon in Vegetation"), &
5415	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5416	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5417	! Carbon in Litter Pool
5418	CALL histdef (hist_id_stom_IPCC, &
5419	& TRIM("cLitter"), &
5420	& TRIM("Carbon in Litter Pool"), &
5421	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5422	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5423	! Carbon in Soil Pool
5424	CALL histdef (hist_id_stom_IPCC, &
5425	& TRIM("cSoil"), &
5426	& TRIM("Carbon in Soil Pool"), &
5427	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5428	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5429	! Carbon in Products of Land Use Change
5430	CALL histdef (hist_id_stom_IPCC, &
5431	& TRIM("cProduct"), &
5432	& TRIM("Carbon in Products of Land Use Change"), &
5433	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5434	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5435	! Leaf Area Fraction
5436	CALL histdef (hist_id_stom_IPCC, &
5437	& TRIM("lai"), &
5438	& TRIM("Leaf Area Fraction"), &
5439	& TRIM("1"), iim,jjm, hist_hori_id, &
5440	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5441	! Gross Primary Production
5442	CALL histdef (hist_id_stom_IPCC, &
5443	& TRIM("gpp"), &
5444	& TRIM("Gross Primary Production"), &
5445	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5446	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5447	! Autotrophic Respiration
5448	CALL histdef (hist_id_stom_IPCC, &
5449	& TRIM("ra"), &
5450	& TRIM("Autotrophic Respiration"), &
5451	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5452	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5453	! Net Primary Production
5454	CALL histdef (hist_id_stom_IPCC, &
5455	& TRIM("npp"), &
5456	& TRIM("Net Primary Production"), &
5457	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5458	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5459	! Heterotrophic Respiration
5460	CALL histdef (hist_id_stom_IPCC, &
5461	& TRIM("rh"), &
5462	& TRIM("Heterotrophic Respiration"), &
5463	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5464	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5465	! CO2 Emission from Fire
5466	CALL histdef (hist_id_stom_IPCC, &
5467	& TRIM("fFire"), &
5468	& TRIM("CO2 Emission from Fire"), &
5469	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5470	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5471
5472	! CO2 Flux to Atmosphere from Crop Harvesting
5473	CALL histdef (hist_id_stom_IPCC, &
5474	& TRIM("fHarvest"), &
5475	& TRIM("CO2 Flux to Atmosphere from Crop Harvesting"), &
5476	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5477	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5478	! CO2 Flux to Atmosphere from Land Use Change
5479	CALL histdef (hist_id_stom_IPCC, &
5480	& TRIM("fLuc"), &
5481	& TRIM("CO2 Flux to Atmosphere from Land Use Change"), &
5482	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5483	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5484	! Net Biospheric Production
5485	CALL histdef (hist_id_stom_IPCC, &
5486	& TRIM("nbp"), &
5487	& TRIM("Net Biospheric Production"), &
5488	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5489	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5490	! Total Carbon Flux from Vegetation to Litter
5491	CALL histdef (hist_id_stom_IPCC, &
5492	& TRIM("fVegLitter"), &
5493	& TRIM("Total Carbon Flux from Vegetation to Litter"), &
5494	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5495	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5496	! Total Carbon Flux from Litter to Soil
5497	CALL histdef (hist_id_stom_IPCC, &
5498	& TRIM("fLitterSoil"), &
5499	& TRIM("Total Carbon Flux from Litter to Soil"), &
5500	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5501	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5502
5503	! Carbon in Leaves
5504	CALL histdef (hist_id_stom_IPCC, &
5505	& TRIM("cLeaf"), &
5506	& TRIM("Carbon in Leaves"), &
5507	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5508	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5509	! Carbon in Wood
5510	CALL histdef (hist_id_stom_IPCC, &
5511	& TRIM("cWood"), &
5512	& TRIM("Carbon in Wood"), &
5513	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5514	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5515	! Carbon in Roots
5516	CALL histdef (hist_id_stom_IPCC, &
5517	& TRIM("cRoot"), &
5518	& TRIM("Carbon in Roots"), &
5519	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5520	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5521	! Carbon in Other Living Compartments
5522	CALL histdef (hist_id_stom_IPCC, &
5523	& TRIM("cMisc"), &
5524	& TRIM("Carbon in Other Living Compartments"), &
5525	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5526	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5527
5528	! Carbon in Above-Ground Litter
5529	CALL histdef (hist_id_stom_IPCC, &
5530	& TRIM("cLitterAbove"), &
5531	& TRIM("Carbon in Above-Ground Litter"), &
5532	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5533	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5534	! Carbon in Below-Ground Litter
5535	CALL histdef (hist_id_stom_IPCC, &
5536	& TRIM("cLitterBelow"), &
5537	& TRIM("Carbon in Below-Ground Litter"), &
5538	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5539	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5540	! Carbon in Fast Soil Pool
5541	CALL histdef (hist_id_stom_IPCC, &
5542	& TRIM("cSoilFast"), &
5543	& TRIM("Carbon in Fast Soil Pool"), &
5544	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5545	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5546	! Carbon in Medium Soil Pool
5547	CALL histdef (hist_id_stom_IPCC, &
5548	& TRIM("cSoilMedium"), &
5549	& TRIM("Carbon in Medium Soil Pool"), &
5550	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5551	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5552	! Carbon in Slow Soil Pool
5553	CALL histdef (hist_id_stom_IPCC, &
5554	& TRIM("cSoilSlow"), &
5555	& TRIM("Carbon in Slow Soil Pool"), &
5556	& TRIM("kg C m-2"), iim,jjm, hist_hori_id, &
5557	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5558
5559	!- 3 PFT: 3rd dimension
5560	! Fractional Land Cover of PFT
5561	CALL histdef (hist_id_stom_IPCC, &
5562	& TRIM("landCoverFrac"), &
5563	& TRIM("Fractional Land Cover of PFT"), &
5564	& TRIM("%"), iim,jjm, hist_hori_id, &
5565	& nvm,1,nvm, hist_PFTaxis_id,32, ave(1), dt, hist_dt)
5566
5567
5568	! Total Primary Deciduous Tree Cover Fraction
5569	CALL histdef (hist_id_stom_IPCC, &
5570	& TRIM("treeFracPrimDec"), &
5571	& TRIM("Total Primary Deciduous Tree Cover Fraction"), &
5572	& TRIM("%"), iim,jjm, hist_hori_id, &
5573	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5574
5575	! Total Primary Evergreen Tree Cover Fraction
5576	CALL histdef (hist_id_stom_IPCC, &
5577	& TRIM("treeFracPrimEver"), &
5578	& TRIM("Total Primary Evergreen Tree Cover Fraction"), &
5579	& TRIM("%"), iim,jjm, hist_hori_id, &
5580	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5581
5582	! Total C3 PFT Cover Fraction
5583	CALL histdef (hist_id_stom_IPCC, &
5584	& TRIM("c3PftFrac"), &
5585	& TRIM("Total C3 PFT Cover Fraction"), &
5586	& TRIM("%"), iim,jjm, hist_hori_id, &
5587	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5588	! Total C4 PFT Cover Fraction
5589	CALL histdef (hist_id_stom_IPCC, &
5590	& TRIM("c4PftFrac"), &
5591	& TRIM("Total C4 PFT Cover Fraction"), &
5592	& TRIM("%"), iim,jjm, hist_hori_id, &
5593	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5594	! Growth Autotrophic Respiration
5595	CALL histdef (hist_id_stom_IPCC, &
5596	& TRIM("rGrowth"), &
5597	& TRIM("Growth Autotrophic Respiration"), &
5598	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5599	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5600	! Maintenance Autotrophic Respiration
5601	CALL histdef (hist_id_stom_IPCC, &
5602	& TRIM("rMaint"), &
5603	& TRIM("Maintenance Autotrophic Respiration"), &
5604	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5605	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5606	! CO2 Flux from Atmosphere due to NPP Allocation to Leaf
5607	CALL histdef (hist_id_stom_IPCC, &
5608	& TRIM("nppLeaf"), &
5609	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Leaf"), &
5610	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5611	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5612	! CO2 Flux from Atmosphere due to NPP Allocation to Wood
5613	CALL histdef (hist_id_stom_IPCC, &
5614	& TRIM("nppWood"), &
5615	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Wood"), &
5616	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5617	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5618	! CO2 Flux from Atmosphere due to NPP Allocation to Root
5619	CALL histdef (hist_id_stom_IPCC, &
5620	& TRIM("nppRoot"), &
5621	& TRIM("CO2 Flux from Atmosphere due to NPP Allocation to Root"), &
5622	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5623	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5624	! Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity on Land.
5625	CALL histdef (hist_id_stom_IPCC, &
5626	& TRIM("nep"), &
5627	& TRIM("Net Carbon Mass Flux out of Atmophere due to Net Ecosystem Productivity."), &
5628	& TRIM("kg C m-2 s-1"), iim,jjm, hist_hori_id, &
5629	& 1,1,1, -99,32, ave(1), dt, hist_dt)
5630
5631	CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_X', 'E-W resolution', 'm', &
5632	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5633	CALL histdef(hist_id_stom_IPCC, 'RESOLUTION_Y', 'N-S resolution', 'm', &
5634	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5635	CALL histdef(hist_id_stom_IPCC, 'CONTFRAC', 'Continental fraction', '1', &
5636	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5637	CALL histdef(hist_id_stom_IPCC, 'Areas', 'Mesh areas', 'm2', &
5638	& iim,jjm, hist_hori_id, 1,1,1, -99, 32, 'once(scatter(X))', dt, hist_dt)
5639
5640	!---------------------------------
5641	END SUBROUTINE stom_IPCC_define_history
5642	END MODULE intersurf

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

Download in other formats: