Context Navigation

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

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

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

Download in other formats: