Context Navigation

source: branches/publications/ORCHIDEE_gmd-2018-57/src_oasisdriver/orchideeoasis.f90 @ 5143

Last change on this file since 5143 was 4513, checked in by jan.polcher, 7 years ago

This commit corrects an error in the output of the largest rivers together with the location of the estuaries.

Now driver2oasis also outputs variables to XIOS. I has its own context and uses the same server as ORCHIDEE. For the moment only river flow to the estuaries is written to file.

File size: 40.3 KB

Line
1	! =================================================================================================================================
2	! PROGRAM : orchideedriveroasis
3	!
4	! CONTACT : jan.polcher@lmd.jussieu.fr
5	!
6	! LICENCE : IPSL (2016)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This is the main program for the driver which gets the forcing data from OASIS. It is used as an interface
10	!! for WRF for instance. It allows to have another domain decomposition than the atmosphere. Particularly useful
11	!! for coupling to atmospheric models not decomposed by the "apple method".
12	!!
13	!!\n DESCRIPTION: This program only organises the data and calls sechiba_main after having received the data from OASIS.
14	!! The main work for the OASIS interface is done in orchoasis_tools.f90 module.
15	!! Call the various modules to get the forcing data and provide it to SECHIBA. The only complexity
16	!! is setting-up the domain decomposition and distributing the grid information.
17	!! The code is parallel from tip to toe using the domain decomposition inherited from LMDZ.
18	!!
19	!! RECENT CHANGE(S): None
20	!!
21	!! REFERENCE(S) :
22	!!
23	!! SVN :
24	!! $HeadURL: $
25	!! $Date: $
26	!! $Revision: $
27	!! \n
28	!_ ================================================================================================================================
29	PROGRAM orchideeoasis
30	!---------------------------------------------------------------------
31	!-
32	!-
33	!---------------------------------------------------------------------
34	USE defprec
35	USE netcdf
36	!
37	!
38	USE ioipsl_para
39	USE mod_orchidee_para
40	!
41	USE grid
42	USE timer
43
44	USE globgrd
45	USE orchoasis_tools
46	!
47	USE sechiba
48	USE control
49	USE ioipslctrl
50	!
51	USE thermosoilc, ONLY : thermosoilc_levels
52	USE routing_reg, ONLY : routing_reg_riverflow
53	!
54	USE mod_oasis
55	!-
56	IMPLICIT NONE
57	!-
58	INCLUDE 'mpif.h'
59	!-
60	CHARACTER(LEN=80) :: gridfilename
61	CHARACTER(LEN=8) :: model_guess
62	INTEGER(i_std) :: iim_glo, jjm_glo, file_id
63	!-
64	INTEGER(i_std) :: nbseg
65	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon_glo, lat_glo, area_glo
66	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: mask_glo
67	REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: corners_glo
68	INTEGER(i_std) :: nbindex_g, kjpindex
69	INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: kindex, kindex_g
70	!
71	! Variables for the global grid available on all procs and used
72	! to fill the ORCHIDEE variable on the root_proc
73	!
74	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo_glo
75	REAL(r_std), ALLOCATABLE, DIMENSION(:) :: contfrac_glo
76	CHARACTER(LEN=20) :: calendar
77	!-
78	!- Variables local to each processors.
79	!-
80	INTEGER(i_std) :: i, j, ik, nbdt, first_point
81	INTEGER(i_std) :: itau, itau_offset, itau_sechiba, itau_tmp
82	REAL(r_std) :: date0, date0_shifted, dt, julian, julian0
83	INTEGER(i_std) :: rest_id, rest_id_stom
84	INTEGER(i_std) :: hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC
85	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo_loc
86	INTEGER(i_std) :: iim, jjm, ier
87	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lon, lat
88	REAL(r_std),ALLOCATABLE, DIMENSION (:) :: soilth_lev !! Vertical soil axis for thermal scheme (m)
89	!-
90	!- input fields
91	!-
92	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: u !! Lowest level wind speed
93	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: v !! Lowest level wind speed
94	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: zlev_uv !! Height of first layer
95	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: zlev_tq !! Height of first layer
96	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: qair !! Lowest level specific humidity
97	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: precip_rain !! Rain precipitation
98	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: precip_snow !! Snow precipitation
99	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: lwdown !! Down-welling long-wave flux
100	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: swdown !! Downwelling surface short-wave flux
101	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: sinang !! cosine of solar zenith angle
102	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: temp_air !! Air temperature in Kelvin
103	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: epot_air !! Air potential energy
104	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: ccanopy !! CO2 concentration in the canopy
105	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: petAcoef !! Coeficients A from the PBL resolution
106	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: peqAcoef !! One for T and another for q
107	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: petBcoef !! Coeficients B from the PBL resolution
108	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: peqBcoef !! One for T and another for q
109	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: cdrag !! Cdrag
110	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: pb !! Lowest level pressure
111	!-
112	!- output fields
113	!-
114	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: z0m !! Surface roughness for momentum
115	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: z0h !! Surface roughness for heat
116	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: coastalflow !! Diffuse flow of water into the ocean (m^3/dt)
117	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: riverflow !! Largest rivers flowing into the ocean (m^3/dt)
118	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: tsol_rad !! Radiative surface temperature
119	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: vevapp !! Total of evaporation
120	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: temp_sol_new !! New soil temperature
121	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: qsurf !! Surface specific humidity
122	REAL(r_std), ALLOCATABLE, DIMENSION (:,:) :: albedo !! Albedo
123	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: fluxsens !! Sensible chaleur flux
124	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: fluxlat !! Latent chaleur flux
125	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: emis !! Emissivity
126	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: netco2 !! netco2flux
127	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: carblu !! fco2_land_use
128	!-
129	!- Declarations for OASIS
130	!-
131	CHARACTER(LEN=6) :: comp_name = 'orchid'
132	INTEGER(i_std) :: loc_size, glo_size ! number of pes used
133	INTEGER(i_std) :: loc_rank, glo_rank ! rank of current pe
134	INTEGER(i_std) :: localComm, LOCAL_OASIS_COMM ! local MPI communicator and Initialized
135	INTEGER(i_std) :: comp_id ! component identification
136	INTEGER(i_std) :: ierror, oasis_info
137	CHARACTER(LEN=3) :: chout
138	CHARACTER(LEN=30) :: diagfilename
139	!!
140	!-
141	!- Variables for rivers to be sent to the ocean model
142	!-
143	INTEGER(i_std), SAVE :: num_largest, river_nstart, river_nlen, ninc
144	REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: lonrivers, latrivers, riverflows
145	!-
146	!-
147	!-
148	REAL(r_std) :: atmco2
149	REAL(r_std), ALLOCATABLE, DIMENSION (:) :: u_tq, v_tq, swnet
150	LOGICAL :: lrestart_read = .TRUE. !! Logical for _restart_ file to read
151	LOGICAL :: lrestart_write = .FALSE. !! Logical for _restart_ file to write'
152	!
153	! Time variables
154	!
155	LOGICAL, PARAMETER :: timemeasure=.TRUE.
156	REAL(r_std) :: waitput_cputime=0.0, waitget_cputime=0.0, orchidee_cputime=0.0
157	REAL(r_std) :: waitput_walltime=0.0, waitget_walltime=0.0, orchidee_walltime=0.0
158	!
159	! Print point (Lon,Lat)
160	!
161	!! REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-25.3/)
162	!! REAL(r_std), DIMENSION(2) :: testpt=(/44.8,-18.3/)
163	!! REAL(r_std), DIMENSION(2) :: testpt=(/-60.25,-5.25/)
164	!! REAL(r_std), DIMENSION(2) :: testpt=(/46.7,10.3/)
165	!! REAL(r_std), DIMENSION(2) :: testpt=(/0.25,49.25/)
166	! Case when no ouput is desired.
167	REAL(r_std), DIMENSION(2) :: testpt=(/9999.99,9999.99/)
168	INTEGER(i_std) :: ktest
169	!
170	!-
171	!---------------------------------------------------------------------------------------
172	!-
173	!- Define MPI communicator and set-up OASIS
174	!-
175	!---------------------------------------------------------------------------------------
176	!-
177	!
178	CALL oasis_init_comp(comp_id, comp_name, ierror)
179	CALL oasis_get_localcomm (LOCAL_OASIS_COMM, ierror)
180	!
181	! Set parallel processing in ORCHIDEE
182	!
183	CALL Init_orchidee_para(LOCAL_OASIS_COMM)
184	!====================================================================================
185	!
186	! Start timer now that the paralelisation is started.
187	!
188	IF ( timemeasure ) THEN
189	CALL init_timer
190	CALL start_timer(timer_global)
191	CALL start_timer(timer_mpi)
192	ENDIF
193	!-
194	!
195	!---------------------------------------------------------------------------------------
196	!-
197	!- Print some diagnostics for this main of ORCHIDEE
198	!-
199	!---------------------------------------------------------------------------------------
200	!-
201	CALL MPI_COMM_RANK(MPI_COMM_WORLD, glo_rank, ierror)
202	CALL MPI_COMM_RANK(LOCAL_OASIS_COMM, loc_rank, ierror)
203	CALL MPI_COMM_SIZE(MPI_COMM_WORLD, glo_size, ierror)
204	CALL MPI_COMM_SIZE(LOCAL_OASIS_COMM, loc_size, ierror)
205	!-
206	!
207	WRITE (numout,*) '-----------------------------------------------------------'
208	WRITE (numout,*) '-------------------- comp_name= ',comp_name,' ---------------'
209	WRITE (numout,*) '-----------------------------------------------------------'
210	WRITE (numout,*) TRIM(comp_name), ' Running with reals compiled as kind =',r_std
211	WRITE (numout,*) 'I am component ', TRIM(comp_name), ' local rank :', loc_rank, &
212	& " Global rank :", glo_rank
213	WRITE (numout,*) 'CPUs we are using for the main :', loc_size, ' Global number :', glo_size
214	WRITE (numout,*) 'Local and global MPI communicators :', LOCAL_OASIS_COMM, MPI_COMM_WORLD
215	WRITE (numout,*) '----------------------------------------------------------'
216	!
217	!---------------------------------------------------------------------------------------
218	!-
219	!- Start the getconf processes
220	!-
221	!---------------------------------------------------------------------------------------
222	!-
223	!! CALL getin_name("run.def")
224	!-
225	!Config Key = GRID_FILE
226	!Config Desc = Name of file containing the forcing data
227	!Config If = [-]
228	!Config Def = grid_file.nc
229	!Config Help = This is the name of the file from which we will read
230	!Config or write into it the description of the grid from
231	!Config the forcing file.
232	!Config compliant.
233	!Config Units = [FILE]
234	!-
235	gridfilename='grid_file.nc'
236	CALL getin_p('GRID_FILE', gridfilename)
237	!-
238	!- Get some basic variables from the run.def
239	!-
240	atmco2=350.
241	CALL getin_p('ATM_CO2',atmco2)
242	!---------------------------------------------------------------------------------------
243	!-
244	!- Get the grid on all processors.
245	!-
246	!---------------------------------------------------------------------------------------
247	!-
248	!
249	CALL globgrd_getdomsz(gridfilename, iim_glo, jjm_glo, nbindex_g, model_guess, file_id)
250	nbseg = 4
251	!
252	!-
253	!- Allocation of memory
254	!- variables over the entire grid (thus in x,y)
255	ALLOCATE(lon_glo(iim_glo, jjm_glo))
256	ALLOCATE(lat_glo(iim_glo, jjm_glo))
257	ALLOCATE(mask_glo(iim_glo, jjm_glo))
258	ALLOCATE(area_glo(iim_glo, jjm_glo))
259	ALLOCATE(corners_glo(iim_glo, jjm_glo, nbseg, 2))
260	!
261	! Gathered variables
262	ALLOCATE(kindex_g(nbindex_g))
263	ALLOCATE(contfrac_glo(nbindex_g))
264	!-
265	!-
266	!-
267	CALL globgrd_getgrid(file_id, iim_glo, jjm_glo, nbindex_g, model_guess, &
268	& lon_glo, lat_glo, mask_glo, area_glo, corners_glo,&
269	& kindex_g, contfrac_glo, calendar)
270	!-
271	!- Set the calendar and get some information
272	!-
273	CALL ioconf_calendar(calendar)
274	CALL ioget_calendar(one_year, one_day)
275	!-
276	!- get the time period for the run
277	!-
278	CALL orchoasis_time(date0, dt, nbdt)
279	!-
280	!- lalo needs to be created before going into the parallel region
281	!-
282	ALLOCATE(lalo_glo(nbindex_g,2))
283	DO ik=1,nbindex_g
284	!
285	j = ((kindex_g(ik)-1)/iim_glo)+1
286	i = (kindex_g(ik)-(j-1)*iim_glo)
287	!
288	IF ( i > iim_glo .OR. j > jjm_glo ) THEN
289	WRITE(100+mpi_rank,*) "Error in the indexing (ik, kindex, i, j) : ", ik, kindex(ik), i, j
290	STOP "ERROR in orchideeoasis"
291	ENDIF
292	!
293	lalo_glo(ik,1) = lat_glo(i,j)
294	lalo_glo(ik,2) = lon_glo(i,j)
295	!
296	ENDDO
297	!
298	!-
299	!---------------------------------------------------------------------------------------
300	!-
301	!- Initialise the ORCHIDEE domain on the procs (longitude, latitude, indices)
302	!-
303	!---------------------------------------------------------------------------------------
304	!-
305	!- init_data_para also transfers kindex_g to index_g (the variable used in ORCHIDEE)
306	!-
307	CALL grid_set_glo(iim_glo, jjm_glo, nbindex_g)
308	CALL grid_allocate_glo(nbseg)
309	! Copy the list of indexes of land points into index_g used by ORCHIDEE and then broacast to all
310	! processors
311	CALL bcast(nbindex_g)
312	IF ( is_root_prc) index_g = kindex_g
313	CALL bcast(index_g)
314	!
315	WRITE(numout,*) "Rank", mpi_rank, "Into Init_orchidee_data_para_driver with ", nbindex_g,index_g(1)
316	!
317	CALL Init_orchidee_data_para_driver(nbindex_g,index_g)
318	CALL init_ioipsl_para
319	!
320	WRITE(numout,*) "Rank", mpi_rank, "After init_data_para global size : ", nbp_glo, SIZE(index_g), iim_g, iim_glo, jjm_g, jjm_glo
321	WRITE(numout,'("After init_data_para local : ij_nb, jj_nb",2I4)') iim_glo, jj_nb
322	!
323	! Allocate grid on the local processor
324	!
325	IF ( model_guess == "regular") THEN
326	CALL grid_init (nbp_loc, nbseg, "RegLonLat", "ForcingGrid")
327	ELSE IF ( model_guess == "WRF") THEN
328	CALL grid_init (nbp_loc, nbseg, "RegXY", "WRFGrid")
329	ELSE
330	CALL ipslerr(3, "orchideeoasis", "The grid found in the GRID_FILE is not supported by ORCHIDEE", "", "")
331	ENDIF
332	!
333	! Transfer the global grid variables to the ORCHIDEE version on the root proc
334	! _glo -> _g
335	! Variables *_g were allocated with the CALL init_grid
336	!
337	IF ( is_root_prc) THEN
338	!
339	lalo_g(:,:) = lalo_glo(:,:)
340	lon_g(:,:) = lon_glo(:,:)
341	lat_g(:,:) = lat_glo(:,:)
342	!
343	ENDIF
344	!-
345	!
346	! Set the local dimensions of the fields
347	!
348	iim = iim_glo
349	jjm = jj_nb
350	kjpindex = nbp_loc
351	!
352	WRITE(numout,*) mpi_rank, "DIMENSIONS of grid on processor : iim, jjm, kjpindex = ", iim, jjm, kjpindex
353	!
354	! Allocate the local arrays we need :
355	!
356	ALLOCATE(lon(iim,jjm), lat(iim,jjm))
357	ALLOCATE(kindex(kjpindex))
358	!
359	lon=lon_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
360	lat=lat_glo(:,jj_para_begin(mpi_rank):jj_para_end(mpi_rank))
361	!
362	!
363	! Redistribute the indeces on all procs (apple distribution of land points)
364	!
365	CALL bcast(lon_g)
366	CALL bcast(lat_g)
367	CALL scatter(index_g, kindex)
368	!
369	!
370	! Apply the offset needed so that kindex refers to the index of the land point
371	! on the current region, i.e. the local lon lat domain.
372	!
373	kindex(1:kjpindex)=kindex(1:kjpindex)-(jj_begin-1)*iim_glo
374	!
375	! This routine transforms the global grid into a series of polygons for all land
376	! points identified by index_g.
377	!
378	CALL grid_stuff(nbindex_g, iim_g, jjm_g, lon_g, lat_g, index_g, contfrac_glo)
379	!
380	! Distribute the global lalo to the local processor level lalo
381	!
382	ALLOCATE(lalo_loc(kjpindex,2))
383	CALL scatter(lalo_glo, lalo_loc)
384	lalo(:,:) = lalo_loc(:,:)
385	!
386	!-
387	!---------------------------------------------------------------------------------------
388	!-
389	!- Allocate the space for the per processor coupling variables
390	!-
391	!---------------------------------------------------------------------------------------
392	!-
393	ALLOCATE(zlev_tq(kjpindex), zlev_uv(kjpindex))
394	ALLOCATE(u(kjpindex), v(kjpindex), pb(kjpindex))
395	ALLOCATE(temp_air(kjpindex))
396	ALLOCATE(qair(kjpindex))
397	ALLOCATE(precip_rain(kjpindex), precip_snow(kjpindex))
398	ALLOCATE(swdown(kjpindex), lwdown(kjpindex), sinang(kjpindex))
399	!
400	ALLOCATE(epot_air(kjpindex), ccanopy(kjpindex), cdrag(kjpindex), swnet(kjpindex))
401	!
402	ALLOCATE(petAcoef(kjpindex), peqAcoef(kjpindex), petBcoef(kjpindex), peqBcoef(kjpindex))
403	ALLOCATE(u_tq(kjpindex), v_tq(kjpindex))
404	!
405	ALLOCATE(vevapp(kjpindex), fluxsens(kjpindex), fluxlat(kjpindex), coastalflow(kjpindex), riverflow(kjpindex))
406	ALLOCATE(netco2(kjpindex), carblu(kjpindex))
407	ALLOCATE(tsol_rad(kjpindex), temp_sol_new(kjpindex), qsurf(kjpindex))
408	ALLOCATE(albedo(kjpindex,2), emis(kjpindex), z0m(kjpindex), z0h(kjpindex))
409	!
410	WRITE(numout,*) "Rank", mpi_rank, "Domain size per proc !:", iim_glo, jjm_glo, kjpindex, SIZE(kindex)
411	WRITE(numout,*) "Rank", mpi_rank, "In parallel region land index starts at : ", kindex(1)
412	!
413	CALL orchoasis_time(date0, dt, nbdt)
414	!
415	CALL control_initialize(dt)
416	!
417	!---------------------------------------------------------------------------------------
418	!-
419	!- We need to do an early (and temporary ?) initialisation of the routing scheme to
420	!- determine how many rivers we will have per processor and thus define the OASIS
421	!- partition for the transfer from ORCHIDEE to the ocean model.
422	!-
423	!---------------------------------------------------------------------------------------
424	!
425	! Get the number of rivers requested by the user in the run.def.
426	!
427	num_largest=50
428	CALL getin_p('ROUTING_RIVERS',num_largest)
429	ALLOCATE(lonrivers(num_largest))
430	ALLOCATE(latrivers(num_largest))
431	ALLOCATE(riverflows(num_largest))
432	!
433	! Here a small and independent restart of the routing is done.
434	!
435	IF ( river_routing ) THEN
436	itau_tmp = 0
437	CALL orchoasis_routinginit (itau_tmp, kjpindex, NbNeighb, nbdl, kindex, &
438	& date0, dt, lalo, &
439	& neighbours, resolution, contfrac, &
440	& num_largest, river_nstart, river_nlen, &
441	& lonrivers, latrivers)
442	!
443	ELSE
444	ninc = num_largest/mpi_size
445	river_nstart = mpi_rank*ninc
446	IF ( mpi_rank .NE. mpi_size-1 ) THEN
447	river_nlen = ninc
448	ELSE
449	river_nlen = num_largest-river_nstart
450	ENDIF
451	latrivers(:) = undef
452	lonrivers(:) = undef
453	ENDIF
454	IF ( printlev > 1 ) THEN
455	WRITE(numout,*) "==##== orchideedriver :: river_nstart, river_nlen :", river_nstart, river_nlen
456	DO ik=1,river_nlen
457	WRITE(numout,*) "==##== orchideedriver :: lat, lon : ", ik, latrivers(ik), lonrivers(ik)
458	ENDDO
459	ENDIF
460	!
461	! Start the restat process.
462	!
463	itau = 0
464	!
465	CALL ioipslctrl_restini(itau, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted)
466	WRITE(numout,*) "itau_offset : ", itau_offset, date0, date0_shifted
467	WRITE(numout,*) "itau_offset diff = ", date0_shifted, date0, date0_shifted-date0
468	!
469	! Get the vertical soil levels for the thermal scheme, to be used in xios_orchidee_init
470	!
471	ALLOCATE(soilth_lev(ngrnd), stat=ier)
472	IF (ier /= 0) CALL ipslerr_p(3,'orchideedriver', 'Error in allocation of soilth_lev','','')
473	IF (hydrol_cwrr) THEN
474	soilth_lev(1:ngrnd) = znt(:)
475	ELSE
476	soilth_lev(1:ngrnd) = thermosoilc_levels()
477	END IF
478	!
479	! To ensure that itau starts with 0 at date0 for the restart, we have to set an off-set to achieve this.
480	! itau_offset will get used to prduce itau_sechiba.
481	!
482	itau_offset=-itau_offset-1
483	!-
484	!-
485	!---------------------------------------------------------------------------------------
486	!-
487	!- Send the grid to OASIS ... only on the root processor
488	!-
489	!---------------------------------------------------------------------------------------
490	!-
491	IF ( is_root_prc ) THEN
492	!
493	CALL orchoasis_wrtgrid(model_guess(1:4), iim_glo, jjm_glo, nbseg, lon_glo, lat_glo, &
494	& corners_glo, area_glo, mask_glo)
495	!
496	ENDIF
497	!
498	CALL orchoasis_defvar(mpi_rank, kjpindex)
499	CALL orchoasis_defvecvar(num_largest, river_nstart, river_nlen)
500	CALL oasis_enddef (ierror)
501	!
502	IF ( ierror .NE. 0 ) THEN
503	CALL ipslerr(3, "orchideeoasis", "End of the definition of coupling variables failed.", &
504	& "If OASIS has a way to decide the error status it should be put here.", "")
505	ENDIF
506	!---------------------------------------------------------------------------------------
507	!-
508	!- Start the history procresses either with IOIPSL or XIOS.
509	!-
510	!---------------------------------------------------------------------------------------
511	!
512	!
513	julian = date0 + 0.5*(dt/one_day)
514	CALL ju2ymds (julian, year, month, day, sec)
515	!
516	CALL xios_orchidee_init( MPI_COMM_ORCH, &
517	date0, year, month, day, &
518	lon, lat, soilth_lev)
519	!
520	itau_sechiba = itau + itau_offset
521	!
522	!- Initialize IOIPSL sechiba output files
523	CALL ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, itau_sechiba, &
524	date0, dt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
525	WRITE(numout,*) "HISTORY : Define for ", itau, date0, dt
526	!-
527	!---------------------------------------------------------------------------------------
528	!-
529	!- Get a first set of forcing data
530	!-
531	!---------------------------------------------------------------------------------------
532	!-
533	itau = 0
534	julian = date0 + (itau+0.5)*(dt/one_day)
535	CALL ju2ymds (julian, year, month, day, sec)
536	!-
537	!- Some default values so that the operations before the ORCHIDEE initialisation do not fail.
538	!-
539	z0m(:) = 0.1
540	albedo(:,:) = 0.13
541	!-
542	!---------------------------------------------------------------------------------------
543	!-
544	!- Going into the time loop
545	!-
546	!---------------------------------------------------------------------------------------
547	!-
548	!
549	DO itau=1,nbdt
550	!
551	julian = date0 + (itau-0.5)*(dt/one_day)
552	! Needed for STOMATE but should be taken from the arguments of SECHIBA
553	in_julian = itau2date(itau, date0, dt)
554	!
555	CALL ju2ymds (julian, year, month, day, sec)
556	CALL ymds2ju (year,1,1,zero, julian0)
557	julian_diff = in_julian-julian0
558	!
559	!
560	IF ( itau == nbdt ) lrestart_write = .TRUE.
561	!
562	!---------------------------------------------------------------------------------------
563	!-
564	!- Get the variables from OASIS
565	!-
566	!---------------------------------------------------------------------------------------
567	!
568	! OASIS get call are blocking so they need to be done once all is finsihed
569	!
570	CALL orchoasis_getvar(itau-1, dt, kjpindex, kindex - (ii_begin - 1), &
571	& zlev_tq, zlev_uv, temp_air, qair, &
572	& precip_rain, precip_snow, swnet, lwdown, sinang, u, v, pb, cdrag)
573	!
574	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_air, "RECEIVED Air temperature")
575	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, qair, "RECEIVED Air humidity")
576	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_rain*one_day, "RECEIVED Rainfall")
577	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, precip_snow*one_day, "RECEIVED Snowfall")
578	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, swnet, "RECEIVED net solar")
579	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, lwdown, "RECEIVED lwdown")
580	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, u, "RECEIVED East-ward wind")
581	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, v, "RECEIVED North-ward wind")
582	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, pb, "RECEIVED surface pressure")
583	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_uv, "RECEIVED UV height")
584	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, zlev_tq, "RECEIVED TQ height")
585	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, sinang, "RECEIVED sinang")
586	!
587	!
588	! Adaptation of the forcing data to SECHIBA's needs
589	!
590	! Contrary to what the documentation says, ORCHIDEE expects surface pressure in hPa.
591	pb(:) = pb(:)/100.
592	epot_air(:) = cp_airtemp_air(:)+cte_gravzlev_tq(:)
593	ccanopy(:) = atmco2
594	!
595	petBcoef(:) = epot_air(:)
596	peqBcoef(:) = qair(:)
597	petAcoef(:) = zero
598	peqAcoef(:) = zero
599	!
600	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, z0m, &
601	& "Z0m before compute", ktest)
602	!
603	! Interpolate the wind (which is at hight zlev_uv) to the same height
604	! as the temperature and humidity (at zlev_tq).
605	!
606	u_tq(:) = u(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
607	v_tq(:) = v(:)*LOG(zlev_tq(:)/z0m(:))/LOG(zlev_uv(:)/z0m(:))
608	!
609	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, u_tq, "USED East-ward wind")
610	!
611	IF ( itau .NE. 1 ) THEN
612	IF ( timemeasure ) THEN
613	waitget_cputime = waitget_cputime + Get_cpu_Time(timer_global)
614	waitget_walltime = waitget_walltime + Get_real_Time(timer_global)
615	CALL stop_timer(timer_global)
616	CALL start_timer(timer_global)
617	ENDIF
618	ENDIF
619	!
620	!---------------------------------------------------------------------------------------
621	!-
622	!- IF first time step : Call to SECHIBA_initialize to set-up ORCHIDEE before doing an actual call
623	!- which will provide the first fluxes.
624	!-
625	!---------------------------------------------------------------------------------------
626	!
627	itau_sechiba = itau+itau_offset
628	!
629	! Update the calendar in xios by sending the new time step
630	CALL xios_orchidee_change_context("orchidee")
631	CALL xios_orchidee_update_calendar(itau_sechiba)
632	!
633	IF ( itau == 1 ) THEN
634	!
635	IF ( timemeasure ) THEN
636	WRITE(numout,*) '------> CPU Time for start-up of main : ',Get_cpu_Time(timer_global)
637	WRITE(numout,*) '------> Real Time for start-up of main : ',Get_real_Time(timer_global)
638	CALL stop_timer(timer_global)
639	CALL start_timer(timer_global)
640	ENDIF
641	!
642	CALL sechiba_initialize( &
643	itau_sechiba, iim*jjm, kjpindex, kindex, &
644	lalo_loc, contfrac, neighbours, resolution, zlev_tq, &
645	u_tq, v_tq, qair, temp_air, temp_air, &
646	petAcoef, peqAcoef, petBcoef, peqBcoef, &
647	precip_rain, precip_snow, lwdown, swnet, swdown, &
648	pb, rest_id, hist_id, hist2_id, &
649	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
650	coastalflow, riverflow, tsol_rad, vevapp, qsurf, &
651	z0m, z0h, albedo, fluxsens, fluxlat, emis, &
652	netco2, carblu, temp_sol_new, cdrag)
653	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Init temp_sol_new")
654	!
655	! Use the obtained albedo to diagnose the Downward Solar
656	!
657	swdown(:) = swnet(:)/(1.-(albedo(:,1)+albedo(:,2))/2.)
658	!
659	lrestart_read = .FALSE.
660	!
661	CALL histwrite_p(hist_id, 'LandPoints', itau+1, (/ REAL(kindex) /), kjpindex, kindex)
662	CALL histwrite_p(hist_id, 'Areas', itau+1, area, kjpindex, kindex)
663	CALL histwrite_p(hist_id, 'Contfrac', itau+1, contfrac, kjpindex, kindex)
664	!
665	IF ( timemeasure ) THEN
666	WRITE(numout,*) '------> CPU Time for set-up of ORCHIDEE : ',Get_cpu_Time(timer_global)
667	WRITE(numout,*) '------> Real Time for set-up of ORCHIDEE : ',Get_real_Time(timer_global)
668	CALL stop_timer(timer_global)
669	CALL start_timer(timer_global)
670	ENDIF
671	ENDIF
672	!
673	!---------------------------------------------------------------------------------------
674	!-
675	!- Call to SECHIBA
676	!-
677	!---------------------------------------------------------------------------------------
678	!
679	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
680	& lrestart_read, lrestart_write, &
681	& lalo_loc, contfrac, neighbours, resolution, &
682	! First level conditions
683	& zlev_tq, u_tq, v_tq, qair, qair, temp_air, temp_air, epot_air, ccanopy, &
684	! Variables for the implicit coupling
685	& cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
686	! Rain, snow, radiation and surface pressure
687	& precip_rain ,precip_snow, lwdown, swnet, swdown, sinang, pb, &
688	! Output : Fluxes
689	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, netco2, carblu, &
690	! Surface temperatures and surface properties
691	& tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, z0h, &
692	! File ids
693	& rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC)
694	!
695	! Use the obtained albedo to diagnose the Downward Solar
696	!
697	swdown(:) = swnet(:)/(1.-(albedo(:,1)+albedo(:,2))/2.)
698	!
699	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, temp_sol_new, "Produced temp_sol_new")
700	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxsens, "Produced fluxsens")
701	CALL orchoasis_printpoint(julian, testpt(1), testpt(2), kjpindex, lalo_loc, fluxlat, "Produced fluxlat")
702	!
703	! Get the flow of the largest rivers
704	!
705	IF ( river_routing ) THEN
706	CALL routing_reg_riverflow(river_nlen, lonrivers, latrivers, riverflows)
707	ELSE
708	riverflows(:) = undef_sechiba
709	ENDIF
710	!
711	IF ( timemeasure ) THEN
712	orchidee_cputime = orchidee_cputime + Get_cpu_Time(timer_global)
713	orchidee_walltime = orchidee_walltime + Get_real_Time(timer_global)
714	CALL stop_timer(timer_global)
715	CALL start_timer(timer_global)
716	ENDIF
717	!
718	!---------------------------------------------------------------------------------------
719	! Send the ORCHIDEE output back to the driver
720	!---------------------------------------------------------------------------------------
721	!
722	CALL orchoasis_putvar(itau-1, dt, kjpindex, kindex - (ii_begin - 1),&
723	& vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
724	& netco2, carblu, tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, z0h)
725	!
726	CALL orchoasis_putvecvar(itau-1, dt, river_nlen, lonrivers, latrivers, riverflows)
727	!
728	IF ( timemeasure ) THEN
729	waitput_cputime = waitput_cputime + Get_cpu_Time(timer_global)
730	waitput_walltime = waitput_walltime + Get_real_Time(timer_global)
731	CALL stop_timer(timer_global)
732	CALL start_timer(timer_global)
733	ENDIF
734	!
735	!---------------------------------------------------------------------------------------
736	!-
737	!- Write diagnostics
738	!-
739	!---------------------------------------------------------------------------------------
740	!
741	!---------------------------------------------------------------------------------------
742	!-
743	!- Write diagnostics
744	!-
745	!---------------------------------------------------------------------------------------
746	!
747	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
748	CALL xios_orchidee_send_field("areas", area)
749	CALL xios_orchidee_send_field("contfrac",contfrac)
750	CALL xios_orchidee_send_field("temp_air",temp_air)
751	CALL xios_orchidee_send_field("qair",qair)
752	CALL xios_orchidee_send_field("swnet",swnet)
753	CALL xios_orchidee_send_field("swdown",swdown)
754	! zpb in hPa, output in Pa
755	CALL xios_orchidee_send_field("pb",pb)
756	!
757	IF ( .NOT. almaoutput ) THEN
758	!
759	! ORCHIDEE INPUT variables
760	!
761	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
762	CALL histwrite_p (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
763	CALL histwrite_p (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
764	CALL histwrite_p (hist_id, 'evap', itau_sechiba, vevapp, kjpindex, kindex)
765	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
766	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
767	!
768	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
769	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
770	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
771	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
772	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex)
773	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
774	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, albedo(:,1), kjpindex, kindex)
775	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, albedo(:,2), kjpindex, kindex)
776	!
777	IF ( hist2_id > 0 ) THEN
778	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
779	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
780	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
781	!
782	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, vevapp, kjpindex, kindex)
783	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, coastalflow, kjpindex, kindex)
784	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, riverflow, kjpindex, kindex)
785	!
786	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
787	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
788	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
789	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, fluxsens, kjpindex, kindex)
790	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, fluxlat, kjpindex, kindex)
791	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
792	!
793	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, albedo(:,1), kjpindex, kindex)
794	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, albedo(:,2), kjpindex, kindex)
795	ENDIF
796	ELSE
797	!
798	! Input variables
799	!
800	CALL histwrite_p (hist_id, 'SinAng', itau_sechiba, sinang, kjpindex, kindex)
801	CALL histwrite_p (hist_id, 'LWdown', itau_sechiba, lwdown, kjpindex, kindex)
802	CALL histwrite_p (hist_id, 'SWdown', itau_sechiba, swdown, kjpindex, kindex)
803	CALL histwrite_p (hist_id, 'Tair', itau_sechiba, temp_air, kjpindex, kindex)
804	CALL histwrite_p (hist_id, 'Qair', itau_sechiba, qair, kjpindex, kindex)
805	CALL histwrite_p (hist_id, 'SurfP', itau_sechiba, pb, kjpindex, kindex)
806	CALL histwrite_p (hist_id, 'Windu', itau_sechiba, u_tq, kjpindex, kindex)
807	CALL histwrite_p (hist_id, 'Windv', itau_sechiba, v_tq, kjpindex, kindex)
808	!
809	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
810	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
811	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
812	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex)
813	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
814	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
815	!
816	! There is a mess with the units passed to the coupler. To be checked with Marc
817	!
818	IF ( river_routing ) THEN
819	CALL histwrite_p (hist_id, 'CoastalFlow',itau_sechiba, coastalflow, kjpindex, kindex)
820	CALL histwrite_p (hist_id, 'RiverFlow',itau_sechiba, riverflow, kjpindex, kindex)
821	ENDIF
822	!
823	IF ( hist2_id > 0 ) THEN
824	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, vevapp, kjpindex, kindex)
825	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
826	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, fluxsens, kjpindex, kindex)
827	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, fluxlat, kjpindex, kindex)
828	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, temp_sol_new, kjpindex, kindex)
829	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, temp_sol_new, kjpindex, kindex)
830	ENDIF
831	ENDIF
832	!
833	!
834	ENDDO
835	!
836	!---------------------------------------------------------------------------------------
837	!-
838	!- Get time and close IOIPSL, OASIS and MPI
839	!-
840	!---------------------------------------------------------------------------------------
841	!
842	CALL histclo
843	IF(is_root_prc) THEN
844	CALL restclo
845	CALL getin_dump
846	ENDIF
847	!
848	WRITE(numout,*) "IOIPSL finalized"
849	!-
850	!- Deallocate all variables existing on all procs (list still incomplete)
851	!-
852	IF ( ALLOCATED(lon_glo) ) DEALLOCATE(lon_glo)
853	IF ( ALLOCATED(lat_glo) ) DEALLOCATE(lat_glo)
854	IF ( ALLOCATED(mask_glo) ) DEALLOCATE(mask_glo)
855	IF ( ALLOCATED(area_glo) ) DEALLOCATE(area_glo)
856	IF ( ALLOCATED(corners_glo) ) DEALLOCATE(corners_glo)
857	IF ( ALLOCATED(kindex_g) ) DEALLOCATE(kindex_g)
858	IF ( ALLOCATED(contfrac_glo) ) DEALLOCATE(contfrac_glo)
859	IF ( ALLOCATED(lalo_glo) ) DEALLOCATE(lalo_glo)
860	IF ( ALLOCATED(lon) ) DEALLOCATE(lon)
861	IF ( ALLOCATED(lat) ) DEALLOCATE(lat)
862	IF ( ALLOCATED(kindex) ) DEALLOCATE(kindex)
863	IF ( ALLOCATED(lalo_loc) ) DEALLOCATE(lalo_loc)
864	IF ( ALLOCATED(zlev_tq) ) DEALLOCATE(zlev_tq)
865	IF ( ALLOCATED(zlev_uv) ) DEALLOCATE(zlev_uv)
866	IF ( ALLOCATED(u) ) DEALLOCATE(u)
867	IF ( ALLOCATED(v) ) DEALLOCATE(v)
868	IF ( ALLOCATED(pb) ) DEALLOCATE(pb)
869	IF ( ALLOCATED(temp_air) ) DEALLOCATE(temp_air)
870	IF ( ALLOCATED(qair) ) DEALLOCATE(qair)
871	IF ( ALLOCATED(precip_rain) ) DEALLOCATE(precip_rain)
872	IF ( ALLOCATED(precip_snow) ) DEALLOCATE(precip_snow)
873	IF ( ALLOCATED(swdown) ) DEALLOCATE(swdown)
874	IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
875	IF ( ALLOCATED(lwdown) ) DEALLOCATE(lwdown)
876	IF ( ALLOCATED(sinang) ) DEALLOCATE(sinang)
877	IF ( ALLOCATED(epot_air) ) DEALLOCATE(epot_air)
878	IF ( ALLOCATED(ccanopy) ) DEALLOCATE(ccanopy)
879	IF ( ALLOCATED(cdrag) ) DEALLOCATE(cdrag)
880	IF ( ALLOCATED(swnet) ) DEALLOCATE(swnet)
881	IF ( ALLOCATED(petAcoef) ) DEALLOCATE(petAcoef)
882	IF ( ALLOCATED(peqAcoef) ) DEALLOCATE(peqAcoef)
883	IF ( ALLOCATED(petBcoef) ) DEALLOCATE(petBcoef)
884	IF ( ALLOCATED(peqBcoef) ) DEALLOCATE(peqBcoef)
885	IF ( ALLOCATED(u_tq) ) DEALLOCATE(u_tq)
886	IF ( ALLOCATED(v_tq) ) DEALLOCATE(v_tq)
887	IF ( ALLOCATED(vevapp) ) DEALLOCATE(vevapp)
888	IF ( ALLOCATED(fluxsens) ) DEALLOCATE(fluxsens)
889	IF ( ALLOCATED(fluxlat) ) DEALLOCATE(fluxlat)
890	IF ( ALLOCATED(coastalflow) ) DEALLOCATE(coastalflow)
891	IF ( ALLOCATED(riverflow) ) DEALLOCATE(riverflow)
892	IF ( ALLOCATED(netco2) ) DEALLOCATE(netco2)
893	IF ( ALLOCATED(carblu) ) DEALLOCATE(carblu)
894	IF ( ALLOCATED(tsol_rad) ) DEALLOCATE(tsol_rad)
895	IF ( ALLOCATED(temp_sol_new) ) DEALLOCATE(temp_sol_new)
896	IF ( ALLOCATED(qsurf) ) DEALLOCATE(qsurf)
897	IF ( ALLOCATED(albedo) ) DEALLOCATE(albedo)
898	IF ( ALLOCATED(emis) ) DEALLOCATE(emis)
899	IF ( ALLOCATED(z0m) ) DEALLOCATE(z0m)
900	IF ( ALLOCATED(z0h) ) DEALLOCATE(z0h)
901	!
902	WRITE(numout,*) "Memory deallocated"
903	!-
904	IF ( timemeasure ) THEN
905	WRITE(numout,*) '------> Total CPU Time waiting to get forcing : ',waitget_cputime
906	WRITE(numout,*) '------> Total Real Time waiting to get forcing : ',waitget_walltime
907	WRITE(numout,*) '------> Total CPU Time for ORCHIDEE : ', orchidee_cputime
908	WRITE(numout,*) '------> Total Real Time for ORCHIDEE : ', orchidee_walltime
909	WRITE(numout,*) '------> Total CPU Time waiting to put fluxes : ',waitput_cputime
910	WRITE(numout,*) '------> Total Real Time waiting to put fluxes : ',waitput_walltime
911	WRITE(numout,*) '------> Total without MPI : CPU Time : ', Get_cpu_Time(timer_mpi)
912	WRITE(numout,*) '------> Total without MPI : Real Time : ', Get_real_Time(timer_mpi)
913	CALL stop_timer(timer_global)
914	CALL stop_timer(timer_mpi)
915	ENDIF
916	!-
917	!-
918	! XIOS will also finalize OASIS if it is used. Else we need to do it by hand.
919	!
920	IF ( xios_orchidee_ok ) THEN
921	CALL xios_orchidee_finalize
922	WRITE(numout,*) "Out of xios_context_finalize"
923	CALL oasis_terminate(ierror)
924	WRITE(numout,*) "Out of oasis_terminate", ierror
925	ELSE
926	CALL oasis_terminate(ierror)
927	ENDIF
928	!
929	WRITE(numout,*) "OASIS & XIOS terminated"
930	!-
931	END PROGRAM orchideeoasis
932

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

Download in other formats: