Context Navigation

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

Last change on this file since 8377 was 8377, checked in by jan.polcher, 6 months ago
The modifications performed on the trunk for the coupling to WRF and the interpolation by XIOS on curviliean grids has been backported.
Property svn:keywords set to `Date Revision HeadURL`
File size: 54.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, 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	END IF
618	#endif
619	END IF
620
621	IF (xios_orchidee_ok) THEN
622	! Send variables to all OMP thredds
623	CALL bcast(xios_default_val)
624	CALL bcast(almaoutput)
625	END IF
626
627	IF (printlev>=3) WRITE(numout,*) 'End xios_orchidee_init'
628	END SUBROUTINE xios_orchidee_init
629
630
631	SUBROUTINE xios_orchidee_close_definition
632
633	IF (printlev >=4) WRITE(numout,*) 'Start xios_orchidee_close_definition'
634	IF (xios_orchidee_ok .AND. is_omp_root) THEN
635	#ifdef XIOS
636
637	!
638	!! 6. Close context
639	!
640	CALL xios_close_context_definition()
641	WRITE(numout,*) 'Done xios_orchidee_close_context'
642
643	!
644	!! 7. Activate almaoutput if needed
645	!! Some extra calculations have to be done for the variables
646	!! delsoilmoist, delintercept, delswe and soilwet.
647	!! Set almaoutput=true if at least one of these variables are defined in an output file.
648	!! If not, keep the initial value of almaoutput.
649	IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
650	xios_field_is_active("delswe") .OR. xios_field_is_active("soilwet") .OR. &
651	xios_field_is_active("twbr")) THEN
652
653	almaoutput=.TRUE.
654	IF (printlev >=3) WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
655	END IF
656	#endif
657	END IF
658
659	IF (xios_orchidee_ok) THEN
660	! Send variables to all OMP thredds
661	CALL bcast(xios_default_val)
662	CALL bcast(almaoutput)
663	END IF
664	IF (printlev >=4) WRITE(numout,*) 'End xios_orchidee_close_definition'
665	END SUBROUTINE xios_orchidee_close_definition
666
667
668
669	!! ==============================================================================================================================
670	!! SUBROUTINE : xios_orchidee_change_context
671	!!
672	!>\BRIEF Use this subroutine to switch between different context.
673	!! This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
674	!! begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
675	!!
676	!! DESCRIPTION :\n
677	!!
678	!! \n
679	!_ ================================================================================================================================
680	SUBROUTINE xios_orchidee_change_context(new_context)
681	!
682	!! 0. Variable and parameter declaration
683	!
684	!! Input variable
685	CHARACTER(LEN=*),INTENT(IN) :: new_context
686
687	!! Local variables
688	#ifdef XIOS
689	TYPE(xios_context) :: ctx_hdl
690	#endif
691	!_ ================================================================================================================================
692
693	IF (xios_orchidee_ok .AND. is_omp_root) THEN
694	#ifdef XIOS
695	CALL xios_get_handle(new_context,ctx_hdl)
696	CALL xios_set_current_context(ctx_hdl)
697	#endif
698	END IF
699
700	END SUBROUTINE xios_orchidee_change_context
701
702	!!
703	!! ==============================================================================================================================
704	!! SUBROUTINE : xios_orchidee_addaxis
705	!!
706	!>\BRIEF Use this subroutine to add axes, needed for nbasmon and nbasmax in routing_highres.f90
707	!!
708	!!
709	!! DESCRIPTION :\n
710	!!
711	!! \n
712	!_ ================================================================================================================================
713	SUBROUTINE xios_orchidee_addaxis(axname, axlen, axval)
714	!
715	! INPUT variables
716	CHARACTER(LEN=*), INTENT(IN) :: axname
717	INTEGER(i_std), INTENT(IN) :: axlen
718	REAL(r_std), DIMENSION(axlen), INTENT(IN) :: axval
719	!
720	IF (xios_orchidee_ok .AND. is_omp_root) THEN
721	CALL xios_set_axis_attr(axname, n_glo=axlen, VALUE=axval)
722	ENDIF
723	!
724	END SUBROUTINE xios_orchidee_addaxis
725	!!
726
727
728	!! ==============================================================================================================================
729	!! SUBROUTINE : xios_orchidee_update_calendar
730	!!
731	!>\BRIEF Update the calandar in XIOS.
732	!!
733	!! DESCRIPTION :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
734	!! This subroutine should be called in the beginning of each time-step. The first
735	!! time-step in a new execution should always start at 1. Therefore, first calculate
736	!! an offset that is substracted to the current time step in sechiba.
737	!!
738	!! \n
739	!_ ================================================================================================================================
740	SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
741	!
742	!! 0. Variable and parameter declaration
743	!
744	!! 0.1 Input variables
745	!
746	INTEGER(i_std), INTENT(IN) :: itau_sechiba !! Current time step of the model
747	!
748	!! 0.2 Local variables
749	!
750	LOGICAL, SAVE :: first=.TRUE. !! Flag for first entering in subroutine
751	INTEGER(i_std), SAVE :: offset !! Offset to substract from itau_sechiba
752	INTEGER(i_std) :: itau_xios !! Current time step for XIOS
753
754	!_ ================================================================================================================================
755
756	IF (xios_orchidee_ok .AND. is_omp_root) THEN
757	#ifdef XIOS
758	! Calculate the offset
759	IF (first) THEN
760	offset=itau_sechiba-1
761	first=.FALSE.
762	END IF
763
764	! Substract the offset to the current time step in sechiba
765	itau_xios=itau_sechiba-offset
766
767	! Send the new time step to XIOS
768	IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
769	CALL xios_update_calendar(itau_xios)
770	#endif
771	END IF
772	END SUBROUTINE xios_orchidee_update_calendar
773	!! ==============================================================================================================================
774	!! SUBROUTINE : xios_orchidee_context_finalize
775	!!
776	!>\BRIEF Finalize orchidee context.
777	!!
778	!! DESCRIPTION :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
779	!! modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
780	!! coupeld mode.
781	!!
782	!! \n
783	!_ ================================================================================================================================
784	SUBROUTINE xios_orchidee_context_finalize
785
786	!_ ================================================================================================================================
787
788	IF (xios_orchidee_ok .AND. is_omp_root) THEN
789	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
790	#ifdef XIOS
791	CALL xios_context_finalize()
792	#endif
793	END IF
794	END SUBROUTINE xios_orchidee_context_finalize
795
796
797	!! ==============================================================================================================================
798	!! SUBROUTINE : xios_orchidee_finalize
799	!!
800	!>\BRIEF Last call to XIOS for finalization.
801	!!
802	!! DESCRIPTION :\n Last call to XIOS for finalization of the orchidee context and XIOS.
803	!! This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
804	!! model that finalizes XIOS. In that case, the context orchidee must be finalized using the
805	!! subroutine xios_orchidee_context_finalize
806	!!
807	!! \n
808	!_ ================================================================================================================================
809	SUBROUTINE xios_orchidee_finalize
810
811	!_ ================================================================================================================================
812
813	IF (xios_orchidee_ok .AND. is_omp_root) THEN
814	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
815	#ifdef XIOS
816	CALL xios_context_finalize()
817	CALL xios_finalize()
818	#endif
819	END IF
820	END SUBROUTINE xios_orchidee_finalize
821
822
823	!! ==============================================================================================================================
824	!! SUBROUTINE : xios_orchidee_send_field_r1d
825	!!
826	!>\BRIEF Subroutine for sending 1D (array) fields to XIOS.
827	!!
828	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 1D fields (array).
829	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
830	!!
831	!! \n
832	!_ ================================================================================================================================
833	SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
834	!
835	!! 0. Variable and parameter declaration
836	!
837	!! 0.1 Input variables
838	!
839	CHARACTER(len=*), INTENT(IN) :: field_id
840	REAL(r_std), DIMENSION(:), INTENT(IN) :: field
841
842	!! 0.2 Local variables
843	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
844
845	!_ ================================================================================================================================
846	IF (xios_orchidee_ok) THEN
847	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
848
849	! Gather all omp domains on the mpi domains
850	CALL gather_omp(field, field_mpi)
851
852	! All master threads send the field to XIOS
853	IF (is_omp_root) THEN
854	#ifdef XIOS
855	CALL xios_send_field(field_id,field_mpi)
856	#endif
857	END IF
858	END IF
859	END SUBROUTINE xios_orchidee_send_field_r1d
860
861
862	!! ==============================================================================================================================
863	!! SUBROUTINE : xios_orchidee_send_field_r2d
864	!!
865	!>\BRIEF Subroutine for sending 2D fields to XIOS.
866	!!
867	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 2D fields.
868	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
869	!!
870	!! \n
871	!_ ================================================================================================================================
872	SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
873	!
874	!! 0. Variable and parameter declaration
875	!
876	!! 0.1 Input variables
877	!
878	CHARACTER(len=*), INTENT(IN) :: field_id
879	REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
880
881	!! 0.2 Local variables
882	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
883
884	!_ ================================================================================================================================
885	IF (xios_orchidee_ok) THEN
886	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
887
888	! Gather all omp domains on the mpi domains
889	CALL gather_omp(field, field_mpi)
890
891	! All master threads send the field to XIOS
892	IF (is_omp_root) THEN
893	#ifdef XIOS
894	CALL xios_send_field(field_id,field_mpi)
895	#endif
896	END IF
897	END IF
898	END SUBROUTINE xios_orchidee_send_field_r2d
899
900
901	!! ==============================================================================================================================
902	!! SUBROUTINE : xios_orchidee_send_field_r3d
903	!!
904	!>\BRIEF Subroutine for sending 3D fields to XIOS.
905	!!
906	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 3D fields.
907	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
908	!!
909	!! \n
910	!_ ================================================================================================================================
911	SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
912	!
913	!! 0. Variable and parameter declaration
914	!
915	!! 0.1 Input variables
916	!
917	CHARACTER(len=*), INTENT(IN) :: field_id
918	REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
919
920	!! 0.2 Local variables
921	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
922
923	!_ ================================================================================================================================
924	IF (xios_orchidee_ok) THEN
925	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
926
927	! Gather all omp domains on the mpi domains
928	CALL gather_omp(field, field_mpi)
929
930	! All master threads send the field to XIOS
931	IF (is_omp_root) THEN
932	#ifdef XIOS
933	CALL xios_send_field(field_id,field_mpi)
934	#endif
935	END IF
936	END IF
937	END SUBROUTINE xios_orchidee_send_field_r3d
938
939	!! ==============================================================================================================================
940	!! SUBROUTINE : xios_orchidee_send_field_r4d
941	!!
942	!>\BRIEF Subroutine for sending 4D fields to XIOS.
943	!!
944	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 4D fields.
945	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
946	!!
947	!! \n
948	!_ ================================================================================================================================
949	SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
950	!
951	!! 0. Variable and parameter declaration
952	!
953	!! 0.1 Input variables
954	!
955	CHARACTER(len=*), INTENT(IN) :: field_id
956	REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
957
958	!! 0.2 Local variables
959	INTEGER :: jv
960	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
961
962	!_ ================================================================================================================================
963	IF (xios_orchidee_ok) THEN
964	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
965
966	! Gather all omp domains on the mpi domains
967	CALL gather_omp(field, field_mpi)
968
969	! All master threads send the field to XIOS
970	IF (is_omp_root) THEN
971	#ifdef XIOS
972	CALL xios_send_field(field_id,field_mpi)
973	#endif
974	END IF
975	END IF
976	END SUBROUTINE xios_orchidee_send_field_r4d
977
978	!! ==============================================================================================================================
979	!! SUBROUTINE : xios_orchidee_send_field_r5d
980	!!
981	!>\BRIEF Subroutine for sending 5D fields to XIOS.
982	!!
983	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 5D fields.
984	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
985	!!
986	!! \n
987	!_ ================================================================================================================================
988	SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
989	!
990	!! 0. Variable and parameter declaration
991	!
992	!! 0.1 Input variables
993	!
994	CHARACTER(len=*), INTENT(IN) :: field_id
995	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
996
997	!! 0.2 Local variables
998	INTEGER :: jv
999	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
1000
1001	!_ ================================================================================================================================
1002	IF (xios_orchidee_ok) THEN
1003	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
1004
1005	! Gather all omp domains on the mpi domains
1006	CALL gather_omp(field, field_mpi)
1007
1008	! All master threads send the field to XIOS
1009	IF (is_omp_root) THEN
1010	#ifdef XIOS
1011	CALL xios_send_field(field_id,field_mpi)
1012	#endif
1013	END IF
1014	END IF
1015	END SUBROUTINE xios_orchidee_send_field_r5d
1016
1017	!! ==============================================================================================================================
1018	!! SUBROUTINE : xios_orchidee_recv_field_r2d
1019	!!
1020	!>\BRIEF Subroutine for receiving 1D (kjpindex) fields to XIOS.
1021	!!
1022	!! DESCRIPTION :\n
1023	!!
1024	!! \n
1025	!_ ================================================================================================================================
1026	SUBROUTINE xios_orchidee_recv_field_r1d(field_id,field)
1027	!
1028	!! 0. Variable and parameter declaration
1029	!
1030	!! 0.1 Input variables
1031	!
1032	CHARACTER(len=*), INTENT(IN) :: field_id
1033
1034	!! 0.2 Output variables
1035	REAL(r_std), DIMENSION(:), INTENT(OUT) :: field
1036
1037	!! 0.2 Local variables
1038	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
1039
1040	!_ ================================================================================================================================
1041	IF (xios_orchidee_ok) THEN
1042	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r1d, field_id=',field_id
1043
1044	! All master threads receive the field from XIOS
1045	IF (is_omp_root) THEN
1046	#ifdef XIOS
1047	CALL xios_recv_field(field_id,field_mpi)
1048	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r1d, field_id=',field_id
1049	#endif
1050	END IF
1051
1052	! Scatter the mpi domains on local omp domains
1053	CALL scatter_omp(field_mpi, field)
1054
1055	END IF
1056	END SUBROUTINE xios_orchidee_recv_field_r1d
1057
1058	!! ==============================================================================================================================
1059	!! SUBROUTINE : xios_orchidee_recv_field_r2d
1060	!!
1061	!>\BRIEF Subroutine for receiving 2D(kjpindex and 1 vertical axe) fields to XIOS.
1062	!!
1063	!! DESCRIPTION :\n
1064	!!
1065	!! \n
1066	!_ ================================================================================================================================
1067	SUBROUTINE xios_orchidee_recv_field_r2d(field_id,field)
1068	!
1069	!! 0. Variable and parameter declaration
1070	!
1071	!! 0.1 Input variables
1072	!
1073	CHARACTER(len=*), INTENT(IN) :: field_id
1074
1075	!! 0.2 Output variables
1076	REAL(r_std), DIMENSION(:,:), INTENT(OUT) :: field
1077
1078	!! 0.2 Local variables
1079	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
1080
1081	!_ ================================================================================================================================
1082	IF (xios_orchidee_ok) THEN
1083	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r2d, field_id=',field_id
1084
1085	! All master threads recieve the field from XIOS
1086	IF (is_omp_root) THEN
1087	#ifdef XIOS
1088	CALL xios_recv_field(field_id,field_mpi)
1089	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r2d, field_id=',field_id
1090	#endif
1091	END IF
1092
1093	! Scatter the mpi domains on local omp domains
1094	CALL scatter_omp(field_mpi, field)
1095
1096	END IF
1097	END SUBROUTINE xios_orchidee_recv_field_r2d
1098
1099	!! ==============================================================================================================================
1100	!! SUBROUTINE : xios_orchidee_recv_field_r3d
1101	!!
1102	!>\BRIEF Subroutine for receiving 3D(kjpindex and 2 vertical axes) fields to XIOS.
1103	!!
1104	!! DESCRIPTION :\n
1105	!!
1106	!! \n
1107	!_ ================================================================================================================================
1108	SUBROUTINE xios_orchidee_recv_field_r3d(field_id,field)
1109	!
1110	!! 0. Variable and parameter declaration
1111	!
1112	!! 0.1 Input variables
1113	!
1114	CHARACTER(len=*), INTENT(IN) :: field_id
1115
1116	!! 0.2 Output variables
1117	REAL(r_std), DIMENSION(:,:,:), INTENT(OUT) :: field
1118
1119	!! 0.2 Local variables
1120	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
1121
1122	!_ ================================================================================================================================
1123	IF (xios_orchidee_ok) THEN
1124	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r3d, field_id=',field_id
1125
1126	! All master threads receive the field from XIOS
1127	IF (is_omp_root) THEN
1128	#ifdef XIOS
1129	CALL xios_recv_field(field_id,field_mpi)
1130	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r3d, field_id=',field_id
1131	#endif
1132	END IF
1133
1134	! Scatter the mpi domains on local omp domains
1135	CALL scatter_omp(field_mpi, field)
1136
1137	END IF
1138	END SUBROUTINE xios_orchidee_recv_field_r3d
1139
1140
1141
1142	SUBROUTINE xios_orchidee_set_file_attr(attr, name, enabled)
1143	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1144	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1145	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1146
1147	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1148
1149	#ifdef XIOS
1150	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1151	CALL xios_set_file_attr(attr, name=name, enabled=enabled)
1152	ELSE IF (PRESENT(name)) THEN
1153	CALL xios_set_file_attr(attr, name=name)
1154	ELSE IF (PRESENT(enabled)) THEN
1155	CALL xios_set_file_attr(attr, enabled=enabled)
1156	ELSE
1157	CALL xios_set_file_attr(attr)
1158	END IF
1159	#endif
1160
1161	END IF
1162
1163	END SUBROUTINE xios_orchidee_set_file_attr
1164
1165	SUBROUTINE xios_orchidee_set_field_attr(attr,name, enabled)
1166	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1167	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1168	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1169
1170	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1171
1172	#ifdef XIOS
1173	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1174	CALL xios_set_field_attr(attr, name=name, enabled=enabled)
1175	ELSE IF (PRESENT(name)) THEN
1176	CALL xios_set_field_attr(attr, name=name)
1177	ELSE IF (PRESENT(enabled)) THEN
1178	CALL xios_set_field_attr(attr, enabled=enabled)
1179	ELSE
1180	CALL xios_set_field_attr(attr)
1181	END IF
1182	#endif
1183
1184	END IF
1185
1186
1187	END SUBROUTINE xios_orchidee_set_field_attr
1188
1189	SUBROUTINE xios_orchidee_set_fieldgroup_attr(attr,name, enabled)
1190	CHARACTER(LEN=*), INTENT(IN) :: attr ! Name of the attribut
1191	CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name ! New name
1192	LOGICAL, INTENT(IN), OPTIONAL :: enabled ! Flag
1193
1194	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1195
1196	#ifdef XIOS
1197	IF (PRESENT(name) .AND. PRESENT(enabled)) THEN
1198	CALL xios_set_fieldgroup_attr(attr, name=name, enabled=enabled)
1199	ELSE IF (PRESENT(name)) THEN
1200	CALL xios_set_fieldgroup_attr(attr, name=name)
1201	ELSE IF (PRESENT(enabled)) THEN
1202	CALL xios_set_fieldgroup_attr(attr, enabled=enabled)
1203	ELSE
1204	CALL xios_set_fieldgroup_attr(attr)
1205	END IF
1206	#endif
1207
1208	END IF
1209
1210
1211	END SUBROUTINE xios_orchidee_set_fieldgroup_attr
1212
1213	FUNCTION xios_orchidee_setvar(varname,varvalue) RESULT (out)
1214	CHARACTER(LEN=*), INTENT(IN) :: varname ! Name of the variable
1215	REAL, INTENT(IN) :: varvalue ! Value of the variable
1216	LOGICAL :: out
1217
1218	IF (xios_orchidee_ok .AND. is_omp_root) THEN
1219	#ifdef XIOS
1220	out=xios_setvar(varname, varvalue)
1221	#endif
1222	END IF
1223
1224	END FUNCTION xios_orchidee_setvar
1225
1226	END MODULE xios_orchidee
1227

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

Download in other formats: