Context Navigation

source: branches/publications/ORCHIDEE_2.0_gmd_Africa/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 7346

Last change on this file since 7346 was 5451, checked in by josefine.ghattas, 6 years ago
Intergration of changeset [5450] done on the trunk: changes for the soil moisture nudging needed for LS3MIP. Now the soil moisture nudging is done in hydrol_soil after mc has been calculated instead of in the beginning of hydrol_main. No changes without nudging activated.
Property svn:keywords set to `Date Revision HeadURL`
File size: 47.3 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 time, ONLY : dt_sechiba
51	USE constantes_soil_var, ONLY : nstm, check_waterbal, diaglev, check_cwrr2, ok_freeze_cwrr
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	USE grid_var, ONLY : GridType
58
59	IMPLICIT NONE
60	PRIVATE
61	PUBLIC :: xios_orchidee_comm_init, xios_orchidee_init, xios_orchidee_change_context, &
62	xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
63	xios_orchidee_send_field, xios_orchidee_recv_field
64
65	!
66	!! Declaration of public variables
67	!
68	LOGICAL, PUBLIC, SAVE :: xios_orchidee_ok=.TRUE. !! Use XIOS for diagnostic files
69	!$OMP THREADPRIVATE(xios_orchidee_ok)
70	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.
71	!$OMP THREADPRIVATE(xios_default_val)
72
73	!
74	!! Declaration of internal variables
75	!
76	#ifdef XIOS
77	TYPE(xios_context) :: ctx_hdl_orchidee !! Handel for ORCHIDEE
78	!$OMP THREADPRIVATE(ctx_hdl_orchidee)
79	#endif
80	CHARACTER(len=*),PARAMETER :: id="client" !! Id for initialization of ORCHIDEE in XIOS
81
82
83
84	!! ==============================================================================================================================
85	!! INTERFACE : xios_orchidee_send_field
86	!!
87	!>\BRIEF Send a field to XIOS.
88	!!
89	!! DESCRIPTION :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
90	!! This interface should be called at each time-step for each output varaiables.
91	!!
92	!! \n
93	!_ ================================================================================================================================
94	INTERFACE xios_orchidee_send_field
95	MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d, &
96	xios_orchidee_send_field_r4d, xios_orchidee_send_field_r5d
97	END INTERFACE
98
99	INTERFACE xios_orchidee_recv_field
100	MODULE PROCEDURE xios_orchidee_recv_field_r1d, xios_orchidee_recv_field_r2d, xios_orchidee_recv_field_r3d
101	END INTERFACE
102
103
104	CONTAINS
105	!! ==============================================================================================================================
106	!! SUBROUTINE : xios_orchidee_comm_init
107	!!
108	!>\BRIEF Get the MPI communicator.
109	!!
110	!! DESCRIPTION :\n First call to XIOS to get the MPI communicator.
111	!! Note that it is XIOS that initialize the MPI communicator.
112	!! This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the
113	!! atmospheric model must initlialize XIOS at the same time as initializing MPI.
114	!! \n
115	!_ ================================================================================================================================
116	SUBROUTINE xios_orchidee_comm_init(comm_local)
117	!
118	!! 0. Variable and parameter declaration
119	!
120	!! Output variables
121	INTEGER, INTENT(OUT) :: comm_local
122
123	!_ ================================================================================================================================
124
125	IF (is_omp_root) THEN
126	#ifdef XIOS
127	CALL xios_initialize(id,return_comm=comm_local)
128	#else
129	CALL ipslerr_p(3, 'xios_orchidee_comm_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS', &
130	'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def','')
131	#endif
132	END IF
133	END SUBROUTINE xios_orchidee_comm_init
134
135
136	!! ==============================================================================================================================
137	!! SUBROUTINE : xios_orchidee_init
138	!!
139	!>\BRIEF Initialize variables needed for use of XIOS.
140	!!
141	!! DESCRIPTION :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step.
142	!!
143	!! In this subroutine also a section containg deactivation of some fields is found. The variables are
144	!! deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the
145	!! routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same
146	!! iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
147	!! is activated in the code can always be deactivated from the iodef.xml external file.
148	!!
149	!! \n
150	!_ ================================================================================================================================
151	SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH, &
152	date0, year, month, day, julian_diff, &
153	lon_mpi, lat_mpi, soilth_lev )
154
155	!
156	!! 0. Variable and parameter declaration
157	!
158	!! 0.1 Input variables
159	!
160	INTEGER(i_std), INTENT(in) :: MPI_COMM_ORCH !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
161	REAL(r_std), INTENT(in) :: date0 !! Julian day at first time step
162	INTEGER(i_std), INTENT(in) :: year, month, day !! Current date information
163	REAL(r_std), INTENT(in) :: julian_diff !! Current day in the year [1,365(366)]
164	REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in) :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
165	REAL(r_std),DIMENSION (ngrnd), INTENT(in) :: soilth_lev !! Vertical soil levels for thermal scheme (m)
166	!
167	!! 0.2 Local variables
168	!
169	#ifdef XIOS
170
171	TYPE(xios_duration) :: dtime_xios
172	TYPE(xios_date) :: start_date
173	TYPE(xios_date) :: time_origin
174	TYPE(xios_fieldgroup) :: fieldgroup_handle
175	TYPE(xios_field) :: field_handle
176	TYPE(xios_file) :: file_handle
177	#endif
178	INTEGER(i_std) :: i
179	INTEGER(i_std) :: year0, month0, day0 !! Time origin date information
180	REAL(r_std) :: sec0 !! Time origin date information
181	CHARACTER(LEN=20) :: calendar_str !! Name of current calendar
182	CHARACTER(LEN=30) :: start_str !! Current date as character string
183	CHARACTER(LEN=30) :: startorig_str !! Time origin date as character string
184	!_ ================================================================================================================================
185
186
187	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_init'
188
189	!Config Key = XIOS_ORCHIDEE_OK
190	!Config Desc = Use XIOS for writing diagnostics file
191	!Config If =
192	!Config Def = y
193	!Config Help = Compiling and linking with XIOS library is necessary.
194	!Config Units = [FLAG]
195	CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
196	IF (printlev>=1) WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
197
198	! Coherence test between flag and preprocessing key
199	#ifndef XIOS
200	IF (xios_orchidee_ok) THEN
201	CALL ipslerr_p(3,'xios_orchidee_init', 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS',&
202	'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def', '')
203	END IF
204	#endif
205
206
207	!
208	!! 1. Set date and calendar information on the format needed by XIOS
209	!
210
211	! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
212	CALL ioget_calendar(calendar_str)
213
214	IF (calendar_str == 'gregorian') THEN
215	calendar_str='gregorian'
216	ELSE IF (calendar_str == 'noleap') THEN
217	calendar_str='noleap'
218	ELSE IF (calendar_str == '360d') THEN
219	calendar_str='d360'
220	END IF
221
222	! Transform the time origin from julian days into year, month, day and seconds
223	CALL ju2ymds(date0, year0, month0, day0, sec0)
224
225
226
227	IF (xios_orchidee_ok .AND. is_omp_root) THEN
228	#ifdef XIOS
229	!
230	!! 2. Context initialization
231	!
232	CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
233	CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
234	CALL xios_set_current_context(ctx_hdl_orchidee)
235
236	!
237	!! 2. Calendar, timstep and date definition
238	!
239	dtime_xios%second=dt_sechiba
240
241	CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
242	time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
243
244	!
245	!! 3. Domain definition
246	!
247	! Global domain
248	CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
249
250	! Local MPI domain
251	IF ( GridType == "RegLonLat" ) THEN
252	CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
253	ELSE IF ( GridType == "RegXY" ) THEN
254	CALL xios_set_domain_attr("domain_landpoints",type="curvilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
255	ELSE
256	WRITE(numout,*) 'Following GridType is not supported: GridType =', GridType
257	CALL ipslerr_p(3, 'xios_orchidee_init', 'GridType not yet supported.','Problem for defining local MPI domain','')
258	ENDIF
259
260	! Define how data is stored on memory : 1D array for only continental points
261	CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
262	CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)
263
264	! Define longitudes and latitudes on local MPI domain depending on GridType
265	IF ( GridType == "RegLonLat" ) THEN
266	CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
267	ELSE IF ( GridType == "RegXY" ) THEN
268	CALL xios_set_domain_attr("domain_landpoints",lonvalue_2d=lon_mpi,latvalue_2d=lat_mpi)
269	ELSE
270	WRITE(numout,*) 'Following GridType is not supported: GridType =', GridType
271	CALL ipslerr_p(3, 'xios_orchidee_init', 'GridType not yet supported. ','Problem for defining longitudes and latitudes','')
272	ENDIF
273
274	!
275	!! 4. Axis definition
276	!
277	CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
278	CALL xios_set_axis_attr("nlut",n_glo=nlut ,VALUE=(/(REAL(i,r_std),i=1,nlut)/))
279	CALL xios_set_axis_attr("ncarb",n_glo=ncarb ,VALUE=(/(REAL(i,r_std),i=1,ncarb)/))
280	CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
281	CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=soilth_lev(:))
282	CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
283	CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
284	CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
285	CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
286	CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
287	CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
288	CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
289	CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
290	IF (ok_explicitsnow) THEN
291	CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
292	ELSE
293	CALL xios_set_axis_attr("nsnow", n_glo=1,VALUE=(/(REAL(i,r_std),i=1,1)/))
294	END IF
295
296
297	!
298	!! 5. Get the default value (missing value) used by XIOS. This value is set in field_def_orchidee.xml
299	!
300	CALL xios_get_fieldgroup_attr("field_definition", default_value=xios_default_val)
301	IF (printlev>=2) WRITE(numout,*) 'Default value read from XIOS, xios_default_val=',xios_default_val
302
303	!
304	!! 5. Deactivation of some fields if they are not calculated
305	!
306	IF ( OFF_LINE_MODE ) THEN
307	CALL xios_set_field_attr("q2m",enabled=.FALSE.)
308	CALL xios_set_field_attr("t2m",enabled=.FALSE.)
309	CALL xios_set_field_attr("riverflow_cpl",enabled=.FALSE.)
310	CALL xios_set_field_attr("coastalflow_cpl",enabled=.FALSE.)
311	END IF
312
313	IF ( .NOT. river_routing ) THEN
314	CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
315	CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
316	CALL xios_set_field_attr("riversret",enabled=.FALSE.)
317	CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
318	CALL xios_set_field_attr("fastr",enabled=.FALSE.)
319	CALL xios_set_field_attr("slowr",enabled=.FALSE.)
320	CALL xios_set_field_attr("streamr",enabled=.FALSE.)
321	CALL xios_set_field_attr("laker",enabled=.FALSE.)
322	CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
323	CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
324	CALL xios_set_field_attr("pondr",enabled=.FALSE.)
325	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
326	CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
327	CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
328	CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
329	CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
330	CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
331	CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
332	CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
333	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
334	CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
335	CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
336	CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
337	CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
338	CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
339	CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
340	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
341	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
342	CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
343	END IF
344
345
346	IF (hydrol_cwrr ) THEN
347	CALL xios_set_field_attr("dss",enabled=.FALSE.)
348	CALL xios_set_field_attr("gqsb",enabled=.FALSE.)
349	CALL xios_set_field_attr("bqsb",enabled=.FALSE.)
350	CALL xios_set_field_attr("rsol",enabled=.FALSE.)
351	ELSE
352	CALL xios_set_field_attr("frac_bare",enabled=.FALSE.)
353	CALL xios_set_field_attr("twbr",enabled=.FALSE.)
354	CALL xios_set_field_attr("nroot",enabled=.FALSE.)
355	CALL xios_set_field_attr("dlh",enabled=.FALSE.)
356	CALL xios_set_field_attr("mcs",enabled=.FALSE.)
357	CALL xios_set_field_attr("water2infilt",enabled=.FALSE.)
358	CALL xios_set_field_attr("reinf_slope",enabled=.FALSE.)
359	CALL xios_set_field_attr("evapnu_soil",enabled=.FALSE.)
360	CALL xios_set_field_attr("drainage_soil",enabled=.FALSE.)
361	CALL xios_set_field_attr("transpir_soil",enabled=.FALSE.)
362	CALL xios_set_field_attr("runoff_soil",enabled=.FALSE.)
363	CALL xios_set_field_attr("tmc",enabled=.FALSE.)
364	CALL xios_set_field_attr("njsc",enabled=.FALSE.)
365	CALL xios_set_field_attr("k_litt",enabled=.FALSE.)
366	CALL xios_set_field_attr("soilmoist",enabled=.FALSE.)
367	CALL xios_set_field_attr("mc",enabled=.FALSE.)
368	CALL xios_set_field_attr("kfact_root",enabled=.FALSE.)
369	CALL xios_set_field_attr("vegetmax_soil",enabled=.FALSE.)
370	CALL xios_set_field_attr("undermcr",enabled=.FALSE.)
371	CALL xios_set_field_attr("wtd",enabled=.FALSE.)
372	CALL xios_set_field_attr("ru_corr",enabled=.FALSE.)
373	CALL xios_set_field_attr("ru_corr2",enabled=.FALSE.)
374	CALL xios_set_field_attr("dr_corr",enabled=.FALSE.)
375	CALL xios_set_field_attr("dr_force",enabled=.FALSE.)
376	CALL xios_set_field_attr("qinfilt",enabled=.FALSE.)
377	CALL xios_set_field_attr("ru_infilt",enabled=.FALSE.)
378	! tws is defined in field_def.xml as a sum of several variables calculated only for cwrr
379	CALL xios_set_field_attr("tws",enabled=.FALSE.)
380	CALL xios_set_field_attr("mrsow",enabled=.FALSE.)
381	CALL xios_set_field_attr("ksat",enabled=.FALSE.)
382	END IF
383
384	IF (.NOT. ok_freeze_cwrr) THEN
385	CALL xios_set_field_attr("profil_froz_hydro",enabled=.FALSE.)
386	CALL xios_set_field_attr("temp_hydro",enabled=.FALSE.)
387	END IF
388
389
390	IF (.NOT. check_cwrr2) THEN
391	CALL xios_set_field_attr("check_infilt",enabled=.FALSE.)
392	CALL xios_set_field_attr("check_tr",enabled=.FALSE.)
393	CALL xios_set_field_attr("check_over",enabled=.FALSE.)
394	CALL xios_set_field_attr("check_under",enabled=.FALSE.)
395	END IF
396
397	IF ( .NOT. do_floodplains ) THEN
398	CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
399	CALL xios_set_field_attr("floodh",enabled=.FALSE.)
400	CALL xios_set_field_attr("floodout",enabled=.FALSE.)
401	END IF
402
403	! Deactivate some stomate fields.
404	! These fields were traditionally added in sechiba_history.nc output file.
405	IF ( .NOT. ok_stomate ) THEN
406	CALL xios_set_field_attr("nee",enabled=.FALSE.)
407	CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
408	CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
409	CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
410	CALL xios_set_field_attr("npp",enabled=.FALSE.)
411	END IF
412
413	IF ( .NOT. do_irrigation ) THEN
414	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
415	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
416	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
417	END IF
418
419	IF ( .NOT. ok_co2)THEN
420	CALL xios_set_field_attr("cimean",enabled=.FALSE.)
421	CALL xios_set_field_attr("cim",enabled=.FALSE.)
422	CALL xios_set_field_attr("gpp",enabled=.FALSE.)
423	CALL xios_set_field_attr("gpp_ipcc2",enabled=.FALSE.)
424	END IF
425
426	IF ( .NOT. ok_bvoc)THEN
427	CALL xios_set_field_attr("PAR",enabled=.FALSE.)
428	CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
429	CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
430	CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
431	CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
432	CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
433	CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
434	CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
435	CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
436	CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
437	CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
438	CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
439	CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
440	CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
441	CALL xios_set_field_attr('flx_apinen' ,enabled=.FALSE.)
442	CALL xios_set_field_attr('flx_bpinen' ,enabled=.FALSE.)
443	CALL xios_set_field_attr('flx_limonen' ,enabled=.FALSE.)
444	CALL xios_set_field_attr('flx_myrcen' ,enabled=.FALSE.)
445	CALL xios_set_field_attr('flx_sabinen' ,enabled=.FALSE.)
446	CALL xios_set_field_attr('flx_camphen' ,enabled=.FALSE.)
447	CALL xios_set_field_attr('flx_3caren' ,enabled=.FALSE.)
448	CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
449	CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
450	CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
451	CALL xios_set_field_attr("CRF",enabled=.FALSE.)
452	CALL xios_set_field_attr("fco2",enabled=.FALSE.)
453	END IF
454
455	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
456	CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
457	CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
458	END IF
459
460	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
461	CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
462	CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
463	END IF
464
465	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
466	CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
467	CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
468	CALL xios_set_field_attr("laisun",enabled=.FALSE.)
469	CALL xios_set_field_attr("laish",enabled=.FALSE.)
470	END IF
471
472	IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
473	CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
474	END IF
475
476	IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
477	CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
478	CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
479	END IF
480
481	! Set record_offset for enable start in the middle of the year.
482	! julian_diff is the day of the year where the current run start
483	IF (printlev>=3) WRITE(numout,*) 'In xios_orchidee_init, julian_diff, INT(julian_diff) =', &
484	julian_diff, INT(julian_diff)
485
486	IF (ok_nudge_mc .AND. nudge_interpol_with_xios) THEN
487	! Activate the input file with id="nudge_moistc" specified in file_def_orchidee.xml.
488	! The nudging file should be called nudge_moistc.nc (see name in the xml file) and is
489	! supposed to contain daily values for the full year for the variable moistc.
490	CALL xios_set_file_attr("nudge_moistc",enabled=.TRUE.)
491	! Set record_offset to start read at correct day in the nudging file.
492	CALL xios_set_file_attr("nudge_moistc",record_offset=INT(julian_diff))
493	ELSE
494	! Deactivate input file for nudging of soil moisture
495	CALL xios_set_file_attr("nudge_moistc",enabled=.FALSE.)
496	! Deactivate variables related to soil moisture nudgnig
497	CALL xios_set_field_attr("mask_moistc_interp",enabled=.FALSE.)
498	CALL xios_set_field_attr("moistc_interp",enabled=.FALSE.)
499
500	! Deactivate output variables related to soil moisture nudging
501	CALL xios_set_field_attr("mc_read_current",enabled=.FALSE.)
502	CALL xios_set_field_attr("mc_read_prev",enabled=.FALSE.)
503	CALL xios_set_field_attr("mc_read_next",enabled=.FALSE.)
504	CALL xios_set_field_attr("mask_mc_interp_out",enabled=.FALSE.)
505	END IF
506	IF(.NOT. ok_nudge_mc ) CALL xios_set_field_attr("nudgincsm",enabled=.FALSE.)
507
508	IF (ok_nudge_snow .AND. nudge_interpol_with_xios) THEN
509	! Activate the input file with id="nudge_snow" specified in file_def_orchidee.xml.
510	! The nudging file should be called nudge_snow.nc (see name in the xml file) and is
511	! supposed to contain daily values for the full year for the variables snowdz, snowtemp and snowrho.
512	CALL xios_set_file_attr("nudge_snow",enabled=.TRUE.)
513	! Set record_offset to start read at correct day in the nudging file.
514	CALL xios_set_file_attr("nudge_snow",record_offset=INT(julian_diff))
515	ELSE
516	! Deactivate input file for nudging of snow variables
517	CALL xios_set_file_attr("nudge_snow",enabled=.FALSE.)
518
519	! Deactivate input variables related to snow nudging
520	CALL xios_set_field_attr("mask_snow_interp",enabled=.FALSE.)
521	CALL xios_set_field_attr("snowdz_interp",enabled=.FALSE.)
522	CALL xios_set_field_attr("snowrho_interp",enabled=.FALSE.)
523	CALL xios_set_field_attr("snowtemp_interp",enabled=.FALSE.)
524
525	! Deactivate output variables related to snow nudging
526	CALL xios_set_field_attr("snowdz_read_current",enabled=.FALSE.)
527	CALL xios_set_field_attr("snowdz_read_prev",enabled=.FALSE.)
528	CALL xios_set_field_attr("snowdz_read_next",enabled=.FALSE.)
529	CALL xios_set_field_attr("snowrho_read_current",enabled=.FALSE.)
530	CALL xios_set_field_attr("snowrho_read_prev",enabled=.FALSE.)
531	CALL xios_set_field_attr("snowrho_read_next",enabled=.FALSE.)
532	CALL xios_set_field_attr("snowtemp_read_current",enabled=.FALSE.)
533	CALL xios_set_field_attr("snowtemp_read_prev",enabled=.FALSE.)
534	CALL xios_set_field_attr("snowtemp_read_next",enabled=.FALSE.)
535	CALL xios_set_field_attr("mask_snow_interp_out",enabled=.FALSE.)
536	END IF
537	IF(.NOT. ok_nudge_snow) CALL xios_set_field_attr("nudgincswe",enabled=.FALSE.)
538
539	IF (impaze) THEN
540	CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
541	CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
542	CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
543	CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
544	END IF
545
546	IF (ok_explicitsnow) THEN
547	! The variable fusion is not calculated for ok_explicitsnow
548	CALL xios_set_field_attr("Qf",enabled=.FALSE.)
549	ELSE
550	CALL xios_set_field_attr("pkappa_snow",enabled=.FALSE.)
551	CALL xios_set_field_attr("pcapa_snow",enabled=.FALSE.)
552	CALL xios_set_field_attr("snowliq",enabled=.FALSE.)
553	CALL xios_set_field_attr("snowrho",enabled=.FALSE.)
554	CALL xios_set_field_attr("snowheat",enabled=.FALSE.)
555	CALL xios_set_field_attr("snowgrain",enabled=.FALSE.)
556	CALL xios_set_field_attr("snowtemp",enabled=.FALSE.)
557	CALL xios_set_field_attr("snowtemp_weighted",enabled=.FALSE.)
558	END IF
559
560	IF (.NOT. do_wood_harvest) THEN
561	CALL xios_set_field_attr("PROD10_HARVEST",enabled=.FALSE.)
562	CALL xios_set_field_attr("FLUX10_HARVEST",enabled=.FALSE.)
563	CALL xios_set_field_attr("PROD100_HARVEST",enabled=.FALSE.)
564	CALL xios_set_field_attr("FLUX100_HARVEST",enabled=.FALSE.)
565	CALL xios_set_field_attr("CONVFLUX_HARVEST",enabled=.FALSE.)
566	CALL xios_set_field_attr("CFLUX_PROD10_HARVEST",enabled=.FALSE.)
567	CALL xios_set_field_attr("CFLUX_PROD100_HARVEST",enabled=.FALSE.)
568	CALL xios_set_field_attr("WOOD_HARVEST",enabled=.FALSE.)
569	CALL xios_set_field_attr("WOOD_HARVEST_PFT",enabled=.FALSE.)
570	END IF
571
572	!
573	!! 6. Close context
574	!
575	CALL xios_close_context_definition()
576
577
578	!
579	!! 7. Activate almaoutput if needed
580	!! Some extra calculations have to be done for the variables
581	!! delsoilmoist, delintercept, delswe and soilwet.
582	!! Set almaoutput=true if at least one of these variables are defined in an output file.
583	!! If not, keep the initial value of almaoutput.
584	IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
585	xios_field_is_active("delswe") .OR. xios_field_is_active("soilwet") .OR. &
586	xios_field_is_active("twbr")) THEN
587
588	almaoutput=.TRUE.
589	IF (printlev >=3) WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
590	END IF
591	#endif
592	END IF
593
594	IF (xios_orchidee_ok) THEN
595	! Send variables to all OMP thredds
596	CALL bcast(xios_default_val)
597	CALL bcast(almaoutput)
598	END IF
599
600	IF (printlev>=3) WRITE(numout,*) 'End xios_orchidee_init'
601	END SUBROUTINE xios_orchidee_init
602
603
604	!! ==============================================================================================================================
605	!! SUBROUTINE : xios_orchidee_change_context
606	!!
607	!>\BRIEF Use this subroutine to switch between different context.
608	!! This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
609	!! begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
610	!!
611	!! DESCRIPTION :\n
612	!!
613	!! \n
614	!_ ================================================================================================================================
615	SUBROUTINE xios_orchidee_change_context(new_context)
616	!
617	!! 0. Variable and parameter declaration
618	!
619	!! Input variable
620	CHARACTER(LEN=*),INTENT(IN) :: new_context
621
622	!! Local variables
623	#ifdef XIOS
624	TYPE(xios_context) :: ctx_hdl
625	#endif
626	!_ ================================================================================================================================
627
628	IF (xios_orchidee_ok .AND. is_omp_root) THEN
629	#ifdef XIOS
630	CALL xios_get_handle(new_context,ctx_hdl)
631	CALL xios_set_current_context(ctx_hdl)
632	#endif
633	END IF
634
635	END SUBROUTINE xios_orchidee_change_context
636
637	!! ==============================================================================================================================
638	!! SUBROUTINE : xios_orchidee_update_calendar
639	!!
640	!>\BRIEF Update the calandar in XIOS.
641	!!
642	!! DESCRIPTION :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
643	!! This subroutine should be called in the beginning of each time-step. The first
644	!! time-step in a new execution should always start at 1. Therefore, first calculate
645	!! an offset that is substracted to the current time step in sechiba.
646	!!
647	!! \n
648	!_ ================================================================================================================================
649	SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
650	!
651	!! 0. Variable and parameter declaration
652	!
653	!! 0.1 Input variables
654	!
655	INTEGER(i_std), INTENT(IN) :: itau_sechiba !! Current time step of the model
656	!
657	!! 0.2 Local variables
658	!
659	LOGICAL, SAVE :: first=.TRUE. !! Flag for first entering in subroutine
660	INTEGER(i_std), SAVE :: offset !! Offset to substract from itau_sechiba
661	INTEGER(i_std) :: itau_xios !! Current time step for XIOS
662
663	!_ ================================================================================================================================
664
665	IF (xios_orchidee_ok .AND. is_omp_root) THEN
666	#ifdef XIOS
667	! Calculate the offset
668	IF (first) THEN
669	offset=itau_sechiba-1
670	first=.FALSE.
671	END IF
672
673	! Substract the offset to the current time step in sechiba
674	itau_xios=itau_sechiba-offset
675
676	! Send the new time step to XIOS
677	IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
678	CALL xios_update_calendar(itau_xios)
679	#endif
680	END IF
681	END SUBROUTINE xios_orchidee_update_calendar
682	!! ==============================================================================================================================
683	!! SUBROUTINE : xios_orchidee_context_finalize
684	!!
685	!>\BRIEF Finalize orchidee context.
686	!!
687	!! DESCRIPTION :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
688	!! modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
689	!! coupeld mode.
690	!!
691	!! \n
692	!_ ================================================================================================================================
693	SUBROUTINE xios_orchidee_context_finalize
694
695	!_ ================================================================================================================================
696
697	IF (xios_orchidee_ok .AND. is_omp_root) THEN
698	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
699	#ifdef XIOS
700	CALL xios_context_finalize()
701	#endif
702	END IF
703	END SUBROUTINE xios_orchidee_context_finalize
704
705
706	!! ==============================================================================================================================
707	!! SUBROUTINE : xios_orchidee_finalize
708	!!
709	!>\BRIEF Last call to XIOS for finalization.
710	!!
711	!! DESCRIPTION :\n Last call to XIOS for finalization of the orchidee context and XIOS.
712	!! This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
713	!! model that finalizes XIOS. In that case, the context orchidee must be finalized using the
714	!! subroutine xios_orchidee_context_finalize
715	!!
716	!! \n
717	!_ ================================================================================================================================
718	SUBROUTINE xios_orchidee_finalize
719
720	!_ ================================================================================================================================
721
722	IF (xios_orchidee_ok .AND. is_omp_root) THEN
723	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
724	#ifdef XIOS
725	CALL xios_context_finalize()
726	CALL xios_finalize()
727	#endif
728	END IF
729	END SUBROUTINE xios_orchidee_finalize
730
731
732	!! ==============================================================================================================================
733	!! SUBROUTINE : xios_orchidee_send_field_r1d
734	!!
735	!>\BRIEF Subroutine for sending 1D (array) fields to XIOS.
736	!!
737	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 1D fields (array).
738	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
739	!!
740	!! \n
741	!_ ================================================================================================================================
742	SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
743	!
744	!! 0. Variable and parameter declaration
745	!
746	!! 0.1 Input variables
747	!
748	CHARACTER(len=*), INTENT(IN) :: field_id
749	REAL(r_std), DIMENSION(:), INTENT(IN) :: field
750
751	!! 0.2 Local variables
752	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
753
754	!_ ================================================================================================================================
755	IF (xios_orchidee_ok) THEN
756	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
757
758	! Gather all omp domains on the mpi domains
759	CALL gather_omp(field, field_mpi)
760
761	! All master threads send the field to XIOS
762	IF (is_omp_root) THEN
763	#ifdef XIOS
764	CALL xios_send_field(field_id,field_mpi)
765	#endif
766	END IF
767	END IF
768	END SUBROUTINE xios_orchidee_send_field_r1d
769
770
771	!! ==============================================================================================================================
772	!! SUBROUTINE : xios_orchidee_send_field_r2d
773	!!
774	!>\BRIEF Subroutine for sending 2D fields to XIOS.
775	!!
776	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 2D fields.
777	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
778	!!
779	!! \n
780	!_ ================================================================================================================================
781	SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
782	!
783	!! 0. Variable and parameter declaration
784	!
785	!! 0.1 Input variables
786	!
787	CHARACTER(len=*), INTENT(IN) :: field_id
788	REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
789
790	!! 0.2 Local variables
791	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
792
793	!_ ================================================================================================================================
794	IF (xios_orchidee_ok) THEN
795	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
796
797	! Gather all omp domains on the mpi domains
798	CALL gather_omp(field, field_mpi)
799
800	! All master threads send the field to XIOS
801	IF (is_omp_root) THEN
802	#ifdef XIOS
803	CALL xios_send_field(field_id,field_mpi)
804	#endif
805	END IF
806	END IF
807	END SUBROUTINE xios_orchidee_send_field_r2d
808
809
810	!! ==============================================================================================================================
811	!! SUBROUTINE : xios_orchidee_send_field_r3d
812	!!
813	!>\BRIEF Subroutine for sending 3D fields to XIOS.
814	!!
815	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 3D fields.
816	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
817	!!
818	!! \n
819	!_ ================================================================================================================================
820	SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
821	!
822	!! 0. Variable and parameter declaration
823	!
824	!! 0.1 Input variables
825	!
826	CHARACTER(len=*), INTENT(IN) :: field_id
827	REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
828
829	!! 0.2 Local variables
830	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
831
832	!_ ================================================================================================================================
833	IF (xios_orchidee_ok) THEN
834	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
835
836	! Gather all omp domains on the mpi domains
837	CALL gather_omp(field, field_mpi)
838
839	! All master threads send the field to XIOS
840	IF (is_omp_root) THEN
841	#ifdef XIOS
842	CALL xios_send_field(field_id,field_mpi)
843	#endif
844	END IF
845	END IF
846	END SUBROUTINE xios_orchidee_send_field_r3d
847
848	!! ==============================================================================================================================
849	!! SUBROUTINE : xios_orchidee_send_field_r4d
850	!!
851	!>\BRIEF Subroutine for sending 4D fields to XIOS.
852	!!
853	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 4D fields.
854	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
855	!!
856	!! \n
857	!_ ================================================================================================================================
858	SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
859	!
860	!! 0. Variable and parameter declaration
861	!
862	!! 0.1 Input variables
863	!
864	CHARACTER(len=*), INTENT(IN) :: field_id
865	REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
866
867	!! 0.2 Local variables
868	INTEGER :: jv
869	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
870
871	!_ ================================================================================================================================
872	IF (xios_orchidee_ok) THEN
873	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
874
875	! Gather all omp domains on the mpi domains
876	CALL gather_omp(field, field_mpi)
877
878	! All master threads send the field to XIOS
879	IF (is_omp_root) THEN
880	#ifdef XIOS
881	CALL xios_send_field(field_id,field_mpi)
882	#endif
883	END IF
884	END IF
885	END SUBROUTINE xios_orchidee_send_field_r4d
886
887	!! ==============================================================================================================================
888	!! SUBROUTINE : xios_orchidee_send_field_r5d
889	!!
890	!>\BRIEF Subroutine for sending 5D fields to XIOS.
891	!!
892	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 5D fields.
893	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
894	!!
895	!! \n
896	!_ ================================================================================================================================
897	SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
898	!
899	!! 0. Variable and parameter declaration
900	!
901	!! 0.1 Input variables
902	!
903	CHARACTER(len=*), INTENT(IN) :: field_id
904	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
905
906	!! 0.2 Local variables
907	INTEGER :: jv
908	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
909
910	!_ ================================================================================================================================
911	IF (xios_orchidee_ok) THEN
912	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
913
914	! Gather all omp domains on the mpi domains
915	CALL gather_omp(field, field_mpi)
916
917	! All master threads send the field to XIOS
918	IF (is_omp_root) THEN
919	#ifdef XIOS
920	CALL xios_send_field(field_id,field_mpi)
921	#endif
922	END IF
923	END IF
924	END SUBROUTINE xios_orchidee_send_field_r5d
925
926	!! ==============================================================================================================================
927	!! SUBROUTINE : xios_orchidee_recv_field_r2d
928	!!
929	!>\BRIEF Subroutine for receiving 1D (kjpindex) fields to XIOS.
930	!!
931	!! DESCRIPTION :\n
932	!!
933	!! \n
934	!_ ================================================================================================================================
935	SUBROUTINE xios_orchidee_recv_field_r1d(field_id,field)
936	!
937	!! 0. Variable and parameter declaration
938	!
939	!! 0.1 Input variables
940	!
941	CHARACTER(len=*), INTENT(IN) :: field_id
942
943	!! 0.2 Output variables
944	REAL(r_std), DIMENSION(:), INTENT(OUT) :: field
945
946	!! 0.2 Local variables
947	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
948
949	!_ ================================================================================================================================
950	IF (xios_orchidee_ok) THEN
951	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r1d, field_id=',field_id
952
953	! All master threads receive the field from XIOS
954	IF (is_omp_root) THEN
955	#ifdef XIOS
956	CALL xios_recv_field(field_id,field_mpi)
957	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r1d, field_id=',field_id
958	#endif
959	END IF
960
961	! Scatter the mpi domains on local omp domains
962	CALL scatter_omp(field_mpi, field)
963
964	END IF
965	END SUBROUTINE xios_orchidee_recv_field_r1d
966
967	!! ==============================================================================================================================
968	!! SUBROUTINE : xios_orchidee_recv_field_r2d
969	!!
970	!>\BRIEF Subroutine for receiving 2D(kjpindex and 1 vertical axe) fields to XIOS.
971	!!
972	!! DESCRIPTION :\n
973	!!
974	!! \n
975	!_ ================================================================================================================================
976	SUBROUTINE xios_orchidee_recv_field_r2d(field_id,field)
977	!
978	!! 0. Variable and parameter declaration
979	!
980	!! 0.1 Input variables
981	!
982	CHARACTER(len=*), INTENT(IN) :: field_id
983
984	!! 0.2 Output variables
985	REAL(r_std), DIMENSION(:,:), INTENT(OUT) :: field
986
987	!! 0.2 Local variables
988	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
989
990	!_ ================================================================================================================================
991	IF (xios_orchidee_ok) THEN
992	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r2d, field_id=',field_id
993
994	! All master threads recieve the field from XIOS
995	IF (is_omp_root) THEN
996	#ifdef XIOS
997	CALL xios_recv_field(field_id,field_mpi)
998	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r2d, field_id=',field_id
999	#endif
1000	END IF
1001
1002	! Scatter the mpi domains on local omp domains
1003	CALL scatter_omp(field_mpi, field)
1004
1005	END IF
1006	END SUBROUTINE xios_orchidee_recv_field_r2d
1007
1008	!! ==============================================================================================================================
1009	!! SUBROUTINE : xios_orchidee_recv_field_r3d
1010	!!
1011	!>\BRIEF Subroutine for receiving 3D(kjpindex and 2 vertical axes) fields to XIOS.
1012	!!
1013	!! DESCRIPTION :\n
1014	!!
1015	!! \n
1016	!_ ================================================================================================================================
1017	SUBROUTINE xios_orchidee_recv_field_r3d(field_id,field)
1018	!
1019	!! 0. Variable and parameter declaration
1020	!
1021	!! 0.1 Input variables
1022	!
1023	CHARACTER(len=*), INTENT(IN) :: field_id
1024
1025	!! 0.2 Output variables
1026	REAL(r_std), DIMENSION(:,:,:), INTENT(OUT) :: field
1027
1028	!! 0.2 Local variables
1029	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
1030
1031	!_ ================================================================================================================================
1032	IF (xios_orchidee_ok) THEN
1033	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_recv_field_r3d, field_id=',field_id
1034
1035	! All master threads receive the field from XIOS
1036	IF (is_omp_root) THEN
1037	#ifdef XIOS
1038	CALL xios_recv_field(field_id,field_mpi)
1039	IF (printlev>=5) WRITE(numout,*) 'Recieve done with xios_orchidee_recv_field_r3d, field_id=',field_id
1040	#endif
1041	END IF
1042
1043	! Scatter the mpi domains on local omp domains
1044	CALL scatter_omp(field_mpi, field)
1045
1046	END IF
1047	END SUBROUTINE xios_orchidee_recv_field_r3d
1048
1049	END MODULE xios_orchidee
1050

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

Download in other formats: