Context Navigation

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

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

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

Download in other formats: