Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_sechiba/intersurf.f90

Last change on this file was 846, checked in by didier.solyga, 12 years ago
Formatted labels so a script can automatically generate the orchidee.default file.
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 281.5 KB

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

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

Download in other formats: