Context Navigation

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

Last change on this file since 7709 was 7709, checked in by josefine.ghattas, 2 years ago

Integrated new irrigation scheme developed by Pedro Arboleda. See ticket #857
This corresponds to revsion 7708 of version pedro.arboleda/ORCHIDEE. Following differences were made but were not made on the pedro.arboleda/ORCHIDEE :

argumet place in call to routing_wrapper_intialize changed order
lines with only change in space were not taken
some indentation changed
set irrigation output as enalbled false if not do_irrigation

Property svn:keywords set to Date Revision HeadURL

File size: 52.4 KB

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

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

Download in other formats: