Context Navigation

source: CONFIG_DEVT/LMDZOR_V6.2_work_ENSEMBLES/modeles/ORCHIDEE/src_parallel/xios_orchidee.f90 @ 5493

Last change on this file since 5493 was 5493, checked in by ymipsl, 4 years ago

Ensemble management for orchidee.

YM

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

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

Download in other formats: