Context Navigation

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

Last change on this file since 7265 was 7265, checked in by agnes.ducharne, 3 years ago
Integrated r5705 (solay now in meters in output files), and small changes with no impact on code (r6220, r6565, r6567) from the trunk. Checked with a 5d run.
Property svn:keywords set to `Date Revision HeadURL`
File size: 50.9 KB

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

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

Download in other formats: