Context Navigation

source: branches/publications/ORCHIDEE_gmd-2018-261/src_parallel/xios_orchidee.f90 @ 8692

Last change on this file since 8692 was 4333, checked in by josefine.ghattas, 8 years ago
Merge with trunk for revision r3623 - r3977 Some corrections for gfortran
File size: 36.8 KB

Line
1	! ================================================================================================================================
2	! MODULE : xios_orchidee
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.fr
5	!
6	! LICENCE : IPSL (2006)
7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
8	!
9	!>\BRIEF This module contains the initialization and interface to the XIOS code.
10	!!
11	!!\n DESCRIPTION: This module contains the interface for the use of the XIOS code. All call to XIOS are done in this module.
12	!! Revision 965 of XIOS/trunk or later is needed. This version is also called XIOS2.
13	!! Older revisions and XIOS1 can not be used.
14	!!
15	!! Summury of subroutines
16	!! xios_orchidee_comm_init : First call to XIOS to get the MPI communicator
17	!! xios_orchidee_init : Initialize variables needed for use of XIOS
18	!! Deactivation of fields not calculated due specific run options
19	!! xios_orchidee_update_calendar : Update the calandar in XIOS
20	!! xios_orchidee_finalize : Last call to XIOS for finalization
21	!! xios_orchidee_send_field : Interface to send fields with 1, 2 or 3 dimensions to XIOS
22	!! xios_orchidee_send_field_r1d : Internal subroutine for 1D(array) fields
23	!! xios_orchidee_send_field_r2d : Internal subroutine for 2D fields
24	!! xios_orchidee_send_field_r3d : Internal subroutine for 3D fields
25	!!
26	!! It is only possible to use XIOS2. Note that compilation must be done with the preprocessing key XIOS
27	!! and CPP_PARA. Compiling without these keys makes it impossible to activate XIOS.
28	!! To activate running using XIOS, the flag XIOS_ORCHIDEE_OK=y must be set in run.def and the file iodef.xml must exist.
29	!!
30	!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
31	!! Removed possibility to use XIOS1, 21/10/2016
32	!!
33	!! REFERENCE(S) : None
34	!!
35	!! SVN :
36	!! $HeadURL: $
37	!! $Date: $
38	!! $Revision: $
39	!! \n
40	!_ ================================================================================================================================
41
42	MODULE xios_orchidee
43
44	#ifdef XIOS
45	USE xios
46	#endif
47	USE defprec
48	USE pft_parameters_var, ONLY : nvm
49	USE constantes_var
50	USE constantes_soil_var, ONLY : nstm, check_waterbal, diaglev, check_cwrr2, ok_freeze_cwrr
51	USE vertical_soil_var, ONLY : ngrnd, nslm, nbdl
52	USE IOIPSL, ONLY : ioget_calendar, ju2ymds
53	USE mod_orchidee_para_var
54	USE mod_orchidee_transfert_para
55	USE ioipsl_para
56
57	IMPLICIT NONE
58	PRIVATE
59	PUBLIC :: xios_orchidee_comm_init, xios_orchidee_init, xios_orchidee_change_context, &
60	xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
61	xios_orchidee_send_field
62
63	!
64	!! Declaration of public variables
65	!
66	LOGICAL, PUBLIC, SAVE :: xios_orchidee_ok=.TRUE. !! Use XIOS for diagnostic files
67	!$OMP THREADPRIVATE(xios_orchidee_ok)
68
69	!
70	!! Declaration of internal variables
71	!
72	#ifdef XIOS
73	TYPE(xios_context) :: ctx_hdl_orchidee !! Handel for ORCHIDEE
74	!$OMP THREADPRIVATE(ctx_hdl_orchidee)
75	#endif
76	CHARACTER(len=*),PARAMETER :: id="client" !! Id for initialization of ORCHIDEE in XIOS
77
78
79
80	!! ==============================================================================================================================
81	!! INTERFACE : xios_orchidee_send_field
82	!!
83	!>\BRIEF Send a field to XIOS.
84	!!
85	!! DESCRIPTION :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
86	!! This interface should be called at each time-step for each output varaiables.
87	!!
88	!! \n
89	!_ ================================================================================================================================
90	INTERFACE xios_orchidee_send_field
91	MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d, &
92	xios_orchidee_send_field_r4d, xios_orchidee_send_field_r5d
93	END INTERFACE
94
95
96	CONTAINS
97	!! ==============================================================================================================================
98	!! SUBROUTINE : xios_orchidee_comm_init
99	!!
100	!>\BRIEF Get the MPI communicator.
101	!!
102	!! DESCRIPTION :\n First call to XIOS to get the MPI communicator.
103	!! Note that it is XIOS that initialize the MPI communicator.
104	!! This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the
105	!! atmospheric model must initlialize XIOS at the same time as initializing MPI.
106	!! \n
107	!_ ================================================================================================================================
108	SUBROUTINE xios_orchidee_comm_init(comm_local)
109	!
110	!! 0. Variable and parameter declaration
111	!
112	!! Output variables
113	INTEGER, INTENT(OUT) :: comm_local
114
115	!_ ================================================================================================================================
116
117	IF (is_omp_root) THEN
118	#ifdef XIOS
119	CALL xios_initialize(id,return_comm=comm_local)
120	#else
121	! Write error messages and stop the model
122	WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
123	WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
124	WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_comm_init'
125	#ifdef CPP_PARA
126	CALL MPI_ABORT(3)
127	#endif
128	STOP 1
129	#endif
130
131	END IF
132	END SUBROUTINE xios_orchidee_comm_init
133
134
135	!! ==============================================================================================================================
136	!! SUBROUTINE : xios_orchidee_init
137	!!
138	!>\BRIEF Initialize variables needed for use of XIOS.
139	!!
140	!! DESCRIPTION :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step.
141	!!
142	!! In this subroutine also a section containg deactivation of some fields is found. The variables are
143	!! deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the
144	!! routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same
145	!! iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
146	!! is activated in the code can always be deactivated from the iodef.xml external file.
147	!!
148	!! \n
149	!_ ================================================================================================================================
150	SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH, &
151	date0, year, month, day, &
152	lon_mpi, lat_mpi, soilth_lev )
153
154	!
155	!! 0. Variable and parameter declaration
156	!
157	!! 0.1 Input variables
158	!
159	INTEGER(i_std), INTENT(in) :: MPI_COMM_ORCH !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
160	REAL(r_std), INTENT(in) :: date0 !! Julian day at first time step
161	INTEGER(i_std), INTENT(in) :: year, month, day !! Current date information
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	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	! Write error messages and stop the model
200	WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
201	WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
202	WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_init'
203	#ifdef CPP_PARA
204	CALL MPI_ABORT(3)
205	#endif
206	STOP 1
207	END IF
208	#endif
209
210
211	!
212	!! 1. Set date and calendar information on the format needed by XIOS
213	!
214
215	! Get the calendar from IOIPSL and modify the string to correspond to what XIOS expects
216	CALL ioget_calendar(calendar_str)
217
218	IF (calendar_str == 'gregorian') THEN
219	calendar_str='gregorian'
220	ELSE IF (calendar_str == 'noleap') THEN
221	calendar_str='noleap'
222	ELSE IF (calendar_str == '360d') THEN
223	calendar_str='d360'
224	END IF
225
226	! Transform the time origin from julian days into year, month, day and seconds
227	CALL ju2ymds(date0, year0, month0, day0, sec0)
228
229
230
231	IF (xios_orchidee_ok .AND. is_omp_root) THEN
232	#ifdef XIOS
233	!
234	!! 2. Context initialization
235	!
236	CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
237	CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
238	CALL xios_set_current_context(ctx_hdl_orchidee)
239
240	!
241	!! 2. Calendar, timstep and date definition
242	!
243	dtime_xios%second=dt_sechiba
244
245	CALL xios_define_calendar(type=calendar_str, start_date=xios_date(year,month,day,0,0,0), &
246	time_origin=xios_date(year0,month0,day0,0,0,0), timestep=dtime_xios)
247
248	!
249	!! 3. Domain definition
250	!
251	! Global domain
252	CALL xios_set_domain_attr("domain_landpoints", ni_glo=iim_g, nj_glo=jjm_g)
253
254	! Local MPI domain
255	CALL xios_set_domain_attr("domain_landpoints",type="rectilinear", ibegin=0, ni=iim_g, jbegin=jj_begin-1, nj=jj_nb)
256
257	! Define how data is stored on memory : 1D array for only continental points
258	CALL xios_set_domain_attr("domain_landpoints",data_dim=1, data_ibegin=0, data_ni=nbp_mpi)
259	CALL xios_set_domain_attr("domain_landpoints",data_ni=nbp_mpi, data_i_index=kindex_mpi-1)
260
261	! Define longitudes and latitudes on local MPI domain
262	CALL xios_set_domain_attr("domain_landpoints",lonvalue_1d=lon_mpi(:,1),latvalue_1d=lat_mpi(1,:))
263
264	!
265	!! 4. Axis definition
266	!
267	CALL xios_set_axis_attr("nvm",n_glo=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
268	CALL xios_set_axis_attr("nlaip1", n_glo=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
269	CALL xios_set_axis_attr("ngrnd",n_glo=ngrnd ,VALUE=soilth_lev(:))
270	CALL xios_set_axis_attr("nstm", n_glo=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
271	CALL xios_set_axis_attr("nnobio", n_glo=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
272	CALL xios_set_axis_attr("albtyp", n_glo=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
273	CALL xios_set_axis_attr("nslm", n_glo=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
274	CALL xios_set_axis_attr("nbdl", n_glo=nbdl,VALUE=diaglev(:))
275	CALL xios_set_axis_attr("P10", n_glo=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
276	CALL xios_set_axis_attr("P100", n_glo=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
277	CALL xios_set_axis_attr("P11", n_glo=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
278	CALL xios_set_axis_attr("P101", n_glo=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
279	IF (ok_explicitsnow) THEN
280	CALL xios_set_axis_attr("nsnow", n_glo=nsnow,VALUE=(/(REAL(i,r_std),i=1,nsnow)/))
281	ELSE
282	CALL xios_set_axis_attr("nsnow", n_glo=1,VALUE=(/(REAL(i,r_std),i=1,1)/))
283	END IF
284
285	!
286	!! 5. Deactivation of some fields if they are not calculated
287	!
288	IF ( OFF_LINE_MODE ) THEN
289	CALL xios_set_field_attr("q2m",enabled=.FALSE.)
290	CALL xios_set_field_attr("t2m",enabled=.FALSE.)
291	END IF
292
293	IF ( .NOT. river_routing ) THEN
294	CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
295	CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
296	CALL xios_set_field_attr("riversret",enabled=.FALSE.)
297	CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
298	CALL xios_set_field_attr("fastr",enabled=.FALSE.)
299	CALL xios_set_field_attr("slowr",enabled=.FALSE.)
300	CALL xios_set_field_attr("streamr",enabled=.FALSE.)
301	CALL xios_set_field_attr("laker",enabled=.FALSE.)
302	CALL xios_set_field_attr("lake_overflow",enabled=.FALSE.)
303	CALL xios_set_field_attr("mask_coast",enabled=.FALSE.)
304	CALL xios_set_field_attr("pondr",enabled=.FALSE.)
305	CALL xios_set_field_attr("slowflow",enabled=.FALSE.)
306	CALL xios_set_field_attr("delfastr",enabled=.FALSE.)
307	CALL xios_set_field_attr("delslowr",enabled=.FALSE.)
308	CALL xios_set_field_attr("delstreamr",enabled=.FALSE.)
309	CALL xios_set_field_attr("dellaker",enabled=.FALSE.)
310	CALL xios_set_field_attr("delpondr",enabled=.FALSE.)
311	CALL xios_set_field_attr("delfloodr",enabled=.FALSE.)
312	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
313	CALL xios_set_field_attr("swampmap",enabled=.FALSE.)
314	CALL xios_set_field_attr("wbr_stream",enabled=.FALSE.)
315	CALL xios_set_field_attr("wbr_fast",enabled=.FALSE.)
316	CALL xios_set_field_attr("wbr_slow",enabled=.FALSE.)
317	CALL xios_set_field_attr("wbr_lake",enabled=.FALSE.)
318	CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
319	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
320	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
321	CALL xios_set_field_attr("SurfStor",enabled=.FALSE.)
322	END IF
323
324
325	IF (hydrol_cwrr ) THEN
326	CALL xios_set_field_attr("dss",enabled=.FALSE.)
327	CALL xios_set_field_attr("gqsb",enabled=.FALSE.)
328	CALL xios_set_field_attr("bqsb",enabled=.FALSE.)
329	CALL xios_set_field_attr("rsol",enabled=.FALSE.)
330	ELSE
331	CALL xios_set_field_attr("frac_bare",enabled=.FALSE.)
332	CALL xios_set_field_attr("twbr",enabled=.FALSE.)
333	CALL xios_set_field_attr("nroot",enabled=.FALSE.)
334	CALL xios_set_field_attr("dh",enabled=.FALSE.)
335	CALL xios_set_field_attr("mcs",enabled=.FALSE.)
336	CALL xios_set_field_attr("water2infilt",enabled=.FALSE.)
337	CALL xios_set_field_attr("reinf_slope",enabled=.FALSE.)
338	CALL xios_set_field_attr("evapnu_soil",enabled=.FALSE.)
339	CALL xios_set_field_attr("drainage_soil",enabled=.FALSE.)
340	CALL xios_set_field_attr("transpir_soil",enabled=.FALSE.)
341	CALL xios_set_field_attr("runoff_soil",enabled=.FALSE.)
342	CALL xios_set_field_attr("tmc",enabled=.FALSE.)
343	CALL xios_set_field_attr("njsc",enabled=.FALSE.)
344	CALL xios_set_field_attr("k_litt",enabled=.FALSE.)
345	CALL xios_set_field_attr("soilmoist",enabled=.FALSE.)
346	CALL xios_set_field_attr("mc",enabled=.FALSE.)
347	CALL xios_set_field_attr("kfact_root",enabled=.FALSE.)
348	CALL xios_set_field_attr("vegetmax_soil",enabled=.FALSE.)
349	CALL xios_set_field_attr("undermcr",enabled=.FALSE.)
350	CALL xios_set_field_attr("wtd",enabled=.FALSE.)
351	CALL xios_set_field_attr("ru_corr",enabled=.FALSE.)
352	CALL xios_set_field_attr("ru_corr2",enabled=.FALSE.)
353	CALL xios_set_field_attr("dr_corr",enabled=.FALSE.)
354	CALL xios_set_field_attr("dr_force",enabled=.FALSE.)
355	CALL xios_set_field_attr("qinfilt",enabled=.FALSE.)
356	CALL xios_set_field_attr("ru_infilt",enabled=.FALSE.)
357	! tws is defined in field_def.xml as a sum of several variables cacluated only for cwrr
358	CALL xios_set_field_attr("tws",enabled=.FALSE.)
359	END IF
360
361	IF (.NOT. ok_freeze_cwrr) THEN
362	CALL xios_set_field_attr("profil_froz_hydro",enabled=.FALSE.)
363	CALL xios_set_field_attr("temp_hydro",enabled=.FALSE.)
364	CALL xios_set_field_attr("kk_moy",enabled=.FALSE.)
365	CALL xios_set_field_attr("profil_froz_hydro_ns",enabled=.FALSE.)
366	END IF
367
368
369	IF (.NOT. check_cwrr2) THEN
370	CALL xios_set_field_attr("check_infilt",enabled=.FALSE.)
371	CALL xios_set_field_attr("check_tr",enabled=.FALSE.)
372	CALL xios_set_field_attr("check_over",enabled=.FALSE.)
373	CALL xios_set_field_attr("check_under",enabled=.FALSE.)
374	END IF
375
376	IF ( .NOT. do_floodplains ) THEN
377	CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
378	CALL xios_set_field_attr("floodh",enabled=.FALSE.)
379	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
380	CALL xios_set_field_attr("floodout",enabled=.FALSE.)
381	END IF
382
383	! Deactivate some stomate fields.
384	! These fields were traditionally added in sechiba_history.nc output file.
385	IF ( .NOT. ok_stomate ) THEN
386	CALL xios_set_field_attr("nee",enabled=.FALSE.)
387	CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
388	CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
389	CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
390	CALL xios_set_field_attr("npp",enabled=.FALSE.)
391	END IF
392
393	IF ( .NOT. do_irrigation ) THEN
394	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
395	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
396	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
397	END IF
398
399	IF ( .NOT. ok_co2)THEN
400	CALL xios_set_field_attr("cimean",enabled=.FALSE.)
401	CALL xios_set_field_attr("cim",enabled=.FALSE.)
402	CALL xios_set_field_attr("gpp",enabled=.FALSE.)
403	END IF
404
405	IF ( .NOT. ok_bvoc)THEN
406	CALL xios_set_field_attr("PAR",enabled=.FALSE.)
407	CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
408	CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
409	CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
410	CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
411	CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
412	CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
413	CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
414	CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
415	CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
416	CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
417	CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
418	CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
419	CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
420	CALL xios_set_field_attr('flx_apinen' ,enabled=.FALSE.)
421	CALL xios_set_field_attr('flx_bpinen' ,enabled=.FALSE.)
422	CALL xios_set_field_attr('flx_limonen' ,enabled=.FALSE.)
423	CALL xios_set_field_attr('flx_myrcen' ,enabled=.FALSE.)
424	CALL xios_set_field_attr('flx_sabinen' ,enabled=.FALSE.)
425	CALL xios_set_field_attr('flx_camphen' ,enabled=.FALSE.)
426	CALL xios_set_field_attr('flx_3caren' ,enabled=.FALSE.)
427	CALL xios_set_field_attr('flx_tbocimen' ,enabled=.FALSE.)
428	CALL xios_set_field_attr('flx_othermono',enabled=.FALSE.)
429	CALL xios_set_field_attr('flx_sesquiter',enabled=.FALSE.)
430	CALL xios_set_field_attr("CRF",enabled=.FALSE.)
431	CALL xios_set_field_attr("fco2",enabled=.FALSE.)
432	END IF
433
434	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy ) THEN
435	CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
436	CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
437	END IF
438
439	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. .NOT. ok_multilayer ) THEN
440	CALL xios_set_field_attr( 'PARsuntab',enabled=.FALSE.)
441	CALL xios_set_field_attr( 'PARshtab' ,enabled=.FALSE.)
442	END IF
443
444	IF ( .NOT. ok_bvoc .OR. .NOT. ok_radcanopy .OR. ok_multilayer ) THEN
445	CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
446	CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
447	CALL xios_set_field_attr("laisun",enabled=.FALSE.)
448	CALL xios_set_field_attr("laish",enabled=.FALSE.)
449	END IF
450
451	IF ( .NOT. ok_bvoc .OR. .NOT. ok_bbgfertil_Nox) THEN
452	CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
453	END IF
454
455	IF ( .NOT. ok_bvoc .OR. .NOT. ok_cropsfertil_Nox) THEN
456	CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
457	CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
458	END IF
459
460	IF (.NOT. check_waterbal) THEN
461	CALL xios_set_field_attr("tot_flux",enabled=.FALSE.)
462	END IF
463
464	IF (impaze) THEN
465	CALL xios_set_field_attr("soilalb_vis",enabled=.FALSE.)
466	CALL xios_set_field_attr("soilalb_nir",enabled=.FALSE.)
467	CALL xios_set_field_attr("vegalb_vis",enabled=.FALSE.)
468	CALL xios_set_field_attr("vegalb_nir",enabled=.FALSE.)
469	END IF
470
471	IF (ok_explicitsnow) THEN
472	! The variable fusion is not calculated for ok_explicitsnow
473	CALL xios_set_field_attr("Qf",enabled=.FALSE.)
474	ELSE
475	CALL xios_set_field_attr("pkappa_snow",enabled=.FALSE.)
476	CALL xios_set_field_attr("pcapa_snow",enabled=.FALSE.)
477	CALL xios_set_field_attr("snowliq",enabled=.FALSE.)
478	CALL xios_set_field_attr("snowrho",enabled=.FALSE.)
479	CALL xios_set_field_attr("snowheat",enabled=.FALSE.)
480	CALL xios_set_field_attr("snowgrain",enabled=.FALSE.)
481	CALL xios_set_field_attr("snowtemp",enabled=.FALSE.)
482	END IF
483	!
484	!! 6. Close context
485	!
486	CALL xios_close_context_definition()
487
488
489	!
490	!! 7. Activate almaoutput if needed
491	!! Some extra calculations have to be done for the variables
492	!! delsoilmoist, delintercept, delswe and soilwet.
493	!! Set almaoutput=true if at least one of these variables are defined in an output file.
494	!! If not, keep the initial value of almaoutput.
495	IF ( xios_field_is_active("delsoilmoist") .OR. xios_field_is_active("delintercept") .OR. &
496	xios_field_is_active("delswe") .OR. xios_field_is_active("soilwet") .OR. &
497	xios_field_is_active("twbr")) THEN
498
499	almaoutput=.TRUE.
500	WRITE(numout,*) 'The flag almaoutput has been activated in xios_orchidee_init'
501	END IF
502	#endif
503	END IF
504
505	IF (xios_orchidee_ok) THEN
506	! Send variable almaoutput to all processes
507	CALL bcast(almaoutput)
508	END IF
509
510	IF (printlev>=3) WRITE(numout,*) 'Exit xios_orchidee_init'
511	END SUBROUTINE xios_orchidee_init
512
513
514	!! ==============================================================================================================================
515	!! SUBROUTINE : xios_orchidee_change_context
516	!!
517	!>\BRIEF Use this subroutine to switch between different context.
518	!! This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
519	!! begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
520	!!
521	!! DESCRIPTION :\n
522	!!
523	!! \n
524	!_ ================================================================================================================================
525	SUBROUTINE xios_orchidee_change_context(new_context)
526	!
527	!! 0. Variable and parameter declaration
528	!
529	!! Input variable
530	CHARACTER(LEN=*),INTENT(IN) :: new_context
531
532	!! Local variables
533	#ifdef XIOS
534	TYPE(xios_context) :: ctx_hdl
535	#endif
536	!_ ================================================================================================================================
537
538	IF (xios_orchidee_ok .AND. is_omp_root) THEN
539	#ifdef XIOS
540	CALL xios_get_handle(new_context,ctx_hdl)
541	CALL xios_set_current_context(ctx_hdl)
542	#endif
543	END IF
544
545	END SUBROUTINE xios_orchidee_change_context
546
547	!! ==============================================================================================================================
548	!! SUBROUTINE : xios_orchidee_update_calendar
549	!!
550	!>\BRIEF Update the calandar in XIOS.
551	!!
552	!! DESCRIPTION :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
553	!! This subroutine should be called in the beginning of each time-step. The first
554	!! time-step in a new execution should always start at 1. Therefore, first calculate
555	!! an offset that is substracted to the current time step in sechiba.
556	!!
557	!! \n
558	!_ ================================================================================================================================
559	SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
560	!
561	!! 0. Variable and parameter declaration
562	!
563	!! 0.1 Input variables
564	!
565	INTEGER(i_std), INTENT(IN) :: itau_sechiba !! Current time step of the model
566	!
567	!! 0.2 Local variables
568	!
569	LOGICAL, SAVE :: first=.TRUE. !! Flag for first entering in subroutine
570	INTEGER(i_std), SAVE :: offset !! Offset to substract from itau_sechiba
571	INTEGER(i_std) :: itau_xios !! Current time step for XIOS
572
573	!_ ================================================================================================================================
574
575	IF (xios_orchidee_ok .AND. is_omp_root) THEN
576	#ifdef XIOS
577	! Calculate the offset
578	IF (first) THEN
579	offset=itau_sechiba-1
580	first=.FALSE.
581	END IF
582
583	! Substract the offset to the current time step in sechiba
584	itau_xios=itau_sechiba-offset
585
586	! Send the new time step to XIOS
587	IF (printlev>=3) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
588	CALL xios_update_calendar(itau_xios)
589	#endif
590	END IF
591	END SUBROUTINE xios_orchidee_update_calendar
592	!! ==============================================================================================================================
593	!! SUBROUTINE : xios_orchidee_context_finalize
594	!!
595	!>\BRIEF Finalize orchidee context.
596	!!
597	!! DESCRIPTION :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
598	!! modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
599	!! coupeld mode.
600	!!
601	!! \n
602	!_ ================================================================================================================================
603	SUBROUTINE xios_orchidee_context_finalize
604
605	!_ ================================================================================================================================
606
607	IF (xios_orchidee_ok .AND. is_omp_root) THEN
608	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
609	#ifdef XIOS
610	CALL xios_context_finalize()
611	#endif
612	END IF
613	END SUBROUTINE xios_orchidee_context_finalize
614
615
616	!! ==============================================================================================================================
617	!! SUBROUTINE : xios_orchidee_finalize
618	!!
619	!>\BRIEF Last call to XIOS for finalization.
620	!!
621	!! DESCRIPTION :\n Last call to XIOS for finalization of the orchidee context and XIOS.
622	!! This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
623	!! model that finalizes XIOS. In that case, the context orchidee must be finalized using the
624	!! subroutine xios_orchidee_context_finalize
625	!!
626	!! \n
627	!_ ================================================================================================================================
628	SUBROUTINE xios_orchidee_finalize
629
630	!_ ================================================================================================================================
631
632	IF (xios_orchidee_ok .AND. is_omp_root) THEN
633	IF (printlev>=3) WRITE(numout,*) 'Entering xios_orchidee_finalize'
634	#ifdef XIOS
635	CALL xios_context_finalize()
636	CALL xios_finalize()
637	#endif
638	END IF
639	END SUBROUTINE xios_orchidee_finalize
640
641
642	!! ==============================================================================================================================
643	!! SUBROUTINE : xios_orchidee_send_field_r1d
644	!!
645	!>\BRIEF Subroutine for sending 1D (array) fields to XIOS.
646	!!
647	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 1D fields (array).
648	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
649	!!
650	!! \n
651	!_ ================================================================================================================================
652	SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
653	!
654	!! 0. Variable and parameter declaration
655	!
656	!! 0.1 Input variables
657	!
658	CHARACTER(len=*), INTENT(IN) :: field_id
659	REAL(r_std), DIMENSION(:), INTENT(IN) :: field
660
661	!! 0.2 Local variables
662	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
663
664	!_ ================================================================================================================================
665	IF (xios_orchidee_ok) THEN
666	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
667
668	! Gather all omp domains on the mpi domains
669	CALL gather_omp(field, field_mpi)
670
671	! All master threads send the field to XIOS
672	IF (is_omp_root) THEN
673	#ifdef XIOS
674	CALL xios_send_field(field_id,field_mpi)
675	#endif
676	END IF
677	END IF
678	END SUBROUTINE xios_orchidee_send_field_r1d
679
680
681	!! ==============================================================================================================================
682	!! SUBROUTINE : xios_orchidee_send_field_r2d
683	!!
684	!>\BRIEF Subroutine for sending 2D fields to XIOS.
685	!!
686	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 2D fields.
687	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
688	!!
689	!! \n
690	!_ ================================================================================================================================
691	SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
692	!
693	!! 0. Variable and parameter declaration
694	!
695	!! 0.1 Input variables
696	!
697	CHARACTER(len=*), INTENT(IN) :: field_id
698	REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
699
700	!! 0.2 Local variables
701	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
702
703	!_ ================================================================================================================================
704	IF (xios_orchidee_ok) THEN
705	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
706
707	! Gather all omp domains on the mpi domains
708	CALL gather_omp(field, field_mpi)
709
710	! All master threads send the field to XIOS
711	IF (is_omp_root) THEN
712	#ifdef XIOS
713	CALL xios_send_field(field_id,field_mpi)
714	#endif
715	END IF
716	END IF
717	END SUBROUTINE xios_orchidee_send_field_r2d
718
719
720	!! ==============================================================================================================================
721	!! SUBROUTINE : xios_orchidee_send_field_r3d
722	!!
723	!>\BRIEF Subroutine for sending 3D fields to XIOS.
724	!!
725	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 3D fields.
726	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
727	!!
728	!! \n
729	!_ ================================================================================================================================
730	SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
731	!
732	!! 0. Variable and parameter declaration
733	!
734	!! 0.1 Input variables
735	!
736	CHARACTER(len=*), INTENT(IN) :: field_id
737	REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
738
739	!! 0.2 Local variables
740	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
741
742	!_ ================================================================================================================================
743	IF (xios_orchidee_ok) THEN
744	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
745
746	! Gather all omp domains on the mpi domains
747	CALL gather_omp(field, field_mpi)
748
749	! All master threads send the field to XIOS
750	IF (is_omp_root) THEN
751	#ifdef XIOS
752	CALL xios_send_field(field_id,field_mpi)
753	#endif
754	END IF
755	END IF
756	END SUBROUTINE xios_orchidee_send_field_r3d
757
758	!! ==============================================================================================================================
759	!! SUBROUTINE : xios_orchidee_send_field_r4d
760	!!
761	!>\BRIEF Subroutine for sending 4D fields to XIOS.
762	!!
763	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 4D fields.
764	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
765	!!
766	!! \n
767	!_ ================================================================================================================================
768	SUBROUTINE xios_orchidee_send_field_r4d(field_id,field)
769	!
770	!! 0. Variable and parameter declaration
771	!
772	!! 0.1 Input variables
773	!
774	CHARACTER(len=*), INTENT(IN) :: field_id
775	REAL(r_std), DIMENSION(:,:,:,:), INTENT(IN) :: field
776
777	!! 0.2 Local variables
778	INTEGER :: jv
779	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4)) :: field_mpi
780
781	!_ ================================================================================================================================
782	IF (xios_orchidee_ok) THEN
783	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r4d, field_id=',field_id
784
785	! Gather all omp domains on the mpi domains
786	CALL gather_omp(field, field_mpi)
787
788	! All master threads send the field to XIOS
789	IF (is_omp_root) THEN
790	#ifdef XIOS
791	CALL xios_send_field(field_id,field_mpi)
792	#endif
793	END IF
794	END IF
795	END SUBROUTINE xios_orchidee_send_field_r4d
796
797	!! ==============================================================================================================================
798	!! SUBROUTINE : xios_orchidee_send_field_r5d
799	!!
800	!>\BRIEF Subroutine for sending 5D fields to XIOS.
801	!!
802	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 5D fields.
803	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
804	!!
805	!! \n
806	!_ ================================================================================================================================
807	SUBROUTINE xios_orchidee_send_field_r5d(field_id,field)
808	!
809	!! 0. Variable and parameter declaration
810	!
811	!! 0.1 Input variables
812	!
813	CHARACTER(len=*), INTENT(IN) :: field_id
814	REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(IN) :: field
815
816	!! 0.2 Local variables
817	INTEGER :: jv
818	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3),size(field,4),size(field,5)) :: field_mpi
819
820	!_ ================================================================================================================================
821	IF (xios_orchidee_ok) THEN
822	IF (printlev>=4) WRITE(numout,*) 'Entering xios_orchidee_send_field_r5d, field_id=',field_id
823
824	! Gather all omp domains on the mpi domains
825	CALL gather_omp(field, field_mpi)
826
827	! All master threads send the field to XIOS
828	IF (is_omp_root) THEN
829	#ifdef XIOS
830	CALL xios_send_field(field_id,field_mpi)
831	#endif
832	END IF
833	END IF
834	END SUBROUTINE xios_orchidee_send_field_r5d
835
836	END MODULE xios_orchidee
837

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

Download in other formats: