Context Navigation

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

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

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

Download in other formats: