Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

teststomate.f90 @ 855

Last change on this file since 855 was 704, checked in by fabienne.maignan, 12 years ago
Editing done
File size: 44.2 KB

Line
1	! =================================================================================================================================
2	! PROGRAM : teststomate
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006). This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
7	!
8	!>\BRIEF This program runs the STOMATE submodel using specific initial conditions
9	!! and driving variables in order to obtain the state variables of STOMATE closed to the steady-state values
10	!! quicker than when using the 'full' ORCHIDEE.
11	!!
12	!! \n DESCRIPTION (functional, design, flags):
13	!! It integrates STOMATE for a given number of years using a specific forcing file.
14	!! The initial GPP from this forcing is scaled in agreement with the updated calculated LAI in STOMATE
15	!! Nothing is done for soil moisture which should actually evolve with the vegetation.
16	!! - 1. It first reads a set of parameters, allocates variables and initializes them.
17	!! - 2. Then, a section on the set up of the STOMATE history file
18	!! - 3. A first call to slowproc subroutine in order to initialize SECHIBA variables
19	!! - 4. A loop over time in which slowproc is called at each time step
20	!! - 5. A restart file is written
21	!!
22	!! RECENT CHANGE(S) : None
23	!!
24	!! REFERENCE(S) : None
25	!!
26	!! SVN :
27	!! $HeadURL$
28	!! $Date$
29	!! $Revision$
30	!! \n
31	!_ ================================================================================================================================
32
33	PROGRAM teststomate
34
35	! modules used;
36
37	USE netcdf
38	USE defprec
39	USE constantes
40	USE constantes_soil
41	USE constantes_veg
42	USE constantes_co2
43	USE stomate_constants
44	USE ioipsl
45	USE grid
46	USE slowproc
47	USE stomate
48	USE intersurf, ONLY: stom_define_history, stom_ipcc_define_history, intsurf_time, l_first_intersurf, check_time
49	USE parallel
50
51	IMPLICIT NONE
52
53	!! 0. Variable and parameter declaration
54
55	INTEGER(i_std) :: kjpij,kjpindex !! # of total/land points
56	REAL(r_std) :: dtradia,dt_force !! time step of sechiba and stomate components
57	!! read into the forcing file [second]
58
59	INTEGER(i_std),DIMENSION(:),ALLOCATABLE :: indices !! index over land points
60	INTEGER(i_std),DIMENSION(:),ALLOCATABLE :: indexveg
61	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: soiltype, veget_x !! texture and fraction of vegetation type
62	!! (accounts for LAI dynamic)
63	REAL(r_std),DIMENSION(:),ALLOCATABLE :: totfrac_nobio !! Total fraction of ice+lakes+cities etc. in
64	!! the mesh
65	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: frac_nobio !! Fraction of ice, lakes, cities etc. in the
66	!! mesh
67	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: veget_max_x !! Fraction of vegetation type
68	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: lai_x !! Leaf Area Index as calculated in STOMATE
69	!! [m2/m2]
70	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: veget_force_x !! Fraction of vegetation of PFTs in each grid
71	!! cell (read in the forcinng file) [-]
72	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: veget_max_force_x !! fraction of maximum vegetation of PFTs in
73	!! each grid cell (read in the forcinng file)
74	!! [-]
75	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: lai_force_x !! Leaf Area Index as read in the forcing file
76	!! [m2/m2]
77	REAL(r_std),DIMENSION(:),ALLOCATABLE :: t2m,t2m_min,temp_sol !! 2 m air temperature, min. 2 m air temp.
78	!! during forcing time step and Surface
79	!! temperature [K]
80	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: soiltemp,soilhum !! Soil temperature and Relative soil moisture
81	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: humrel_x
82	REAL(r_std),DIMENSION(:),ALLOCATABLE :: litterhum !! Litter humidity
83	REAL(r_std),DIMENSION(:),ALLOCATABLE :: precip_rain,precip_snow !! Rainfall, Snowfall
84	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: gpp_x !! GPP (gC/(m**2 of total ground)/time step)
85	REAL(r_std),DIMENSION(:),ALLOCATABLE :: deadleaf_cover !! fraction of soil covered by dead leaves
86	REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE :: assim_param_x !! min/max/opt temperature for photosynthesis
87	!! and vcmax/vjmax parameters
88	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: height_x !! height (m)
89	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: qsintmax_x !! Maximum water on vegetation for interception
90	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: co2_flux !! CO2 flux in gC/m**2 of ground/second
91	REAL(r_std),DIMENSION(:),ALLOCATABLE :: fco2_lu !! Land Cover Change CO2 flux (gC/m**2 of
92	!! average ground/s)
93
94	INTEGER(i_std),DIMENSION(:),ALLOCATABLE :: indices_g !! Vector of indeces of land points
95	REAL(r_std),DIMENSION(:),ALLOCATABLE :: x_indices_g !! Vector of indeces of land points
96	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: x_neighbours_g !! Indeces of neighbours for each land point
97
98	INTEGER :: ier,iret !! Return value of functions used to catch
99	!! errors
100	INTEGER :: ncfid !! Id of the restart file of SECHIBA used in
101	!! input
102	CHARACTER(LEN=20),SAVE :: thecalendar='noleap' !! Type of calendar used
103
104	LOGICAL :: a_er !! Flag used to check errors when allocating
105	CHARACTER(LEN=80) :: & !! Name of the restart files used for
106	& dri_restname_in,dri_restname_out, & !! the driver in/out
107	& sec_restname_in,sec_restname_out, & !! the sechiba component in/out
108	& sto_restname_in,sto_restname_out, & !! the stomate component in/out
109	& stom_histname, stom_ipcc_histname !! Name of the history files for stomate
110	!! (standard and ippc format)
111	INTEGER(i_std) :: iim,jjm,llm !! # of lon,lat and time-step in the restart
112	!! files
113	REAL, ALLOCATABLE, DIMENSION(:,:) :: lon, lat !! Arrays of Longitude and latitude (iim,jjm)
114	!! dimension for each processor
115	REAL, ALLOCATABLE, DIMENSION(:) :: lev !! height level (required by the restini
116	!! interface)
117	LOGICAL :: rectilinear !! Is the grid rectilinear
118	REAL, ALLOCATABLE, DIMENSION(:) :: lon_rect, lat_rect !! Vectors of Longitude and latitude (iim or
119	!! jjm) dimension used in case of a
120	!! rectilinear grid
121	REAL(r_std) :: dt !! Time step of sechiba component read in the
122	!! restart file [seconds]
123	INTEGER(i_std) :: itau_dep,itau_fin,itau !! First, last and current time step of SECHIBA
124	!! component
125	INTEGER(i_std) :: itau_len,itau_step !! Total length of the simulation and length
126	!! between 2 calls of slowproc (expreseed in
127	!! time steps of SECHIBA component)
128	REAL(r_std) :: date0 !! Initial date
129	INTEGER(i_std) :: rest_id_sec,rest_id_sto !! ID's of the restart files for the SECHIBA
130	!! and STOMATE components
131	INTEGER(i_std) :: hist_id_sec,hist_id_sec2 !! ID's of the history files of SECHIBA
132	!! component (required by the interface of
133	!! slowproc but not used)
134	INTEGER(i_std) :: hist_id_stom,hist_id_stom_IPCC !! ID's of the history files of STOMATE
135	!! component
136	CHARACTER(LEN=30) :: time_str !! String used for reading the length of
137	!! simulation in the .def file
138	REAL(r_std) :: dt_slow_ !!
139	REAL :: hist_days_stom,hist_days_stom_ipcc !! Time frequency at which variables are
140	!! written in the history file for the STOMATE
141	!! component (standard and ipcc format) [day]
142	REAL :: hist_dt_stom,hist_dt_stom_ipcc !! Time frequency at which variables are
143	!! written in the history file for the STOMATE
144	!! component (standard and ipcc format)
145	!! [second]
146	REAL,DIMENSION(nvm) :: hist_PFTaxis !! Vector with PFT indeces used as axis in the
147	!! history file
148	REAL(r_std),DIMENSION(10) :: hist_pool_10axis !! Vector with 10-year indeces used as axis in
149	!! the history file (for land-use change)
150	REAL(r_std),DIMENSION(100) :: hist_pool_100axis !! Vector with 100-year indeces used as axis in
151	!! the history file (for land-use change)
152	REAL(r_std),DIMENSION(11) :: hist_pool_11axis !! Vector with 11-year indeces used as axis in
153	!! the history file (for land-use change)
154	REAL(r_std),DIMENSION(101) :: hist_pool_101axis !! Vector with 101-year indeces used as axis in
155	!! the history file (for land-use change)
156	INTEGER :: hist_PFTaxis_id,hist_IPCC_PFTaxis_id !! Id of the axis for PFT in the standard/IPCC
157	!! format
158	INTEGER :: hori_id
159	INTEGER :: hist_pool_10axis_id !! Id of the axis for 10-year vector
160	INTEGER :: hist_pool_100axis_id !! Id of the axis for the 100-year vector
161	INTEGER :: hist_pool_11axis_id !! Id of the axis for the 11-year vector
162	INTEGER :: hist_pool_101axis_id !! Id of the axis for the 101-year vector
163	INTEGER(i_std) :: i,j,iv !! used as counters
164	LOGICAL :: ldrestart_read,ldrestart_write !! Flags to activate reading/writing of the
165	!! restart file
166	LOGICAL :: l1d !! Are vector elements 1-dimension size ?
167	INTEGER(i_std),PARAMETER :: nbvarmax=200 !! Maximum number of variables assumed in the
168	!! restart file of SECHIBA component used as
169	!! input
170	INTEGER(i_std) :: nbvar !! Number of variables present in the restart
171	!! file of SECHIBA component used as input
172	CHARACTER*50,DIMENSION(nbvarmax) :: varnames !! Name of the variables present in the restart
173	!! file of SECHIBA component used as input
174	INTEGER(i_std) :: varnbdim !! Number of dimensions of a variable
175	!! varnames(i)
176	INTEGER(i_std),PARAMETER :: varnbdim_max=20 !! Maximum number of dimensions of a variable
177	!! varnames(i)
178	INTEGER,DIMENSION(varnbdim_max) :: vardims
179	CHARACTER*200 :: taboo_vars
180	REAL(r_std),DIMENSION(1) :: xtmp
181	INTEGER :: nsfm,nsft
182	INTEGER :: iisf,iiisf
183	INTEGER(i_std) :: max_totsize,totsize_1step
184	INTEGER(i_std) :: totsize_tmp
185
186	INTEGER :: vid
187	CHARACTER(LEN=100) :: forcing_name
188	REAL :: x
189
190	REAL(r_std),DIMENSION(:,:),ALLOCATABLE :: var_3d
191	REAL(r_std) :: var_1d(1)
192
193	!-
194	REAL(r_std) :: time_sec,time_step_sec
195	REAL(r_std) :: time_dri,time_step_dri
196	REAL(r_std),DIMENSION(1) :: r1d
197	REAL(r_std) :: julian,djulian
198
199	INTEGER(i_std) :: ji,jv,l
200
201	LOGICAL :: debug
202
203	!---------------------------------------------------------------------
204
205	!-
206	! 1. Reading parameters, Allocating variables and Initializations
207	!-
208
209	CALL init_para(.FALSE.)
210	CALL init_timer
211
212	IF (is_root_prc) THEN
213	!-
214	! open STOMATE's forcing file to read some basic info
215	!-
216	forcing_name = 'stomate_forcing.nc'
217	CALL getin ('STOMATE_FORCING_NAME',forcing_name)
218	iret = NF90_OPEN (TRIM(forcing_name),NF90_NOWRITE,forcing_id)
219	IF (iret /= NF90_NOERR) THEN
220	CALL ipslerr (3,'teststomate', &
221	& 'Could not open file : ', &
222	& forcing_name,'(Do you have forget it ?)')
223	ENDIF
224	ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dtradia',dtradia)
225	ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'dt_slow',dt_force)
226	ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'nsft',x)
227	nsft = NINT(x)
228	ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpij',x)
229	kjpij = NINT(x)
230	ier = NF90_GET_ATT (forcing_id,NF90_GLOBAL,'kjpindex',x)
231	nbp_glo = NINT(x)
232	ENDIF
233
234	CALL bcast(dtradia)
235	CALL bcast(dt_force)
236	CALL bcast(nsft)
237	CALL bcast(nbp_glo)
238	!-
239	write(numout,*) 'ATTENTION',dtradia,dt_force
240	!-
241	! read info about land points
242	!-
243	IF (is_root_prc) THEN
244	a_er=.FALSE.
245	ALLOCATE (indices_g(nbp_glo),stat=ier)
246	a_er = a_er .OR. (ier.NE.0)
247	IF (a_er) THEN
248	CALL ipslerr (3,'teststomate', &
249	& 'PROBLEM WITH ALLOCATION', &
250	& 'for local variables 1','')
251	ENDIF
252	!
253	ALLOCATE (x_indices_g(nbp_glo),stat=ier)
254	a_er = a_er .OR. (ier.NE.0)
255	IF (a_er) THEN
256	CALL ipslerr (3,'teststomate', &
257	& 'PROBLEM WITH ALLOCATION', &
258	& 'for global variables 1','')
259	ENDIF
260	ier = NF90_INQ_VARID (forcing_id,'index',vid)
261	IF (ier .NE. 0) THEN
262	CALL ipslerr (3,'teststomate', &
263	& 'PROBLEM WITH ALLOCATION', &
264	& 'for global variables 1','')
265	ENDIF
266	ier = NF90_GET_VAR (forcing_id,vid,x_indices_g)
267	IF (iret /= NF90_NOERR) THEN
268	CALL ipslerr (3,'teststomate', &
269	& 'PROBLEM WITH variable "index" in file ', &
270	& forcing_name,'(check this file)')
271	ENDIF
272	indices_g(:) = NINT(x_indices_g(:))
273	DEALLOCATE (x_indices_g)
274	ELSE
275	ALLOCATE (indices_g(0))
276	ENDIF
277	!---------------------------------------------------------------------
278	!-
279	! set debug to have more information
280	!-
281	!Config Key = DEBUG_INFO
282	!Config Desc = Flag for debug information
283	!Config Def = n
284	!Config Help = This option allows to switch on the output of debug
285	!Config information without recompiling the code.
286	!-
287	debug = .FALSE.
288	CALL getin_p('DEBUG_INFO',debug)
289	!
290	!Config Key = LONGPRINT
291	!Config Desc = ORCHIDEE will print more messages
292	!Config Def = n
293	!Config Help = This flag permits to print more debug messages in the run.
294	!
295	long_print = .FALSE.
296	CALL getin_p('LONGPRINT',long_print)
297	!-
298	! activate CO2, STOMATE, but not sechiba
299	!-
300	control%river_routing = .FALSE.
301	control%hydrol_cwrr = .FALSE.
302	control%ok_sechiba = .FALSE.
303	!
304	control%stomate_watchout = .TRUE.
305	control%ok_co2 = .TRUE.
306	control%ok_stomate = .TRUE.
307	!-
308	! is DGVM activated?
309	!-
310	control%ok_dgvm = .FALSE.
311	CALL getin_p('STOMATE_OK_DGVM',control%ok_dgvm)
312	WRITE(numout,*) 'LPJ is activated: ',control%ok_dgvm
313
314	!-
315	! restart files
316	!-
317	IF (is_root_prc) THEN
318	! Sechiba's restart files
319	sec_restname_in = 'sechiba_start.nc'
320	CALL getin('SECHIBA_restart_in',sec_restname_in)
321	WRITE(numout,*) 'SECHIBA INPUT RESTART_FILE: ',TRIM(sec_restname_in)
322	IF ( TRIM(sec_restname_in) .EQ. 'NONE' ) THEN
323	STOP 'Need a restart file for Sechiba'
324	ENDIF
325	sec_restname_out = 'sechiba_rest_out.nc'
326	CALL getin('SECHIBA_rest_out',sec_restname_out)
327	WRITE(numout,*) 'SECHIBA OUTPUT RESTART_FILE: ',TRIM(sec_restname_out)
328	! Stomate's restart files
329	sto_restname_in = 'stomate_start.nc'
330	CALL getin('STOMATE_RESTART_FILEIN',sto_restname_in)
331	WRITE(numout,*) 'STOMATE INPUT RESTART_FILE: ',TRIM(sto_restname_in)
332	sto_restname_out = 'stomate_rest_out.nc'
333	CALL getin('STOMATE_RESTART_FILEOUT',sto_restname_out)
334	WRITE(numout,*) 'STOMATE OUTPUT RESTART_FILE: ',TRIM(sto_restname_out)
335
336	!-
337	! We need to know iim, jjm.
338	! Get them from the restart files themselves.
339	!-
340	iret = NF90_OPEN (sec_restname_in,NF90_NOWRITE,ncfid)
341	IF (iret /= NF90_NOERR) THEN
342	CALL ipslerr (3,'teststomate', &
343	& 'Could not open file : ', &
344	& sec_restname_in,'(Do you have forget it ?)')
345	ENDIF
346	iret = NF90_INQUIRE_DIMENSION (ncfid,1,len=iim_g)
347	iret = NF90_INQUIRE_DIMENSION (ncfid,2,len=jjm_g)
348	iret = NF90_INQ_VARID (ncfid, "time", iv)
349	iret = NF90_GET_ATT (ncfid, iv, 'calendar',thecalendar)
350	iret = NF90_CLOSE (ncfid)
351	i=INDEX(thecalendar,ACHAR(0))
352	IF ( i > 0 ) THEN
353	thecalendar(i:20)=' '
354	ENDIF
355	ENDIF
356	CALL bcast(iim_g)
357	CALL bcast(jjm_g)
358	CALL bcast(thecalendar)
359	!-
360	! calendar
361	!-
362	CALL ioconf_calendar (thecalendar)
363	CALL ioget_calendar (one_year,one_day)
364	!
365	! Parallelization :
366	!
367	CALL init_data_para(iim_g,jjm_g,nbp_glo,indices_g)
368	kjpindex=nbp_loc
369	jjm=jj_nb
370	iim=iim_g
371	kjpij=iim*jjm
372	IF (debug) WRITE(numout,*) "Local grid : ",kjpindex,iim,jjm
373	!-
374	!-
375	! read info about grids
376	!-
377	!-
378	llm=1
379	ALLOCATE(lev(llm))
380	IF (is_root_prc) THEN
381	!-
382	ier = NF90_INQ_VARID (forcing_id,'lalo',vid)
383	ier = NF90_GET_VAR (forcing_id,vid,lalo_g)
384	!-
385	ALLOCATE (x_neighbours_g(nbp_glo,8),stat=ier)
386	ier = NF90_INQ_VARID (forcing_id,'neighbours',vid)
387	ier = NF90_GET_VAR (forcing_id,vid,x_neighbours_g)
388	neighbours_g(:,:) = NINT(x_neighbours_g(:,:))
389	DEALLOCATE (x_neighbours_g)
390	!-
391	ier = NF90_INQ_VARID (forcing_id,'resolution',vid)
392	ier = NF90_GET_VAR (forcing_id,vid,resolution_g)
393	!-
394	ier = NF90_INQ_VARID (forcing_id,'contfrac',vid)
395	ier = NF90_GET_VAR (forcing_id,vid,contfrac_g)
396
397	lon_g(:,:) = 0.0
398	lat_g(:,:) = 0.0
399	lev(1) = 0.0
400	!-
401	CALL restini &
402	& (sec_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
403	& sec_restname_out, itau_dep, date0, dt, rest_id_sec)
404	!-
405	IF ( dt .NE. dtradia ) THEN
406	WRITE(numout,*) 'dt',dt
407	WRITE(numout,*) 'dtradia',dtradia
408	CALL ipslerr (3,'teststomate', &
409	& 'PROBLEM with time steps.', &
410	& sec_restname_in,'(dt .NE. dtradia)')
411	ENDIF
412	!-
413	CALL restini &
414	& (sto_restname_in, iim_g, jjm_g, lon_g, lat_g, llm, lev, &
415	& sto_restname_out, itau_dep, date0, dt, rest_id_sto)
416	!-
417	IF ( dt .NE. dtradia ) THEN
418	WRITE(numout,*) 'dt',dt
419	WRITE(numout,*) 'dtradia',dtradia
420	CALL ipslerr (3,'teststomate', &
421	& 'PROBLEM with time steps.', &
422	& sto_restname_in,'(dt .NE. dtradia)')
423	ENDIF
424	ENDIF
425	CALL bcast(rest_id_sec)
426	CALL bcast(rest_id_sto)
427	CALL bcast(itau_dep)
428	CALL bcast(date0)
429	CALL bcast(dt)
430	CALL bcast(lev)
431	!---
432	!--- Create the index table
433	!---
434	!--- This job return a LOCAL kindex
435	!---
436	ALLOCATE (indices(kjpindex),stat=ier)
437	IF (debug .AND. is_root_prc) WRITE(numout,*) "indices_g = ",indices_g(1:nbp_glo)
438	CALL scatter(indices_g,indices)
439	indices(1:kjpindex)=indices(1:kjpindex)-(jj_begin-1)*iim_g
440	IF (debug) WRITE(numout,*) "indices = ",indices(1:kjpindex)
441
442	!---
443	!--- initialize global grid
444	!---
445	CALL init_grid( kjpindex )
446	CALL grid_stuff (nbp_glo, iim_g, jjm_g, lon_g, lat_g, indices_g)
447
448	!---
449	!--- initialize local grid
450	!---
451	jlandindex = (((indices(1:kjpindex)-1)/iim) + 1)
452	if (debug) WRITE(numout,*) "jlandindex = ",jlandindex(1:kjpindex)
453	ilandindex = (indices(1:kjpindex) - (jlandindex(1:kjpindex)-1)*iim)
454	IF (debug) WRITE(numout,*) "ilandindex = ",ilandindex(1:kjpindex)
455	ALLOCATE(lon(iim,jjm))
456	ALLOCATE(lat(iim,jjm))
457	lon=zero
458	lat=zero
459	CALL scatter2D(lon_g,lon)
460	CALL scatter2D(lat_g,lat)
461
462	DO ji=1,kjpindex
463
464	j = jlandindex(ji)
465	i = ilandindex(ji)
466
467	!- Create the internal coordinate table
468	!-
469	lalo(ji,1) = lat(i,j)
470	lalo(ji,2) = lon(i,j)
471	ENDDO
472	CALL scatter(neighbours_g,neighbours)
473	CALL scatter(resolution_g,resolution)
474	CALL scatter(contfrac_g,contfrac)
475	CALL scatter(area_g,area)
476	!-
477	!- Check if we have by any chance a rectilinear grid. This would allow us to
478	!- simplify the output files.
479	!
480	rectilinear = .FALSE.
481	IF (is_root_prc) THEN
482	IF ( ALL(lon_g(:,:) == SPREAD(lon_g(:,1), 2, SIZE(lon_g,2))) .AND. &
483	& ALL(lat_g(:,:) == SPREAD(lat_g(1,:), 1, SIZE(lat_g,1))) ) THEN
484	rectilinear = .TRUE.
485	ENDIF
486	ENDIF
487	CALL bcast(rectilinear)
488	IF (rectilinear) THEN
489	ALLOCATE(lon_rect(iim),stat=ier)
490	IF (ier .NE. 0) THEN
491	WRITE (numout,*) ' error in lon_rect allocation. We stop. We need iim words = ',iim
492	STOP 'intersurf_history'
493	ENDIF
494	ALLOCATE(lat_rect(jjm),stat=ier)
495	IF (ier .NE. 0) THEN
496	WRITE (numout,*) ' error in lat_rect allocation. We stop. We need jjm words = ',jjm
497	STOP 'intersurf_history'
498	ENDIF
499	lon_rect(:) = lon(:,1)
500	lat_rect(:) = lat(1,:)
501	ENDIF
502	!-
503	! allocate arrays
504	!-
505	!
506	a_er = .FALSE.
507	ALLOCATE (indexveg(kjpindex*nvm), stat=ier)
508	a_er = a_er .OR. (ier.NE.0)
509	ALLOCATE (soiltype(kjpindex,nstm),stat=ier)
510	a_er = a_er .OR. (ier.NE.0)
511	ALLOCATE (veget_x(kjpindex,nvm),stat=ier)
512	a_er = a_er .OR. (ier.NE.0)
513	ALLOCATE (totfrac_nobio(kjpindex),stat=ier)
514	a_er = a_er .OR. (ier.NE.0)
515	ALLOCATE (frac_nobio(kjpindex,nnobio),stat=ier)
516	a_er = a_er .OR. (ier.NE.0)
517	ALLOCATE (veget_max_x(kjpindex,nvm),stat=ier)
518	a_er = a_er .OR. (ier.NE.0)
519	ALLOCATE (lai_x(kjpindex,nvm),stat=ier)
520	a_er = a_er .OR. (ier.NE.0)
521	ALLOCATE (veget_force_x(kjpindex,nvm),stat=ier)
522	a_er = a_er .OR. (ier.NE.0)
523	ALLOCATE (veget_max_force_x(kjpindex,nvm),stat=ier)
524	a_er = a_er .OR. (ier.NE.0)
525	ALLOCATE (lai_force_x(kjpindex,nvm),stat=ier)
526	a_er = a_er .OR. (ier.NE.0)
527	ALLOCATE (t2m(kjpindex),stat=ier)
528	a_er = a_er .OR. (ier.NE.0)
529	ALLOCATE (t2m_min(kjpindex),stat=ier)
530	a_er = a_er .OR. (ier.NE.0)
531	ALLOCATE (temp_sol(kjpindex),stat=ier)
532	a_er = a_er .OR. (ier.NE.0)
533	ALLOCATE (soiltemp(kjpindex,nbdl),stat=ier)
534	a_er = a_er .OR. (ier.NE.0)
535	ALLOCATE (soilhum(kjpindex,nbdl),stat=ier)
536	a_er = a_er .OR. (ier.NE.0)
537	ALLOCATE (humrel_x(kjpindex,nvm),stat=ier)
538	a_er = a_er .OR. (ier.NE.0)
539	ALLOCATE (litterhum(kjpindex),stat=ier)
540	a_er = a_er .OR. (ier.NE.0)
541	ALLOCATE (precip_rain(kjpindex),stat=ier)
542	a_er = a_er .OR. (ier.NE.0)
543	ALLOCATE (precip_snow(kjpindex),stat=ier)
544	a_er = a_er .OR. (ier.NE.0)
545	ALLOCATE (gpp_x(kjpindex,nvm),stat=ier)
546	a_er = a_er .OR. (ier.NE.0)
547	ALLOCATE (deadleaf_cover(kjpindex),stat=ier)
548	a_er = a_er .OR. (ier.NE.0)
549	ALLOCATE (assim_param_x(kjpindex,nvm,npco2),stat=ier)
550	a_er = a_er .OR. (ier.NE.0)
551	ALLOCATE (height_x(kjpindex,nvm),stat=ier)
552	a_er = a_er .OR. (ier.NE.0)
553	ALLOCATE (qsintmax_x(kjpindex,nvm),stat=ier)
554	a_er = a_er .OR. (ier.NE.0)
555	ALLOCATE (co2_flux(kjpindex,nvm),stat=ier)
556	a_er = a_er .OR. (ier.NE.0)
557	ALLOCATE (fco2_lu(kjpindex),stat=ier)
558	a_er = a_er .OR. (ier.NE.0)
559	IF (a_er) THEN
560	CALL ipslerr (3,'teststomate', &
561	& 'PROBLEM WITH ALLOCATION', &
562	& 'for local variables 1','')
563	ENDIF
564	!
565	! prepare forcing
566	! forcing file of STOMATE is read by block
567	! in order to minimize the reading frequency
568	! Here is done the calculation of the number
569	! of time steps we load in memory
570	!
571	max_totsize = 50
572	CALL getin_p ('STOMATE_FORCING_MEMSIZE',max_totsize)
573	max_totsize = max_totsize * 1000000
574
575	totsize_1step = SIZE(soiltype(:,3))*KIND(soiltype(:,3)) + &
576	SIZE(humrel_x)*KIND(humrel_x) + &
577	SIZE(litterhum)*KIND(litterhum) + &
578	SIZE(t2m)*KIND(t2m) + &
579	SIZE(t2m_min)*KIND(t2m_min) + &
580	SIZE(temp_sol)*KIND(temp_sol) + &
581	SIZE(soiltemp)*KIND(soiltemp) + &
582	SIZE(soilhum)*KIND(soilhum) + &
583	SIZE(precip_rain)*KIND(precip_rain) + &
584	SIZE(precip_snow)*KIND(precip_snow) + &
585	SIZE(gpp_x)*KIND(gpp_x) + &
586	SIZE(veget_force_x)*KIND(veget_force_x) + &
587	SIZE(veget_max_force_x)*KIND(veget_max_force_x) + &
588	SIZE(lai_force_x)*KIND(lai_force_x)
589	CALL reduce_sum(totsize_1step,totsize_tmp)
590	CALL bcast(totsize_tmp)
591	totsize_1step=totsize_tmp
592
593	! check for consistency of the total number of forcing steps
594	IF ( nsft .NE. INT(one_year/(dt_force/one_day)) ) THEN
595	CALL ipslerr (3,'teststomate', &
596	& 'stomate: error with total number of forcing steps', &
597	& 'nsft','teststomate computation different with forcing file value.')
598	ENDIF
599	! number of forcing steps in memory
600	nsfm = MIN(nsft, &
601	& MAX(1,NINT( REAL(max_totsize,r_std) &
602	& /REAL(totsize_1step,r_std))))
603	!-
604	WRITE(numout,*) 'Offline forcing of Stomate:'
605	WRITE(numout,*) ' Total number of forcing steps:',nsft
606	WRITE(numout,*) ' Number of forcing steps in memory:',nsfm
607	!-
608	! init_forcing defined into stomate.f90
609	! allocate and set to zero driving variables of STOMATE
610	! ie variables that are read in the forcing file
611	!-
612	CALL init_forcing(kjpindex,nsfm,nsft)
613	!-
614	! ensure that we read all new forcing states
615	iisf = nsfm
616	! initialize the table that contains the indices
617	! of the forcing states that will be in memory
618	isf(:) = (/ (i,i=1,nsfm) /)
619
620	nf_written(:) = .FALSE.
621	nf_written(isf(:)) = .TRUE.
622
623	!-
624	! a time step for STOMATE corresponds to itau_step timesteps in SECHIBA
625	!-
626	itau_step = NINT(dt_force/dtradia)
627	IF (debug) WRITE(numout,*) "dtradia, dt_rest, dt_force, itau_step",dtradia, dt, dt_force, itau_step
628	!
629	CALL ioconf_startdate(date0)
630	CALL intsurf_time( itau_dep, date0, dtradia )
631	!-
632	! Length of integration
633	!-
634	WRITE(time_str,'(a)') '1Y'
635	CALL getin_p ('TIME_LENGTH', time_str)
636	! transform into itau
637	CALL tlen2itau(time_str, dt, date0, itau_len)
638	! itau_len*dtradia must be a multiple of dt_force
639	itau_len = NINT( MAX(1.,FLOAT(NINT(itau_len*dtradia/dt_force))) &
640	& *dt_force/dtradia)
641	!-
642	itau_fin = itau_dep+itau_len
643	!-
644	! 2. set up STOMATE history file
645	!-
646	!Config Key = STOMATE_OUTPUT_FILE
647	!Config Desc = Name of file in which STOMATE's output is going
648	!Config to be written
649	!Config Def = stomate_history.nc
650	!Config Help = This file is going to be created by the model
651	!Config and will contain the output from the model.
652	!Config This file is a truly COADS compliant netCDF file.
653	!Config It will be generated by the hist software from
654	!Config the IOIPSL package.
655	!-
656	stom_histname='stomate_history.nc'
657	CALL getin_p ('STOMATE_OUTPUT_FILE', stom_histname)
658	WRITE(numout,*) 'STOMATE_OUTPUT_FILE', TRIM(stom_histname)
659	!-
660	!Config Key = STOMATE_HIST_DT
661	!Config Desc = STOMATE history time step (d)
662	!Config Def = 10.
663	!Config Help = Time step of the STOMATE history file
664	!-
665	hist_days_stom = 10.
666	CALL getin_p ('STOMATE_HIST_DT', hist_days_stom)
667	IF ( hist_days_stom == -1. ) THEN
668	hist_dt_stom = -1.
669	WRITE(numout,*) 'output frequency for STOMATE history file (d): one month.'
670	ELSE
671	hist_dt_stom = NINT( hist_days_stom ) * one_day
672	WRITE(numout,*) 'output frequency for STOMATE history file (d): ', &
673	hist_dt_stom/one_day
674	ENDIF
675	!-
676	!- initialize
677	WRITE(numout,*) "before histbeg : ",date0,dt
678	IF ( rectilinear ) THEN
679	#ifdef CPP_PARA
680	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
681	& itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
682	#else
683	CALL histbeg(stom_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
684	& itau_dep, date0, dt, hori_id, hist_id_stom)
685	#endif
686	ELSE
687	#ifdef CPP_PARA
688	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
689	& itau_dep, date0, dt, hori_id, hist_id_stom, domain_id=orch_domain_id)
690	#else
691	CALL histbeg(stom_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
692	& itau_dep, date0, dt, hori_id, hist_id_stom)
693	#endif
694	ENDIF
695	!- define PFT axis
696	hist_PFTaxis = (/ ( REAL(i,r_std), i=1,nvm ) /)
697	!- declare this axis
698	CALL histvert (hist_id_stom, 'PFT', 'Plant functional type', &
699	& '1', nvm, hist_PFTaxis, hist_PFTaxis_id)
700	!- define Pool_10 axis
701	hist_pool_10axis = (/ ( REAL(i,r_std), i=1,10 ) /)
702	!- declare this axis
703	CALL histvert (hist_id_stom, 'P10', 'Pool 10 years', &
704	& '1', 10, hist_pool_10axis, hist_pool_10axis_id)
705
706	!- define Pool_100 axis
707	hist_pool_100axis = (/ ( REAL(i,r_std), i=1,100 ) /)
708	!- declare this axis
709	CALL histvert (hist_id_stom, 'P100', 'Pool 100 years', &
710	& '1', 100, hist_pool_100axis, hist_pool_100axis_id)
711
712	!- define Pool_11 axis
713	hist_pool_11axis = (/ ( REAL(i,r_std), i=1,11 ) /)
714	!- declare this axis
715	CALL histvert (hist_id_stom, 'P11', 'Pool 10 years + 1', &
716	& '1', 11, hist_pool_11axis, hist_pool_11axis_id)
717	!- define Pool_101 axis
718	hist_pool_101axis = (/ ( REAL(i,r_std), i=1,101 ) /)
719	!- declare this axis
720	CALL histvert (hist_id_stom, 'P101', 'Pool 100 years + 1', &
721	& '1', 101, hist_pool_101axis, hist_pool_101axis_id)
722
723	!- define STOMATE history file
724	CALL stom_define_history (hist_id_stom, nvm, iim, jjm, &
725	& dt, hist_dt_stom, hori_id, hist_PFTaxis_id, &
726	& hist_pool_10axis_id, hist_pool_100axis_id, &
727	& hist_pool_11axis_id, hist_pool_101axis_id)
728
729	!- end definition
730	CALL histend(hist_id_stom)
731	!-
732	!-
733	! STOMATE IPCC OUTPUTS IS ACTIVATED
734	!-
735	!Config Key = STOMATE_IPCC_OUTPUT_FILE
736	!Config Desc = Name of file in which STOMATE's output is going
737	!Config to be written
738	!Config Def = stomate_ipcc_history.nc
739	!Config Help = This file is going to be created by the model
740	!Config and will contain the output from the model.
741	!Config This file is a truly COADS compliant netCDF file.
742	!Config It will be generated by the hist software from
743	!Config the IOIPSL package.
744	!-
745	stom_ipcc_histname='stomate_ipcc_history.nc'
746	CALL getin_p('STOMATE_IPCC_OUTPUT_FILE', stom_ipcc_histname)
747	WRITE(numout,*) 'STOMATE_IPCC_OUTPUT_FILE', TRIM(stom_ipcc_histname)
748	!-
749	!Config Key = STOMATE_IPCC_HIST_DT
750	!Config Desc = STOMATE IPCC history time step (d)
751	!Config Def = 0.
752	!Config Help = Time step of the STOMATE IPCC history file
753	!-
754	hist_days_stom_ipcc = zero
755	CALL getin_p('STOMATE_IPCC_HIST_DT', hist_days_stom_ipcc)
756	IF ( hist_days_stom_ipcc == moins_un ) THEN
757	hist_dt_stom_ipcc = moins_un
758	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): one month.'
759	ELSE
760	hist_dt_stom_ipcc = NINT( hist_days_stom_ipcc ) * one_day
761	WRITE(numout,*) 'output frequency for STOMATE IPCC history file (d): ', &
762	hist_dt_stom_ipcc/one_day
763	ENDIF
764
765	! test consistency between STOMATE_IPCC_HIST_DT and DT_SLOW parameters
766	dt_slow_ = one_day
767	CALL getin_p('DT_SLOW', dt_slow_)
768	IF ( hist_days_stom_ipcc > zero ) THEN
769	IF (dt_slow_ > hist_dt_stom_ipcc) THEN
770	WRITE(numout,*) "DT_SLOW = ",dt_slow_," , STOMATE_IPCC_HIST_DT = ",hist_dt_stom_ipcc
771	CALL ipslerr (3,'intsurf_history', &
772	& 'Problem with DT_SLOW > STOMATE_IPCC_HIST_DT','', &
773	& '(must be less or equal)')
774	ENDIF
775	ENDIF
776
777	IF ( hist_dt_stom_ipcc == 0 ) THEN
778	hist_id_stom_ipcc = -1
779	ELSE
780	!-
781	!- initialize
782	IF ( rectilinear ) THEN
783	#ifdef CPP_PARA
784	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
785	& itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
786	#else
787	CALL histbeg(stom_ipcc_histname, iim, lon_rect, jjm, lat_rect, 1, iim, 1, jjm, &
788	& itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
789	#endif
790	ELSE
791	#ifdef CPP_PARA
792	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
793	& itau_dep, date0, dt, hori_id, hist_id_stom_ipcc,domain_id=orch_domain_id)
794	#else
795	CALL histbeg(stom_ipcc_histname, iim, lon, jjm, lat, 1, iim, 1, jjm, &
796	& itau_dep, date0, dt, hori_id, hist_id_stom_ipcc)
797	#endif
798	ENDIF
799	!- declare this axis
800	CALL histvert (hist_id_stom_IPCC, 'PFT', 'Plant functional type', &
801	& '1', nvm, hist_PFTaxis, hist_IPCC_PFTaxis_id)
802
803	!- define STOMATE history file
804	CALL stom_IPCC_define_history (hist_id_stom_IPCC, nvm, iim, jjm, &
805	& dt, hist_dt_stom_ipcc, hori_id, hist_IPCC_PFTaxis_id)
806
807	!- end definition
808	CALL histend(hist_id_stom_IPCC)
809
810	ENDIF
811	!
812	CALL histwrite(hist_id_stom, 'Areas', itau_dep+itau_step, area, kjpindex, indices)
813	IF ( hist_id_stom_IPCC > 0 ) THEN
814	CALL histwrite(hist_id_stom_IPCC, 'Areas', itau_dep+itau_step, area, kjpindex, indices)
815	ENDIF
816	!
817	hist_id_sec = -1
818	hist_id_sec2 = -1
819	!-
820	! 3. first call of slowproc to initialize variables
821	!-
822	itau = itau_dep
823	!
824	DO ji=1,kjpindex
825	DO jv=1,nvm
826	indexveg((jv-1)kjpindex + ji) = indices(ji) + (jv-1)kjpij
827	ENDDO
828	ENDDO
829	!-
830	!MM Problem here with dpu which depends on soil type
831	DO l = 1, nbdl-1
832	! first 2.0 is dpu
833	! second 2.0 is average
834	diaglev(l) = dpu_cste/(2*(nbdl-1) -1) ( ( 2(l-1) -1) + ( 2(l) -1) ) / 2.0
835	ENDDO
836	diaglev(nbdl) = dpu_cste
837	!
838	CALL ioget_expval(val_exp)
839	ldrestart_read = .TRUE.
840	ldrestart_write = .FALSE.
841	!-
842	! read some variables we need from SECHIBA's restart file
843	!-
844	CALL slowproc_main &
845	& (itau, kjpij, kjpindex, dt_force, date0, &
846	& ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
847	& indices, indexveg, lalo, neighbours, resolution, contfrac, soiltype, &
848	& t2m, t2m_min, temp_sol, soiltemp, &
849	& humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
850	& deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, &
851	& frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, &
852	& rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu)
853	! correct date
854
855
856	day_counter = one_day - dt_force
857	date=1
858	IF (debug) check_time=.TRUE.
859	CALL intsurf_time( itau_dep+itau_step, date0, dtradia )
860	l_first_intersurf=.FALSE.
861	!-
862	! 4. Time loop
863	!â»
864	DO itau = itau_dep+itau_step,itau_fin,itau_step
865	!
866	CALL intsurf_time( itau, date0, dtradia )
867	!-
868	! next forcing state
869	iisf = iisf+1
870	IF (debug) WRITE(numout,*) "itau,iisf : ",itau,iisf
871	!---
872	IF (iisf .GT. nsfm) THEN
873	!-
874	! we have to read new forcing states from the file
875	! determine blocks of forcing states that are contiguous in memory
876	!-
877	CALL forcing_read(forcing_id,nsfm)
878	!-
879	! determine which forcing states must be read next time
880	!-
881	isf(1) = isf(nsfm)+1
882	IF ( isf(1) .GT. nsft ) isf(1) = 1
883	DO iiisf = 2, nsfm
884	isf(iiisf) = isf(iiisf-1)+1
885	IF ( isf(iiisf) .GT. nsft ) isf(iiisf) = 1
886	ENDDO
887	nf_written(isf(:)) = .TRUE.
888	!---- start again at first forcing state
889	iisf = 1
890	ENDIF
891	! Bug here ! soiltype(:,3) != clay
892	! soiltype(:,3) = clay_fm(:,iisf)
893	humrel_x(:,:) = humrel_daily_fm(:,:,iisf)
894	litterhum(:) = litterhum_daily_fm(:,iisf)
895	t2m(:) = t2m_daily_fm(:,iisf)
896	t2m_min(:) = t2m_min_daily_fm(:,iisf)
897	temp_sol(:) = tsurf_daily_fm(:,iisf)
898	soiltemp(:,:) = tsoil_daily_fm(:,:,iisf)
899	soilhum(:,:) = soilhum_daily_fm(:,:,iisf)
900	precip_rain(:) = precip_fm(:,iisf)
901	gpp_x(:,:) = gpp_daily_fm(:,:,iisf)
902	veget_force_x(:,:) = veget_fm(:,:,iisf)
903	veget_max_force_x(:,:) = veget_max_fm(:,:,iisf)
904	lai_force_x(:,:) = lai_fm(:,:,iisf)
905	WHERE ( t2m(:) .LT. ZeroCelsius )
906	precip_snow(:) = precip_rain(:)
907	precip_rain(:) = 0.
908	ELSEWHERE
909	precip_snow(:) = 0.
910	ENDWHERE
911	!-
912	! scale GPP to new lai and veget_max
913	!-
914	WHERE ( lai_x(:,:) .EQ. 0.0 ) gpp_x(:,:) = 0.0
915	!- scale GPP to new LAI
916	WHERE (lai_force_x(:,:) .GT. 0.0 )
917	gpp_x(:,:) = gpp_x(:,:)ATAN(2.lai_x(:,:)) &
918	& /ATAN( 2.*MAX(lai_force_x(:,:),0.01))
919	ENDWHERE
920	!- scale GPP to new veget_max
921	WHERE (veget_max_force_x(:,:) .GT. 0.0 )
922	gpp_x(:,:) = gpp_x(:,:)*veget_max_x(:,:)/veget_max_force_x(:,:)
923	ENDWHERE
924	!-
925	!- number crunching
926	!-
927	ldrestart_read = .FALSE.
928	ldrestart_write = .FALSE.
929	CALL slowproc_main &
930	& (itau, kjpij, kjpindex, dt_force, date0, &
931	& ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
932	& indices, indexveg, lalo, neighbours, resolution, contfrac, soiltype, &
933	& t2m, t2m_min, temp_sol, soiltemp, &
934	& humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
935	& deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, &
936	& frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, &
937	& rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu)
938	day_counter = one_day - dt_force
939	ENDDO ! end of the time loop
940
941
942	!-
943	! 5. write restart files
944	!-
945	IF (is_root_prc) THEN
946	! first, read and write variables that are not managed otherwise
947	taboo_vars = &
948	& '$lat$ $lon$ $lev$ $veget_year$ '// &
949	& '$height$ $day_counter$ $veget$ $veget_max$ $frac_nobio$ '// &
950	& '$lai$ $soiltype_frac$ $clay_frac$ '// &
951	& '$nav_lon$ $nav_lat$ $nav_lev$ $time$ $time_steps$'
952	!-
953	CALL ioget_vname(rest_id_sec, nbvar, varnames)
954	!-
955	DO iv = 1, nbvar
956	!-- check if the variable is to be written here
957	IF (INDEX( taboo_vars,'$'//TRIM(varnames(iv))//'$') .EQ. 0 ) THEN
958	IF (debug) WRITE(numout,*) "restart var : ",TRIM(varnames(iv)),itau_dep,itau_fin
959
960	!---- get variable dimensions, especially 3rd dimension
961	CALL ioget_vdim &
962	& (rest_id_sec, varnames(iv), varnbdim_max, varnbdim, vardims)
963	l1d = ALL(vardims(1:varnbdim) .EQ. 1)
964	!---- read it
965	IF (l1d) THEN
966	CALL restget (rest_id_sec,TRIM(varnames(iv)), &
967	1,1,1,itau_dep,.TRUE.,var_1d)
968	ELSE
969	ALLOCATE(var_3d(nbp_glo,vardims(3)),stat=ier)
970	IF (ier .NE. 0) STOP 'ALLOCATION PROBLEM'
971	CALL restget (rest_id_sec,TRIM(varnames(iv)), &
972	nbp_glo,vardims(3),1,itau_dep,.TRUE.,var_3d, &
973	"gather",nbp_glo,indices_g)
974	ENDIF
975	!---- write it
976	IF (l1d) THEN
977	CALL restput (rest_id_sec,TRIM(varnames(iv)), &
978	1,1,1,itau_fin,var_1d)
979	ELSE
980	CALL restput (rest_id_sec,TRIM(varnames(iv)), &
981	nbp_glo,vardims(3),1,itau_fin,var_3d, &
982	'scatter',nbp_glo,indices_g)
983	DEALLOCATE (var_3d)
984	ENDIF
985	ENDIF
986	ENDDO
987	ENDIF
988	CALL barrier_para()
989
990	! call slowproc to write restart files
991	ldrestart_read = .FALSE.
992	ldrestart_write = .TRUE.
993	!-
994	IF (debug) WRITE(numout,*) "Call slowproc for restart."
995	CALL slowproc_main &
996	& (itau_fin, kjpij, kjpindex, dt_force, date0, &
997	& ldrestart_read, ldrestart_write, .FALSE., .TRUE., &
998	& indices, indexveg, lalo, neighbours, resolution, contfrac, soiltype, &
999	& t2m, t2m_min, temp_sol, soiltemp, &
1000	& humrel_x, soilhum, litterhum, precip_rain, precip_snow, gpp_x, &
1001	& deadleaf_cover, assim_param_x, lai_x, height_x, veget_x, &
1002	& frac_nobio, veget_max_x, totfrac_nobio, qsintmax_x, &
1003	& rest_id_sec, hist_id_sec, hist_id_sec2, rest_id_sto, hist_id_stom, hist_id_stom_IPCC, co2_flux, fco2_lu)
1004	!-
1005	! close files
1006	!-
1007	IF (is_root_prc) THEN
1008	CALL restclo
1009	IF ( debug ) WRITE(numout,*) 'REST CLOSED'
1010	ENDIF
1011	CALL histclo
1012
1013	IF (is_root_prc) &
1014	ier = NF90_CLOSE (forcing_id)
1015
1016	IF (is_root_prc) THEN
1017	CALL getin_dump()
1018	ENDIF
1019	#ifdef CPP_PARA
1020	CALL MPI_FINALIZE(ier)
1021	#endif
1022	WRITE(numout,*) "End of teststomate."
1023
1024	!---------------
1025	END PROGRAM teststomate
1026	!
1027	!===
1028	!

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

Context Navigation

source: perso/abdelouhab.djerrah/ORCHIDEE_OL/teststomate.f90 @ 855

Download in other formats: