Context Navigation

xios_orchidee.f90 @ 8546

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

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

Context Navigation

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

Download in other formats: