Context Navigation

xios_orchidee.f90 @ 7346

Last change on this file since 7346 was 5715, checked in by daniel.goll, 5 years ago

parameter revision (biochemic. mineralisation & soil P fixation)
addit. output variable to separate litter from som fluxes.

if no surprises anymore, this revision will be CNPv1.0

DSG

Property svn:keywords set to Date Revision HeadURL

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

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

Context Navigation

source: branches/publications/ORCHIDEE-CN-P-MIMICS_r7301/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 7346

Download in other formats: