Context Navigation

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

Last change on this file since 277 was 277, checked in by didier.solyga, 13 years ago
Update the externalized version with the last commit of the trunk (revision 275)
File size: 276.4 KB

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

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

Download in other formats: