Context Navigation

source: branches/ORCHIDEE_2_2/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 8011

Last change on this file since 8011 was 8011, checked in by josefine.ghattas, 14 months ago
Deactivate 2 variables not available on unstructured grid : as done in the trunk [8010]
Property svn:keywords set to `Date Revision HeadURL`
File size: 53.0 KB

Line
1	! ================================================================================================================================
2	! MODULE : xios_orchidee
3	!
4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This module contains the initialization and interface to the XIOS code.
10	!!
11	!!\n DESCRIPTION: This module contains the interface for the use of the XIOS code. All call to XIOS are done in this module.
12	!! Revision 965 of XIOS/trunk or later is needed. This version is also called XIOS2.
13	!! Older revisions and XIOS1 can not be used.
14	!!
15	!! Summury of subroutines
16	!! xios_orchidee_comm_init : First call to XIOS to get the MPI communicator
17	!! xios_orchidee_init : Initialize variables needed for use of XIOS
18	!! Deactivation of fields not calculated due specific run options
19	!! xios_orchidee_update_calendar : Update the calandar in XIOS
20	!! xios_orchidee_finalize : Last call to XIOS for finalization
21	!! xios_orchidee_send_field : Interface to send fields with 1, 2 or 3 dimensions to XIOS
22	!! xios_orchidee_send_field_r1d : Internal subroutine for 1D(array) fields
23	!! xios_orchidee_send_field_r2d : Internal subroutine for 2D fields
24	!! xios_orchidee_send_field_r3d : Internal subroutine for 3D fields
25	!!
26	!! It is only possible to use XIOS2. Note that compilation must be done with the preprocessing key XIOS
27	!! and CPP_PARA. Compiling without these keys makes it impossible to activate XIOS.
28	!! To activate running using XIOS, the flag XIOS_ORCHIDEE_OK=y must be set in run.def and the file iodef.xml must exist.
29	!!
30	!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
31	!! Removed possibility to use XIOS1, 21/10/2016
32	!!
33	!! REFERENCE(S) : None
34	!!
35	!! SVN :
36	!! $HeadURL$
37	!! $Date$
38	!! $Revision$
39	!! \n
40	!_ ================================================================================================================================
41
42	MODULE xios_orchidee
43
44	#ifdef XIOS
45	USE xios
46	#endif
47	USE defprec
48	USE pft_parameters_var, ONLY : nvm
49	USE constantes_var
50	USE constantes_soil_var, ONLY : nstm, nscm, diaglev, check_cwrr, ok_freeze_cwrr
51	USE time, ONLY : dt_sechiba
52	USE vertical_soil_var, ONLY : ngrnd, nslm
53	USE IOIPSL, ONLY : ioget_calendar, ju2ymds
54	USE mod_orchidee_para_var
55	USE mod_orchidee_transfert_para
56	USE ioipsl_para
57
58	IMPLICIT NONE
59	PRIVATE
60	PUBLIC :: xios_orchidee_init, xios_orchidee_change_context, &
61	xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
62	xios_orchidee_close_definition, &
63	xios_orchidee_send_field, xios_orchidee_recv_field, &
64	xios_orchidee_set_file_attr, xios_orchidee_set_field_attr, xios_orchidee_set_fieldgroup_attr, xios_orchidee_setvar, xios_orchidee_addaxis
65
66
67	!
68	!! Declaration of public variables
69	!
70	LOGICAL, PUBLIC, SAVE :: xios_orchidee_ok=.TRUE. !! Use XIOS for diagnostic files
71	!$OMP THREADPRIVATE(xios_orchidee_ok)
72	LOGICAL, PUBLIC, SAVE :: xios_interpolation !! Do reading and interpolations with XIOS. If false, reading will be done with IOIOSL and interpolation using aggregate_p
73	!$OMP THREADPRIVATE(xios_interpolation)
74
75	REAL(r_std), PUBLIC, SAVE :: xios_default_val=0 !! Default value (missing value) used in XIOS. The value 0 will be overwritten with the value taken from XIOS.
76	!$OMP THREADPRIVATE(xios_default_val)
77
78	!
79	!! Declaration of internal variables
80	!
81	#ifdef XIOS
82	TYPE(xios_context) :: ctx_hdl_orchidee !! Handel for ORCHIDEE
83	!$OMP THREADPRIVATE(ctx_hdl_orchidee)
84	#endif
85
86
87
88	!! ==============================================================================================================================
89	!! INTERFACE : xios_orchidee_send_field
90	!!
91	!>\BRIEF Send a field to XIOS.
92	!!
93	!! DESCRIPTION :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
94	!! This interface should be called at each time-step for each output varaiables.
95	!!
96	!! \n
97	!_ ================================================================================================================================
98	INTERFACE xios_orchidee_send_field
99	MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d, &
100	xios_orchidee_send_field_r4d, xios_orchidee_send_field_r5d
101	END INTERFACE
102
103	INTERFACE xios_orchidee_recv_field
104	MODULE PROCEDURE xios_orchidee_recv_field_r1d, xios_orchidee_recv_field_r2d, xios_orchidee_recv_field_r3d
105	END INTERFACE
106
107
108	CONTAINS
109
110
111	!! ==============================================================================================================================
112	!! SUBROUTINE : xios_orchidee_init
113	!!
114	!>\BRIEF Initialize variables needed for use of XIOS.
115	!!
116	!! DESCRIPTION :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step.
117	!!
118	!! In this subroutine also a section containg deactivation of some fields is found. The variables are
119	!! deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the
120	!! routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same
121	!! iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
122	!! is activated in the code can always be deactivated from the iodef.xml external file.
123	!!
124	!! \n
125	!_ ================================================================================================================================
126	SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH, &
127	date0, year, month, day, julian_diff, &
128	lon_mpi, lat_mpi )
129
130	USE grid, ONLY : grid_type, unstructured, regular_lonlat, regular_xy, nvertex, &
131	longitude, latitude, bounds_lon, bounds_lat, ind_cell_glo
132
133	USE vertical_soil_var, ONLY : znt, znh
134
135	IMPLICIT NONE
136	!
137	!! 0. Variable and parameter declaration
138	!
139	!! 0.1 Input variables
140	!
141	INTEGER(i_std), INTENT(in) :: MPI_COMM_ORCH !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
142	REAL(r_std), INTENT(in) :: date0 !! Julian day at first time step
143	INTEGER(i_std), INTENT(in) :: year, month, day !! Current date information
144	REAL(r_std), INTENT(in) :: julian_diff !! Current day in the year [1,365(366)]
145	REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in) :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
146	!
147	!! 0.2 Local variables
148	!
149	#ifdef XIOS
150
151	TYPE(xios_duration) :: dtime_xios
152	TYPE(xios_date) :: start_date
153	TYPE(xios_date) :: time_origin
154	TYPE(xios_fieldgroup) :: fieldgroup_handle
155	TYPE(xios_field) :: field_handle
156	TYPE(xios_file) :: file_handle
157	#endif
158	INTEGER(i_std) :: i
159	INTEGER(i_std) :: year0, month0, day0 !! Time origin date information
160	REAL(r_std) :: sec0 !! Time origin date information
161	CHARACTER(LEN=20) :: calendar_str !! Name of current calendar
162	CHARACTER(LEN=30) :: start_str !! Current date as character string
163	CHARACTER(LEN=30) :: startorig_str !! Time origin date as character string
164
165	REAL(r_std),ALLOCATABLE :: longitude_mpi(:), latitude_mpi(:)
166	REAL(r_std),ALLOCATABLE :: bounds_lon_mpi(:,:),bounds_lat_mpi(:,:)
167	INTEGER(i_std),ALLOCATABLE :: ind_cell_mpi(:)
168	LOGICAL :: xios_remap_output
169	!_ ================================================================================================================================
170
171
172	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_init'
173
174	!Config Key = XIOS_ORCHIDEE_OK
175	!Config Desc = Use XIOS for writing diagnostics file
176	!Config If =
177	!Config Def = y
178	!Config Help = Compiling and linking with XIOS library is necessary.
179	!Config Units = [FLAG]
180	CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
181	IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
182
183
184	! Coherence test between flag and preprocessing key
185	#ifndef XIOS
186	IF (xios_orchidee_ok) THEN
187	CALL ipslerr_p(3,'xios_orchidee_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS',&
188	'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def', '')
189	END IF
190	#endif
191
192
193
194	IF (xios_orchidee_ok) THEN
195	!Config Key = XIOS_INTERPOLATION
196	!Config Desc = Actiave reading and intrepolation using XIOS
197	!Config If = XIOS_ORCHIDEE_OK
198	!Config Def = n
199	!Config Help = This flag allows the user to decide to use xios
200	!Config interpolation or standard method for reading input files
201	!Config Units = [FLAG]
202	xios_interpolation = .FALSE.
203	CALL getin_p('XIOS_INTERPOLATION', xios_interpolation)
204
205
206	!Config Key = XIOS_REMAP_OUTPUT
207	!Config Desc = Actiave remaping of diagnostic output files to regular grid
208	!Config If = XIOS_ORCHIDEE_OK .AND. grid_type=unstructured
209	!Config Def = True
210	!Config Help = Set this flag to false to output an unstructured grid on its natvie grid without interpolation
211	!Config Units = [FLAG]
212	xios_remap_output=.TRUE.
213	CALL getin_p("XIOS_REMAP_OUTPUT",xios_remap_output)
214
215	ELSE
216	! Deactivate interpolation with XIOS not possible wihtout having
217	! xios_orchidee_ok=true
218	xios_interpolation = .FALSE.
219	END IF
220
221	! Force xios_interpolation=.TRUE. if using unstructured grid
222	IF (grid_type==unstructured .AND. .NOT. xios_interpolation) THEN
223	WRITE(numout,*) 'xios_interpolation must be true for unstructured grid. It is now changed to true.'
224	xios_interpolation=.TRUE.
225	END IF
226	IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_interpolation=', xios_interpolation
227
228
229	!
230	!! 1. Set date and calendar information on the format needed by XIOS
231	!
232
233	! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
234	CALL ioget_calendar(calendar_str)
235
236	IF (calendar_str == 'gregorian') THEN
237	calendar_str='gregorian'
238	ELSE IF (calendar_str == 'noleap') THEN
239	calendar_str='noleap'
240	ELSE IF (calendar_str == '360d' .OR. calendar_str == '360_day') THEN
241	calendar_str='d360'
242	END IF
243
244	! Transform the time origin from julian days into year, month, day and seconds
245	CALL ju2ymds(date0, year0, month0, day0, sec0)
246
247	IF (grid_type==unstructured) THEN
248	IF (is_omp_root) THEN
249	ALLOCATE(longitude_mpi(ij_nb))
250	ALLOCATE(latitude_mpi(ij_nb))
251	ALLOCATE(bounds_lon_mpi(ij_nb,nvertex))
252	ALLOCATE(bounds_lat_mpi(ij_nb,nvertex))
253	ALLOCATE(ind_cell_mpi(ij_nb))
254	ELSE
255	ALLOCATE(longitude_mpi(0))
256	ALLOCATE(latitude_mpi(0))
257	ALLOCATE(bounds_lon_mpi(0,0))
258	ALLOCATE(bounds_lat_mpi(0,0))
259	ALLOCATE(ind_cell_mpi(0))
260	ENDIF
261
262	CALL gather_unindexed_omp(longitude,longitude_mpi)
263	CALL gather_unindexed_omp(latitude,latitude_mpi)
264	CALL gather_unindexed_omp(bounds_lon,bounds_lon_mpi)
265	CALL gather_unindexed_omp(bounds_lat,bounds_lat_mpi)
266	CALL gather_unindexed_omp(ind_cell_glo,ind_cell_mpi)
267	ENDIF
268
269
270	IF (xios_orchidee_ok .AND. is_omp_root) THEN
271	#ifdef XIOS
272	!
273	!! 2. Context initialization
274	!
275	CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
276	CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
277	CALL xios_set_current_context(ctx_hdl_orchidee)
278
279	!
280	!! 2. Calendar, timstep and date definition
281	!
282	dtime_xios%second=dt_sechiba
283
284	CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
285	time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
286
287	!
288	!! 3. Domain definition
289	!
290	IF (grid_type==regular_lonlat) THEN
291	! Global domain
292	CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
293	! Local MPI domain
294	CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
295
296	! Define how data is stored on memory : 1D array for only continental points
297	CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
298	CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)
299
300	! Define longitudes and latitudes on local MPI domain
301	CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
302
303	ELSE IF (grid_type==regular_xy ) THEN
304	! Global domain
305	CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
306	! Local MPI domain
307	CALL xios_set_domain_attr("domain_landpoints",type="curvilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
308
309	! Define how data is stored on memory : 1D array for only continental points
310	CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
311	CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)
312
313	! Define longitudes and latitudes on local MPI domain depending on grid_type
314	CALL xios_set_domain_attr("domain_landpoints",lonvalue_2d=lon_mpi,latvalue_2d=lat_mpi)
315
316	ELSE IF (grid_type==unstructured) THEN
317
318	! Global domain
319	CALL xios_set_domain_attr("domain_landpoints", ni_glo=jjm_g, type="unstructured", nvertex=nvertex)
320	! Local MPI domain
321	CALL xios_set_domain_attr("domain_landpoints", ibegin=ij_begin-1, ni=ij_nb)
322
323	! Define how data is stored on memory : 1D array for only continental points
324	CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ni=nbp_mpi, data_i_index=kindex_mpi-1)
325
326	! Define longitudes and latitudes on local MPI domain
327	CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=longitude_mpi,latvalue_1d=latitude_mpi)
328	CALL xios_set_domain_attr("domain_landpoints",bounds_lon_1d=RESHAPE(bounds_lon_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
329	CALL xios_set_domain_attr("domain_landpoints",bounds_lat_1d=RESHAPE(bounds_lat_mpi,(/nvertex,ij_nb/),order=(/2,1/)))
330
331
332	IF (xios_remap_output) THEN
333
334	! Define output grid as domain_landpoints_regular (grid specified in xml files)
335	CALL xios_set_domain_attr("domain_landpoints_out",domain_ref="domain_landpoints_regular")
336
337	CALL xios_set_fieldgroup_attr("remap_expr",expr="@this_ref")
338	CALL xios_set_fieldgroup_attr("remap_1ts", freq_op=xios_duration_convert_from_string("1ts"))
339	CALL xios_set_fieldgroup_attr("remap_1800s", freq_op=xios_duration_convert_from_string("1800s"))
340	CALL xios_set_fieldgroup_attr("remap_1h", freq_op=xios_duration_convert_from_string("1h"))
341	CALL xios_set_fieldgroup_attr("remap_3h", freq_op=xios_duration_convert_from_string("3h"))
342	CALL xios_set_fieldgroup_attr("remap_6h", freq_op=xios_duration_convert_from_string("6h"))
343	CALL xios_set_fieldgroup_attr("remap_1d", freq_op=xios_duration_convert_from_string("1d"))
344	CALL xios_set_fieldgroup_attr("remap_1mo", freq_op=xios_duration_convert_from_string("1mo"))
345	CALL xios_set_fieldgroup_attr("remap_1y", freq_op=xios_duration_convert_from_string("1y"))
346	ENDIF
347
348	END IF
349
350	!
351	!! 4. Axis definition
352	!
353	CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
354	CALL xios_set_axis_attr("nlut",n_glo=nlut ,VALUE=(/(REAL(i,r_std),i=1,nlut)/))
355	CALL xios_set_axis_attr("ncarb",n_glo=ncarb ,VALUE=(/(REAL(i,r_std),i=1,ncarb)/))
356	CALL xios_set_axis_attr("nparts",n_glo=nparts,VALUE=(/(REAL(i,r_std),i=1,nparts)/))
357	CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
358	CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=znt(:))
359	CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
360	CALL xios_set_axis_attr("nscm", n_glo=nscm,VALUE=(/(REAL(i,r_std),i=1,nscm)/))
361	CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
362	CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
363	CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=znh(:))
364	CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
365	CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
366	CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
367	CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
368	CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
369
370	!
371	!! 5. Get the default value (missing value) used by XIOS. This value is set in field_def_orchidee.xml
372	!
373	CALL xios_get_fieldgroup_attr("field_definition", default_value=xios_default_val)
374	IF (printlev>=2) WRITE(numout,*) 'Default value read from XIOS, xios_default_val=',xios_default_val
375
376	!
377	!! 5. Deactivation of some fields if they are not calculated
378	!
379	IF ( OFF_LINE_MODE ) THEN
380	CALL xios_set_field_attr("riverflow_cpl",enabled=.FALSE.)
381	CALL xios_set_field_attr("coastalflow_cpl",enabled=.FALSE.)
382	END IF
383
384	IF ( .NOT. river_routing ) THEN
385	CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
386	CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
387	CALL xios_set_field_attr("riversret",enabled=.FALSE.)
388	CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
389	CALL xios_set_field_attr("htuhgmon",enabled=.FALSE.)
390	CALL xios_set_field_attr("fastr",enabled=.FALSE.)
391	CALL xios_set_field_attr("slowr",enabled=.FALSE.)
392	CALL xios_set_field_attr("streamr",enabled=.FALSE.)
393	CALL xios_set_field_attr("laker",enabled=.FALSE.)
394	CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
395	CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
396	CALL xios_set_field_attr("pondr",enabled=.FALSE.)
397	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
398	CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
399	CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
400	CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
401	CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
402	CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
403	CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
404	CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
405	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
406	CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
407	CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
408	CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
409	CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
410	CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
411	CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
412	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
413	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
414	CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
415	CALL xios_set_field_attr("htutempmon",enabled=.FALSE.)
416	CALL xios_set_field_attr("streamlimit",enabled=.FALSE.)
417	CALL xios_set_field_attr("StreamT_TotTend",enabled=.FALSE.)
418	CALL xios_set_field_attr("StreamT_AdvTend",enabled=.FALSE.)
419	CALL xios_set_field_attr("StreamT_RelTend",enabled=.FALSE.)
420	END IF
421
422	IF (.NOT. ok_freeze_cwrr) THEN
423	CALL xios_set_field_attr("profil_froz_hydro",enabled=.FALSE.)
424	END IF
425
426
427	IF (.NOT. check_cwrr) THEN
428	CALL xios_set_field_attr("check_infilt",enabled=.FALSE.)
429	CALL xios_set_field_attr("check_tr",enabled=.FALSE.)
430	CALL xios_set_field_attr("check_over",enabled=.FALSE.)
431	CALL xios_set_field_attr("check_under",enabled=.FALSE.)
432	CALL xios_set_field_attr("check_top",enabled=.FALSE.)
433	CALL xios_set_field_attr("qflux",enabled=.FALSE.)
434	END IF
435
436	IF ( .NOT. do_floodplains ) THEN
437	CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
438	CALL xios_set_field_attr("floodh",enabled=.FALSE.)
439	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
440	CALL xios_set_field_attr("floodout",enabled=.FALSE.)
441	CALL xios_set_field_attr("flood_frac",enabled=.FALSE.)
442	END IF
443
444	! Deactivate some stomate fields.
445	! These fields were traditionally added in sechiba_history.nc output file.
446	IF ( .NOT. ok_stomate ) THEN
447	CALL xios_set_field_attr("nee",enabled=.FALSE.)
448	CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
449	CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
450	CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
451	CALL xios_set_field_attr("npp",enabled=.FALSE.)
452	END IF
453
454	IF ( .NOT. do_irrigation ) THEN
455	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
456	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
457	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
458	CALL xios_set_field_attr("irrig_deficit",enabled=.FALSE.)
459	CALL xios_set_field_attr("irrig_adduct",enabled=.FALSE.)
460	CALL xios_set_field_attr("irrig_gw_source",enabled=.FALSE.)
461	CALL xios_set_field_attr("irrig_fast_source",enabled=.FALSE.)
462	CALL xios_set_field_attr("irrig_str_source",enabled=.FALSE.)
463	CALL xios_set_field_attr("Count_failure_slow",enabled=.FALSE.)
464	CALL xios_set_field_attr("Count_failure_fast",enabled=.FALSE.)
465	CALL xios_set_field_attr("Count_failure_stre",enabled=.FALSE.)
466	CALL xios_set_field_attr("irrigmap_dyn",enabled=.FALSE.)
467	END IF
468
469	IF ( .NOT. ok_bvoc)THEN
470	CALL xios_set_field_attr("PAR",enabled=.FALSE.)
471	CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
472	CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
473	CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
474	CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
475	CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
476	CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
477	CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
478	CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
479	CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
480	CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
481	CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
482	CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
483	CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
484	CALL xios_set_field_attr('flx_apinen' ,enabled=.FALSE.)
485	CALL xios_set_field_attr('flx_bpinen' ,enabled=.FALSE.)
486	CALL xios_set_field_attr('flx_limonen' ,enabled=.FALSE.)
487	CALL xios_set_field_attr('flx_myrcen' ,enabled=.FALSE.)
488	CALL xios_set_field_attr('flx_sabinen' ,enabled=.FALSE.)
489	CALL xios_set_field_attr('flx_camphen' ,enabled=.FALSE.)
490	CALL xios_set_field_attr('flx_3caren' ,enabled=.FALSE.)
491	CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
492	CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
493	CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
494	CALL xios_set_field_attr("CRF",enabled=.FALSE.)
495	CALL xios_set_field_attr("fco2",enabled=.FALSE.)
496	END IF
497
498	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
499	CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
500	CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
501	END IF
502
503	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
504	CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
505	CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
506	END IF
507
508	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
509	CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
510	CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
511	CALL xios_set_field_attr("laisun",enabled=.FALSE.)
512	CALL xios_set_field_attr("laish",enabled=.FALSE.)
513	END IF
514
515	IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
516	CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
517	END IF
518
519	IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
520	CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
521	CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
522	END IF
523
524	! Set record_offset for enable start in the middle of the year.
525	! julian_diff is the day of the year where the current run start
526	IF (printlev>=3) WRITE(numout,*) 'In xios_orchidee_init, julian_diff, INT(julian_diff) =', &
527	julian_diff, INT(julian_diff)
528
529	IF (ok_nudge_mc .AND. nudge_interpol_with_xios) THEN
530	! Activate the input file with id="nudge_moistc" specified in file_def_orchidee.xml.
531	! The nudging file should be called nudge_moistc.nc (see name in the xml file) and is
532	! supposed to contain daily values for the full year for the variable moistc.
533	CALL xios_set_file_attr("nudge_moistc",enabled=.TRUE.)
534	! Set record_offset to start read at correct day in the nudging file.
535	CALL xios_set_file_attr("nudge_moistc",record_offset=INT(julian_diff))
536	ELSE
537	! Deactivate input file for nudging of soil moisture
538	CALL xios_set_file_attr("nudge_moistc",enabled=.FALSE.)
539	! Deactivate variables related to soil moisture nudgnig
540	CALL xios_set_field_attr("mask_moistc_interp",enabled=.FALSE.)
541	CALL xios_set_field_attr("moistc_interp",enabled=.FALSE.)
542
543	! Deactivate output variables related to soil moisture nudging
544	CALL xios_set_field_attr("mc_read_current",enabled=.FALSE.)
545	CALL xios_set_field_attr("mc_read_prev",enabled=.FALSE.)
546	CALL xios_set_field_attr("mc_read_next",enabled=.FALSE.)
547	CALL xios_set_field_attr("mask_mc_interp_out",enabled=.FALSE.)
548	END IF
549	IF (.NOT. ok_nudge_mc ) CALL xios_set_field_attr("nudgincsm",enabled=.FALSE.)
550
551	IF (ok_nudge_snow .AND. nudge_interpol_with_xios) THEN
552	! Activate the input file with id="nudge_snow" specified in file_def_orchidee.xml.
553	! The nudging file should be called nudge_snow.nc (see name in the xml file) and is
554	! supposed to contain daily values for the full year for the variables snowdz, snowtemp and snowrho.
555	CALL xios_set_file_attr("nudge_snow",enabled=.TRUE.)
556	! Set record_offset to start read at correct day in the nudging file.
557	CALL xios_set_file_attr("nudge_snow",record_offset=INT(julian_diff))
558	ELSE
559	! Deactivate input file for nudging of snow variables
560	CALL xios_set_file_attr("nudge_snow",enabled=.FALSE.)
561
562	! Deactivate input variables related to snow nudging
563	CALL xios_set_field_attr("mask_snow_interp",enabled=.FALSE.)
564	CALL xios_set_field_attr("snowdz_interp",enabled=.FALSE.)
565	CALL xios_set_field_attr("snowrho_interp",enabled=.FALSE.)
566	CALL xios_set_field_attr("snowtemp_interp",enabled=.FALSE.)
567
568	! Deactivate output variables related to snow nudging
569	CALL xios_set_field_attr("snowdz_read_current",enabled=.FALSE.)
570	CALL xios_set_field_attr("snowdz_read_prev",enabled=.FALSE.)
571	CALL xios_set_field_attr("snowdz_read_next",enabled=.FALSE.)
572	CALL xios_set_field_attr("snowrho_read_current",enabled=.FALSE.)
573	CALL xios_set_field_attr("snowrho_read_prev",enabled=.FALSE.)
574	CALL xios_set_field_attr("snowrho_read_next",enabled=.FALSE.)
575	CALL xios_set_field_attr("snowtemp_read_current",enabled=.FALSE.)
576	CALL xios_set_field_attr("snowtemp_read_prev",enabled=.FALSE.)
577	CALL xios_set_field_attr("snowtemp_read_next",enabled=.FALSE.)
578	CALL xios_set_field_attr("mask_snow_interp_out",enabled=.FALSE.)
579	END IF
580	IF (.NOT. ok_nudge_snow) CALL xios_set_field_attr("nudgincswe",enabled=.FALSE.)
581
582	IF (impaze) THEN
583	CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
584	CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
585	CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
586	CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
587	END IF
588
589	IF (.NOT. do_wood_harvest) THEN
590	CALL xios_set_field_attr("PROD10_HARVEST",enabled=.FALSE.)
591	CALL xios_set_field_attr("FLUX10_HARVEST",enabled=.FALSE.)
592	CALL xios_set_field_attr("PROD100_HARVEST",enabled=.FALSE.)
593	CALL xios_set_field_attr("FLUX100_HARVEST",enabled=.FALSE.)
594	CALL xios_set_field_attr("CONVFLUX_HARVEST",enabled=.FALSE.)
595	CALL xios_set_field_attr("CFLUX_PROD10_HARVEST",enabled=.FALSE.)
596	CALL xios_set_field_attr("CFLUX_PROD100_HARVEST",enabled=.FALSE.)
597	CALL xios_set_field_attr("WOOD_HARVEST",enabled=.FALSE.)
598	CALL xios_set_field_attr("WOOD_HARVEST_PFT",enabled=.FALSE.)
599	END IF
600
601
602	IF (grid_type==unstructured) THEN
603	CALL xios_set_field_attr('RESOLUTION_X',enabled=.FALSE.)
604	CALL xios_set_field_attr('RESOLUTION_Y',enabled=.FALSE.)
605	END IF
606	#endif
607	END IF
608
609	IF (xios_orchidee_ok) THEN
610	! Send variables to all OMP thredds
611	CALL bcast(xios_default_val)
612	CALL bcast(almaoutput)
613	END IF
614
615	IF (printlev>=3) WRITE(numout,*) 'End xios_orchidee_init'
616	END SUBROUTINE xios_orchidee_init
617
618
619	SUBROUTINE xios_orchidee_close_definition
620
621	IF (printlev >=4) WRITE(numout,*) 'Start xios_orchidee_close_definition'
622	IF (xios_orchidee_ok .AND. is_omp_root) THEN
623	#ifdef XIOS
624
625	!
626	!! 6. Close context
627	!
628	CALL xios_close_context_definition()
629	WRITE(numout,*) 'Done xios_orchidee_close_context'
630
631	!
632	!! 7. Activate almaoutput if needed
633	!! Some extra calculations have to be done for the variables
634	!! delsoilmoist, delintercept, delswe and soilwet.
635	!! Set almaoutput=true if at least one of these variables are defined in an output file.
636	!! If not, keep the initial value of almaoutput.
637	IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
638	xios_field_is_active("delswe") .OR. xios_field_is_active("soilwet") .OR. &
639	xios_field_is_active("twbr")) THEN
640
641	almaoutput=.TRUE.
642	IF (printlev >=3) WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
643	END IF
644	#endif
645	END IF
646
647	IF (xios_orchidee_ok) THEN
648	! Send variables to all OMP thredds
649	CALL bcast(xios_default_val)
650	CALL bcast(almaoutput)
651	END IF
652	IF (printlev >=4) WRITE(numout,*) 'End xios_orchidee_close_definition'
653	END SUBROUTINE xios_orchidee_close_definition
654
655
656
657	!! ==============================================================================================================================
658	!! SUBROUTINE : xios_orchidee_change_context
659	!!
660	!>\BRIEF Use this subroutine to switch between different context.
661	!! This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
662	!! begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
663	!!
664	!! DESCRIPTION :\n
665	!!
666	!! \n
667	!_ ================================================================================================================================
668	SUBROUTINE xios_orchidee_change_context(new_context)
669	!
670	!! 0. Variable and parameter declaration
671	!
672	!! Input variable
673	CHARACTER(LEN=*),INTENT(IN) :: new_context
674
675	!! Local variables
676	#ifdef XIOS
677	TYPE(xios_context) :: ctx_hdl
678	#endif
679	!_ ================================================================================================================================
680
681	IF (xios_orchidee_ok .AND. is_omp_root) THEN
682	#ifdef XIOS
683	CALL xios_get_handle(new_context,ctx_hdl)
684	CALL xios_set_current_context(ctx_hdl)
685	#endif
686	END IF
687
688	END SUBROUTINE xios_orchidee_change_context
689
690	!!
691	!! ==============================================================================================================================
692	!! SUBROUTINE : xios_orchidee_addaxis
693	!!
694	!>\BRIEF Use this subroutine to add axes, needed for nbasmon and nbasmax in routing_highres.f90
695	!!
696	!!
697	!! DESCRIPTION :\n
698	!!
699	!! \n
700	!_ ================================================================================================================================
701	SUBROUTINE xios_orchidee_addaxis(axname, axlen, axval)
702	!
703	! INPUT variables
704	CHARACTER(LEN=*), INTENT(IN) :: axname
705	INTEGER(i_std), INTENT(IN) :: axlen
706	REAL(r_std), DIMENSION(axlen), INTENT(IN) :: axval
707	!
708	IF (xios_orchidee_ok .AND. is_omp_root) THEN
709	CALL xios_set_axis_attr(axname, n_glo=axlen, VALUE=axval)
710	ENDIF
711	!
712	END SUBROUTINE xios_orchidee_addaxis
713	!!
714
715
716	!! ==============================================================================================================================
717	!! SUBROUTINE : xios_orchidee_update_calendar
718	!!
719	!>\BRIEF Update the calandar in XIOS.
720	!!
721	!! DESCRIPTION :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
722	!! This subroutine should be called in the beginning of each time-step. The first
723	!! time-step in a new execution should always start at 1. Therefore, first calculate
724	!! an offset that is substracted to the current time step in sechiba.
725	!!
726	!! \n
727	!_ ================================================================================================================================
728	SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
729	!
730	!! 0. Variable and parameter declaration
731	!
732	!! 0.1 Input variables
733	!
734	INTEGER(i_std), INTENT(IN) :: itau_sechiba !! Current time step of the model
735	!
736	!! 0.2 Local variables
737	!
738	LOGICAL, SAVE :: first=.TRUE. !! Flag for first entering in subroutine
739	INTEGER(i_std), SAVE :: offset !! Offset to substract from itau_sechiba
740	INTEGER(i_std) :: itau_xios !! Current time step for XIOS
741
742	!_ ================================================================================================================================
743
744	IF (xios_orchidee_ok .AND. is_omp_root) THEN
745	#ifdef XIOS
746	! Calculate the offset
747	IF (first) THEN
748	offset=itau_sechiba-1
749	first=.FALSE.
750	END IF
751
752	! Substract the offset to the current time step in sechiba
753	itau_xios=itau_sechiba-offset
754
755	! Send the new time step to XIOS
756	IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
757	CALL xios_update_calendar(itau_xios)
758	#endif
759	END IF
760	END SUBROUTINE xios_orchidee_update_calendar
761	!! ==============================================================================================================================
762	!! SUBROUTINE : xios_orchidee_context_finalize
763	!!
764	!>\BRIEF Finalize orchidee context.
765	!!
766	!! DESCRIPTION :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
767	!! modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
768	!! coupeld mode.
769	!!
770	!! \n
771	!_ ================================================================================================================================
772	SUBROUTINE xios_orchidee_context_finalize
773
774	!_ ================================================================================================================================
775
776	IF (xios_orchidee_ok .AND. is_omp_root) THEN
777	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
778	#ifdef XIOS
779	CALL xios_context_finalize()
780	#endif
781	END IF
782	END SUBROUTINE xios_orchidee_context_finalize
783
784
785	!! ==============================================================================================================================
786	!! SUBROUTINE : xios_orchidee_finalize
787	!!
788	!>\BRIEF Last call to XIOS for finalization.
789	!!
790	!! DESCRIPTION :\n Last call to XIOS for finalization of the orchidee context and XIOS.
791	!! This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
792	!! model that finalizes XIOS. In that case, the context orchidee must be finalized using the
793	!! subroutine xios_orchidee_context_finalize
794	!!
795	!! \n
796	!_ ================================================================================================================================
797	SUBROUTINE xios_orchidee_finalize
798
799	!_ ================================================================================================================================
800
801	IF (xios_orchidee_ok .AND. is_omp_root) THEN
802	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
803	#ifdef XIOS
804	CALL xios_context_finalize()
805	CALL xios_finalize()
806	#endif
807	END IF
808	END SUBROUTINE xios_orchidee_finalize
809
810
811	!! ==============================================================================================================================
812	!! SUBROUTINE : xios_orchidee_send_field_r1d
813	!!
814	!>\BRIEF Subroutine for sending 1D (array) fields to XIOS.
815	!!
816	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 1D fields (array).
817	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
818	!!
819	!! \n
820	!_ ================================================================================================================================
821	SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
822	!
823	!! 0. Variable and parameter declaration
824	!
825	!! 0.1 Input variables
826	!
827	CHARACTER(len=*), INTENT(IN) :: field_id
828	REAL(r_std), DIMENSION(:), INTENT(IN) :: field
829
830	!! 0.2 Local variables
831	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
832
833	!_ ================================================================================================================================
834	IF (xios_orchidee_ok) THEN
835	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
836
837	! Gather all omp domains on the mpi domains
838	CALL gather_omp(field, field_mpi)
839
840	! All master threads send the field to XIOS
841	IF (is_omp_root) THEN
842	#ifdef XIOS
843	CALL xios_send_field(field_id,field_mpi)
844	#endif
845	END IF
846	END IF
847	END SUBROUTINE xios_orchidee_send_field_r1d
848
849
850	!! ==============================================================================================================================
851	!! SUBROUTINE : xios_orchidee_send_field_r2d
852	!!
853	!>\BRIEF Subroutine for sending 2D fields to XIOS.
854	!!
855	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 2D fields.
856	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
857	!!
858	!! \n
859	!_ ================================================================================================================================
860	SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
861	!
862	!! 0. Variable and parameter declaration
863	!
864	!! 0.1 Input variables
865	!
866	CHARACTER(len=*), INTENT(IN) :: field_id
867	REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
868
869	!! 0.2 Local variables
870	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
871
872	!_ ================================================================================================================================
873	IF (xios_orchidee_ok) THEN
874	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
875
876	! Gather all omp domains on the mpi domains
877	CALL gather_omp(field, field_mpi)
878
879	! All master threads send the field to XIOS
880	IF (is_omp_root) THEN
881	#ifdef XIOS
882	CALL xios_send_field(field_id,field_mpi)
883	#endif
884	END IF
885	END IF
886	END SUBROUTINE xios_orchidee_send_field_r2d
887
888
889	!! ==============================================================================================================================
890	!! SUBROUTINE : xios_orchidee_send_field_r3d
891	!!
892	!>\BRIEF Subroutine for sending 3D fields to XIOS.
893	!!
894	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 3D fields.
895	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
896	!!
897	!! \n
898	!_ ================================================================================================================================
899	SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
900	!
901	!! 0. Variable and parameter declaration
902	!
903	!! 0.1 Input variables
904	!
905	CHARACTER(len=*), INTENT(IN) :: field_id
906	REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
907
908	!! 0.2 Local variables
909	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
910
911	!_ ================================================================================================================================
912	IF (xios_orchidee_ok) THEN
913	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
914
915	! Gather all omp domains on the mpi domains
916	CALL gather_omp(field, field_mpi)
917
918	! All master threads send the field to XIOS
919	IF (is_omp_root) THEN
920	#ifdef XIOS
921	CALL xios_send_field(field_id,field_mpi)
922	#endif
923	END IF
924	END IF
925	END SUBROUTINE xios_orchidee_send_field_r3d
926
927	!! ==============================================================================================================================
928	!! SUBROUTINE : xios_orchidee_send_field_r4d
929	!!
930	!>\BRIEF Subroutine for sending 4D fields to XIOS.
931	!!
932	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 4D fields.
933	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
934	!!
935	!! \n
936	!_ ================================================================================================================================
937	SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
938	!
939	!! 0. Variable and parameter declaration
940	!
941	!! 0.1 Input variables
942	!
943	CHARACTER(len=*), INTENT(IN) :: field_id
944	REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
945
946	!! 0.2 Local variables
947	INTEGER :: jv
948	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
949
950	!_ ================================================================================================================================
951	IF (xios_orchidee_ok) THEN
952	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
953
954	! Gather all omp domains on the mpi domains
955	CALL gather_omp(field, field_mpi)
956
957	! All master threads send the field to XIOS
958	IF (is_omp_root) THEN
959	#ifdef XIOS
960	CALL xios_send_field(field_id,field_mpi)
961	#endif
962	END IF
963	END IF
964	END SUBROUTINE xios_orchidee_send_field_r4d
965
966	!! ==============================================================================================================================
967	!! SUBROUTINE : xios_orchidee_send_field_r5d
968	!!
969	!>\BRIEF Subroutine for sending 5D fields to XIOS.
970	!!
971	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 5D fields.
972	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
973	!!
974	!! \n
975	!_ ================================================================================================================================
976	SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
977	!
978	!! 0. Variable and parameter declaration
979	!
980	!! 0.1 Input variables
981	!
982	CHARACTER(len=*), INTENT(IN) :: field_id
983	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
984
985	!! 0.2 Local variables
986	INTEGER :: jv
987	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
988
989	!_ ================================================================================================================================
990	IF (xios_orchidee_ok) THEN
991	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
992
993	! Gather all omp domains on the mpi domains
994	CALL gather_omp(field, field_mpi)
995
996	! All master threads send the field to XIOS
997	IF (is_omp_root) THEN
998	#ifdef XIOS
999	CALL xios_send_field(field_id,field_mpi)
1000	#endif
1001	END IF
1002	END IF
1003	END SUBROUTINE xios_orchidee_send_field_r5d
1004
1005	!! ==============================================================================================================================
1006	!! SUBROUTINE : xios_orchidee_recv_field_r2d
1007	!!
1008	!>\BRIEF Subroutine for receiving 1D (kjpindex) fields to XIOS.
1009	!!
1010	!! DESCRIPTION :\n
1011	!!
1012	!! \n
1013	!_ ================================================================================================================================
1014	SUBROUTINE xios_orchidee_recv_field_r1d(field_id,field)
1015	!
1016	!! 0. Variable and parameter declaration
1017	!
1018	!! 0.1 Input variables
1019	!
1020	CHARACTER(len=*), INTENT(IN) :: field_id
1021
1022	!! 0.2 Output variables
1023	REAL(r_std), DIMENSION(:), INTENT(OUT) :: field
1024
1025	!! 0.2 Local variables
1026	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
1027
1028	!_ ================================================================================================================================
1029	IF (xios_orchidee_ok) THEN
1030	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r1d, field_id=',field_id
1031
1032	! All master threads receive the field from XIOS
1033	IF (is_omp_root) THEN
1034	#ifdef XIOS
1035	CALL xios_recv_field(field_id,field_mpi)
1036	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r1d, field_id=',field_id
1037	#endif
1038	END IF
1039
1040	! Scatter the mpi domains on local omp domains
1041	CALL scatter_omp(field_mpi, field)
1042
1043	END IF
1044	END SUBROUTINE xios_orchidee_recv_field_r1d
1045
1046	!! ==============================================================================================================================
1047	!! SUBROUTINE : xios_orchidee_recv_field_r2d
1048	!!
1049	!>\BRIEF Subroutine for receiving 2D(kjpindex and 1 vertical axe) fields to XIOS.
1050	!!
1051	!! DESCRIPTION :\n
1052	!!
1053	!! \n
1054	!_ ================================================================================================================================
1055	SUBROUTINE xios_orchidee_recv_field_r2d(field_id,field)
1056	!
1057	!! 0. Variable and parameter declaration
1058	!
1059	!! 0.1 Input variables
1060	!
1061	CHARACTER(len=*), INTENT(IN) :: field_id
1062
1063	!! 0.2 Output variables
1064	REAL(r_std), DIMENSION(:,:), INTENT(OUT) :: field
1065
1066	!! 0.2 Local variables
1067	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
1068
1069	!_ ================================================================================================================================
1070	IF (xios_orchidee_ok) THEN
1071	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r2d, field_id=',field_id
1072
1073	! All master threads recieve the field from XIOS
1074	IF (is_omp_root) THEN
1075	#ifdef XIOS
1076	CALL xios_recv_field(field_id,field_mpi)
1077	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r2d, field_id=',field_id
1078	#endif
1079	END IF
1080
1081	! Scatter the mpi domains on local omp domains
1082	CALL scatter_omp(field_mpi, field)
1083
1084	END IF
1085	END SUBROUTINE xios_orchidee_recv_field_r2d
1086
1087	!! ==============================================================================================================================
1088	!! SUBROUTINE : xios_orchidee_recv_field_r3d
1089	!!
1090	!>\BRIEF Subroutine for receiving 3D(kjpindex and 2 vertical axes) fields to XIOS.
1091	!!
1092	!! DESCRIPTION :\n
1093	!!
1094	!! \n
1095	!_ ================================================================================================================================
1096	SUBROUTINE xios_orchidee_recv_field_r3d(field_id,field)
1097	!
1098	!! 0. Variable and parameter declaration
1099	!
1100	!! 0.1 Input variables
1101	!
1102	CHARACTER(len=*), INTENT(IN) :: field_id
1103
1104	!! 0.2 Output variables
1105	REAL(r_std), DIMENSION(:,:,:), INTENT(OUT) :: field
1106
1107	!! 0.2 Local variables
1108	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
1109
1110	!_ ================================================================================================================================
1111	IF (xios_orchidee_ok) THEN
1112	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r3d, field_id=',field_id
1113
1114	! All master threads receive the field from XIOS
1115	IF (is_omp_root) THEN
1116	#ifdef XIOS
1117	CALL xios_recv_field(field_id,field_mpi)
1118	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r3d, field_id=',field_id
1119	#endif
1120	END IF
1121
1122	! Scatter the mpi domains on local omp domains
1123	CALL scatter_omp(field_mpi, field)
1124
1125	END IF
1126	END SUBROUTINE xios_orchidee_recv_field_r3d
1127
1128
1129
1130	SUBROUTINE xios_orchidee_set_file_attr(attr, name, enabled)
1131	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1132	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1133	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1134
1135	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1136
1137	#ifdef XIOS
1138	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1139	CALL xios_set_file_attr(attr, name=name, enabled=enabled)
1140	ELSE IF (PRESENT(name)) THEN
1141	CALL xios_set_file_attr(attr, name=name)
1142	ELSE IF (PRESENT(enabled)) THEN
1143	CALL xios_set_file_attr(attr, enabled=enabled)
1144	ELSE
1145	CALL xios_set_file_attr(attr)
1146	END IF
1147	#endif
1148
1149	END IF
1150
1151	END SUBROUTINE xios_orchidee_set_file_attr
1152
1153	SUBROUTINE xios_orchidee_set_field_attr(attr,name, enabled)
1154	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1155	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1156	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1157
1158	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1159
1160	#ifdef XIOS
1161	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1162	CALL xios_set_field_attr(attr, name=name, enabled=enabled)
1163	ELSE IF (PRESENT(name)) THEN
1164	CALL xios_set_field_attr(attr, name=name)
1165	ELSE IF (PRESENT(enabled)) THEN
1166	CALL xios_set_field_attr(attr, enabled=enabled)
1167	ELSE
1168	CALL xios_set_field_attr(attr)
1169	END IF
1170	#endif
1171
1172	END IF
1173
1174
1175	END SUBROUTINE xios_orchidee_set_field_attr
1176
1177	SUBROUTINE xios_orchidee_set_fieldgroup_attr(attr,name, enabled)
1178	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1179	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1180	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1181
1182	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1183
1184	#ifdef XIOS
1185	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1186	CALL xios_set_fieldgroup_attr(attr, name=name, enabled=enabled)
1187	ELSE IF (PRESENT(name)) THEN
1188	CALL xios_set_fieldgroup_attr(attr, name=name)
1189	ELSE IF (PRESENT(enabled)) THEN
1190	CALL xios_set_fieldgroup_attr(attr, enabled=enabled)
1191	ELSE
1192	CALL xios_set_fieldgroup_attr(attr)
1193	END IF
1194	#endif
1195
1196	END IF
1197
1198
1199	END SUBROUTINE xios_orchidee_set_fieldgroup_attr
1200
1201	FUNCTION xios_orchidee_setvar(varname,varvalue) RESULT (out)
1202	CHARACTER(LEN=*), INTENT(IN) :: varname ! Name of the variable
1203	REAL, INTENT(IN) :: varvalue ! Value of the variable
1204	LOGICAL :: out
1205
1206	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1207	#ifdef XIOS
1208	out=xios_setvar(varname, varvalue)
1209	#endif
1210	END IF
1211
1212	END FUNCTION xios_orchidee_setvar
1213
1214	END MODULE xios_orchidee
1215

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

Download in other formats: