Context Navigation

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

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

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

Download in other formats: