Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

xios_orchidee.f90 @ 8367

Last change on this file since 8367 was 7909, checked in by josefine.ghattas, 16 months ago

Modification needed to be compatible with IOIPSL before and after revision 6272 on IOPSL/trunk : In IOIPSL, calendar attribute changed from "360d" to "360_day". Now in ORCHIDEE, check both attributes.

"360_day" is the correct attribute according to CF convention. "360d"
leads to an error when opening a history file with xarray.

Property svn:keywords set to Date Revision HeadURL

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

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

Context Navigation

source: branches/ORCHIDEE_3_CMIP6/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 8367

Download in other formats: