Context Navigation

source: branches/publications/ORCHIDEE_CAN_NHA/src_parallel/xios_orchidee.f90 @ 7475

Last change on this file since 7475 was 1964, checked in by matthew.mcgrath, 10 years ago
DEV: Trunk changes up to and including r1947
File size: 30.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 is done in this module.
12	!!
13	!! Summury of subroutines
14	!! xios_orchidee_comm_init : First call to XIOS to get the MPI communicator
15	!! xios_orchidee_init : Initialize variables needed for use of XIOS
16	!! Deactivation of fields not calculated due specific run options
17	!! xios_orchidee_update_calendar : Update the calandar in XIOS
18	!! xios_orchidee_finalize : Last call to XIOS for finalization
19	!! xios_orchidee_send_field : Interface to send fields with 1, 2 or 3 dimensions to XIOS
20	!! xios_orchidee_send_field_r1d : Internal subroutine for 1D(array) fields
21	!! xios_orchidee_send_field_r2d : Internal subroutine for 2D fields
22	!! xios_orchidee_send_field_r3d : Internal subroutine for 3D fields
23	!!
24	!! Note that compilation must be done with the preporcessing key XIOS and CPP_PARA. Compiling without these
25	!! keys makes it impossible to activate XIOS. To activate run using XIOS, the flag XIOS_ORCHIDEE_OK=y must
26	!! be set in run.def and the file iodef.xml must exist.
27	!!
28	!! RECENT CHANGE(S): Created by Arnaud Caubel(LSCE), Josefine Ghattas (IPSL) 2013
29	!!
30	!! REFERENCE(S) : None
31	!!
32	!! SVN :
33	!! $HeadURL: $
34	!! $Date: $
35	!! $Revision: $
36	!! \n
37	!_ ================================================================================================================================
38
39	MODULE xios_orchidee
40
41	#ifdef XIOS
42	USE xios
43	#endif
44	USE defprec
45	USE pft_parameters_var, ONLY : nvm
46	USE constantes_var, ONLY : nlai, nnobio, control_type, long_print, almaoutput, dt_sechiba
47	USE constantes_soil_var, ONLY : ngrnd, nstm, nslm, check_waterbal
48	USE IOIPSL, ONLY : ioget_calendar, ju2ymds, getin
49	USE mod_orchidee_para_var
50	USE mod_orchidee_transfert_para
51	USE ioipsl_para
52
53	IMPLICIT NONE
54	PRIVATE
55	PUBLIC :: xios_orchidee_comm_init, xios_orchidee_init, xios_orchidee_change_context, &
56	xios_orchidee_update_calendar, xios_orchidee_context_finalize, xios_orchidee_finalize, &
57	xios_orchidee_send_field
58
59	!
60	!! Declaration of public variables
61	!
62	LOGICAL, PUBLIC, SAVE :: xios_orchidee_ok=.FALSE. !! Use XIOS for diagnostic files
63	!$OMP THREADPRIVATE(xios_orchidee_ok)
64
65	!
66	!! Declaration of internal variables
67	!
68	#ifdef XIOS
69	TYPE(xios_context) :: ctx_hdl_orchidee !! Handel for ORCHIDEE
70	!$OMP THREADPRIVATE(ctx_hdl_orchidee)
71	#endif
72	CHARACTER(len=*),PARAMETER :: id="client" !! Id for initialization of ORCHIDEE in XIOS
73
74
75
76	!! ==============================================================================================================================
77	!! INTERFACE : xios_orchidee_send_field
78	!!
79	!>\BRIEF Send a field to XIOS.
80	!!
81	!! DESCRIPTION :\n Send a field to XIOS. The field can have 1, 2 or 3 dimensions.
82	!! This interface should be called at each time-step for each output varaiables.
83	!!
84	!! \n
85	!_ ================================================================================================================================
86	INTERFACE xios_orchidee_send_field
87	MODULE PROCEDURE xios_orchidee_send_field_r1d, xios_orchidee_send_field_r2d, xios_orchidee_send_field_r3d
88	END INTERFACE
89
90
91	CONTAINS
92	!! ==============================================================================================================================
93	!! SUBROUTINE : xios_orchidee_comm_init
94	!!
95	!>\BRIEF Get the MPI communicator.
96	!!
97	!! DESCRIPTION :\n First call to XIOS to get the MPI communicator.
98	!! Note that it is XIOS that initialize the MPI communicator.
99	!! This subroutine is only called in ORCHIDEE offline mode. When running in coupled mode, the
100	!! atmospheric model must initlialize XIOS at the same time as initializing MPI.
101	!! \n
102	!_ ================================================================================================================================
103	SUBROUTINE xios_orchidee_comm_init(comm_local)
104	!
105	!! 0. Variable and parameter declaration
106	!
107	!! Output variables
108	INTEGER, INTENT(OUT) :: comm_local
109
110	!_ ================================================================================================================================
111
112	IF (is_omp_root) THEN
113	#ifdef XIOS
114	CALL xios_initialize(id,return_comm=comm_local)
115	#else
116	! Write error messages and stop the model
117	WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
118	WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
119	WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_comm_init'
120	#ifdef CPP_PARA
121	CALL MPI_ABORT(3)
122	#endif
123
124	#endif
125
126	END IF
127	END SUBROUTINE xios_orchidee_comm_init
128
129
130	!! ==============================================================================================================================
131	!! SUBROUTINE : xios_orchidee_init
132	!!
133	!>\BRIEF Initialize variables needed for use of XIOS.
134	!!
135	!! DESCRIPTION :\n Initialization of specific varaiables needed to use XIOS such as model domain and time step.
136	!!
137	!! In this subroutine also a section containg deactivation of some fields is found. The variables are
138	!! deactivated of not according to the corresponding control flag. For exemple the variables cacluated by the
139	!! routing scheme will be deactivated if the routing is deactivated. This is done to be able to keep the same
140	!! iodef.xml input file for several options without geting empty fields in the output file. Note that a field that
141	!! is activated in the code can always be deactivated from the iodef.xml external file.
142	!!
143	!! \n
144	!_ ================================================================================================================================
145	SUBROUTINE xios_orchidee_init(MPI_COMM_ORCH, &
146	date0, year, month, day, &
147	lon_mpi, lat_mpi, soilth_lev, control_flags )
148
149	!
150	!! 0. Variable and parameter declaration
151	!
152	!! 0.1 Input variables
153	!
154	INTEGER(i_std), INTENT(in) :: MPI_COMM_ORCH !! Orchidee MPI communicator (from module mod_orchidee_mpi_data)
155	REAL(r_std), INTENT(in) :: date0 !! Julian day at first time step
156	INTEGER(i_std), INTENT(in) :: year, month, day !! Current date information
157	REAL(r_std),DIMENSION (iim_g,jj_nb), INTENT(in) :: lon_mpi, lat_mpi !! Longitudes and latitudes on MPI local domain 2D domain
158	REAL(r_std),DIMENSION (ngrnd), INTENT(in) :: soilth_lev !! Vertical soil levels for thermal scheme (m)
159	TYPE(control_type) :: control_flags !! Flags that activate parts of the model
160
161	!
162	!! 0.2 Local variables
163	!
164	#ifdef XIOS
165	TYPE(xios_time) :: dtime_xios
166	TYPE(xios_fieldgroup) :: fieldgroup_handle
167	TYPE(xios_field) :: field_handle
168	TYPE(xios_file) :: file_handle
169	#endif
170	INTEGER(i_std) :: i
171	INTEGER(i_std) :: year0, month0, day0 !! Time origin date information
172	REAL(r_std) :: sec0 !! Time origin date information
173	CHARACTER(LEN=20) :: calendar_str !! Name of current calendar
174	CHARACTER(LEN=30) :: start_str !! Current date as character string
175	CHARACTER(LEN=30) :: startorig_str !! Time origin date as character string
176	!_ ================================================================================================================================
177
178
179	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_init'
180
181	!Config Key = XIOS_ORCHIDEE_OK
182	!Config Desc = Use XIOS for writing diagnostics file
183	!Config If =
184	!Config Def = FALSE
185	!Config Help =
186	!Config Units = [FLAG]
187	CALL getin_p('XIOS_ORCHIDEE_OK',xios_orchidee_ok)
188	WRITE(numout,*)'In xios_orchidee_init, xios_orchidee_ok=',xios_orchidee_ok
189
190	! Coherence test between flag and preprocessing key
191	#ifndef XIOS
192	IF (xios_orchidee_ok) THEN
193	! Write error messages and stop the model
194	WRITE(numout,*) 'Preprocessing key XIOS is missing to run ORCHIDEE with XIOS'
195	WRITE(numout,*) 'Recompile with preprocessing flag XIOS or set XIOS_ORCHIDEE_OK=n in run.def'
196	WRITE(numout,*) 'Fatal error from ORCHIDEE. STOP in xios_orchidee_init'
197	#ifdef CPP_PARA
198	CALL MPI_ABORT(3)
199	#endif
200	END IF
201	#endif
202
203
204	!
205	!! 1. Set date and calendar information on the format needed by XIOS
206	!
207
208	! Get the calendar from IOIPSL and captialize the string to be readable for XIOS
209	CALL ioget_calendar(calendar_str)
210	IF (calendar_str == 'gregorian') THEN
211	calendar_str='Gregorian'
212	ELSE IF (calendar_str == 'noleap') THEN
213	calendar_str='NoLeap'
214	ELSE IF (calendar_str == '360d') THEN
215	calendar_str='D360'
216	END IF
217
218	! Transform the time origin from julian days into year, month, day and seconds
219	CALL ju2ymds(date0, year0, month0, day0, sec0)
220
221	! Transform the current date into character string as XIOS need
222	WRITE(start_str,"(I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)") year,month,day,0,0,0
223
224	! Transform the time origin date into character string as XIOS need
225	WRITE(startorig_str,"(I4.4,'-',I2.2,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2)") year0,month0,day0,0,0,0
226
227	IF (long_print) THEN
228	WRITE(numout,*) 'In xios_orchidee_init : calendar_str=', calendar_str
229	WRITE(numout,*) 'In xios_orchidee_init : start_date=', start_str
230	WRITE(numout,*) 'In xios_orchidee_init : time_origin=', startorig_str
231	END IF
232
233	IF (xios_orchidee_ok .AND. is_omp_root) THEN
234	#ifdef XIOS
235	!
236	!! 2. Context initialization
237	!
238	CALL xios_context_initialize("orchidee",MPI_COMM_ORCH)
239	CALL xios_get_handle("orchidee",ctx_hdl_orchidee)
240	CALL xios_set_current_context(ctx_hdl_orchidee)
241
242	!
243	!! 2. Calendar and date definition
244	!
245	CALL xios_set_context_attr("orchidee",calendar_type=calendar_str)
246	CALL xios_set_context_attr("orchidee",start_date=start_str)
247	CALL xios_set_context_attr("orchidee",time_origin=startorig_str)
248
249	!
250	!! 3. Domain definition
251	!
252	! Global domain
253	CALL xios_set_domain_attr("domain_landpoints",ni_glo=iim_g, nj_glo=jjm_g)
254
255	! Local MPI domain
256	CALL xios_set_domain_attr("domain_landpoints",ibegin=1, iend=iim_g, jbegin=jj_begin, jend=jj_end)
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_n_index=nbp_mpi, data_i_index=kindex_mpi)
261
262	! Define longitudes and latitudes on local MPI domain
263	CALL xios_set_domain_attr("domain_landpoints",lonvalue=lon_mpi(:,1),latvalue=lat_mpi(1,:))
264
265	!
266	!! 4. Axis definition
267	!
268	CALL xios_set_axis_attr("veget",size=nvm ,VALUE=(/(REAL(i,r_std),i=1,nvm)/))
269	CALL xios_set_axis_attr("laiax", size=nlai+1,VALUE=(/(REAL(i,r_std),i=1,nlai+1)/))
270	CALL xios_set_axis_attr("solth",size=ngrnd ,VALUE=soilth_lev(:))
271	CALL xios_set_axis_attr("soiltyp", size=nstm,VALUE=(/(REAL(i,r_std),i=1,nstm)/))
272	CALL xios_set_axis_attr("nobio", size=nnobio,VALUE=(/(REAL(i,r_std),i=1,nnobio)/))
273	CALL xios_set_axis_attr("albtyp", size=2,VALUE=(/(REAL(i,r_std),i=1,2)/))
274	CALL xios_set_axis_attr("solay", size=nslm,VALUE=(/(REAL(i,r_std),i=1,nslm)/))
275	CALL xios_set_axis_attr("PFT", size=nvm,VALUE=(/(REAL(i,r_std), i=1,nvm)/))
276	CALL xios_set_axis_attr("P10", size=10,VALUE=(/(REAL(i,r_std), i=1,10)/))
277	CALL xios_set_axis_attr("P100", size=100,VALUE=(/(REAL(i,r_std), i=1,100)/))
278	CALL xios_set_axis_attr("P11", size=11,VALUE=(/(REAL(i,r_std), i=1,11)/))
279	CALL xios_set_axis_attr("P101", size=101,VALUE=(/(REAL(i,r_std), i=1,101)/))
280
281	!
282	!! 5. Send the time-step length to XIOS
283	!
284	dtime_xios%second=dt_sechiba
285	CALL xios_set_timestep(dtime_xios)
286
287	!
288	!! 6. Deactivation of some fields if they are not calculated
289	!
290	IF ( .NOT. control_flags%river_routing ) THEN
291	CALL xios_set_field_attr("basinmap",enabled=.FALSE.)
292	CALL xios_set_field_attr("nbrivers",enabled=.FALSE.)
293	CALL xios_set_field_attr("riversret",enabled=.FALSE.)
294	CALL xios_set_field_attr("hydrographs",enabled=.FALSE.)
295	CALL xios_set_field_attr("fastr",enabled=.FALSE.)
296	CALL xios_set_field_attr("slowr",enabled=.FALSE.)
297	CALL xios_set_field_attr("streamr",enabled=.FALSE.)
298	CALL xios_set_field_attr("lakevol",enabled=.FALSE.)
299	CALL xios_set_field_attr("pondr",enabled=.FALSE.)
300	END IF
301
302
303	IF (control_flags%hydrol_cwrr ) THEN
304	CALL xios_set_field_attr("dss",enabled=.FALSE.)
305	CALL xios_set_field_attr("gqsb",enabled=.FALSE.)
306	CALL xios_set_field_attr("bqsb",enabled=.FALSE.)
307	CALL xios_set_field_attr("rsol",enabled=.FALSE.)
308	CALL xios_set_field_attr("mrsos",enabled=.FALSE.)
309	CALL xios_set_field_attr("mrso",enabled=.FALSE.)
310	CALL xios_set_field_attr("mrros",enabled=.FALSE.)
311	CALL xios_set_field_attr("mrro",enabled=.FALSE.)
312	CALL xios_set_field_attr("prveg",enabled=.FALSE.)
313	ELSE
314	CALL xios_set_field_attr("reinf_slope",enabled=.FALSE.)
315	CALL xios_set_field_attr("soilindex",enabled=.FALSE.)
316	CALL xios_set_field_attr("evapnu_soil",enabled=.FALSE.)
317	CALL xios_set_field_attr("drainage_soil",enabled=.FALSE.)
318	CALL xios_set_field_attr("transpir_soil",enabled=.FALSE.)
319	CALL xios_set_field_attr("runoff_soil",enabled=.FALSE.)
320	CALL xios_set_field_attr("humtot",enabled=.FALSE.)
321	CALL xios_set_field_attr("humtot_soil",enabled=.FALSE.)
322	CALL xios_set_field_attr("SWI",enabled=.FALSE.)
323	CALL xios_set_field_attr("njsc",enabled=.FALSE.)
324	CALL xios_set_field_attr("k_litt",enabled=.FALSE.)
325	CALL xios_set_field_attr("SoilMoist",enabled=.FALSE.)
326	CALL xios_set_field_attr("moistc_1",enabled=.FALSE.)
327	CALL xios_set_field_attr("moistc_2",enabled=.FALSE.)
328	CALL xios_set_field_attr("moistc_3",enabled=.FALSE.)
329	CALL xios_set_field_attr("kfactroot_1",enabled=.FALSE.)
330	CALL xios_set_field_attr("kfactroot_2",enabled=.FALSE.)
331	CALL xios_set_field_attr("kfactroot_3",enabled=.FALSE.)
332	CALL xios_set_field_attr("vegetsoil_1",enabled=.FALSE.)
333	CALL xios_set_field_attr("vegetsoil_2",enabled=.FALSE.)
334	CALL xios_set_field_attr("vegetsoil_3",enabled=.FALSE.)
335	END IF
336
337	IF ( .NOT. control_flags%do_floodplains ) THEN
338	CALL xios_set_field_attr("flood_frac",enabled=.FALSE.)
339	CALL xios_set_field_attr("reinfiltration",enabled=.FALSE.)
340	CALL xios_set_field_attr("floodmap",enabled=.FALSE.)
341	CALL xios_set_field_attr("floodh",enabled=.FALSE.)
342	CALL xios_set_field_attr("floodr",enabled=.FALSE.)
343	CALL xios_set_field_attr("floodout",enabled=.FALSE.)
344	CALL xios_set_field_attr("evapflo",enabled=.FALSE.)
345	CALL xios_set_field_attr("evapflo_alma",enabled=.FALSE.)
346	END IF
347
348	! Deactivate some stomate fields.
349	! These fields were traditionally added in sechiba_history.nc output file.
350	IF ( .NOT. control_flags%ok_stomate ) THEN
351	CALL xios_set_field_attr("nee",enabled=.FALSE.)
352	CALL xios_set_field_attr("maint_resp",enabled=.FALSE.)
353	CALL xios_set_field_attr("hetero_resp",enabled=.FALSE.)
354	CALL xios_set_field_attr("growth_resp",enabled=.FALSE.)
355	CALL xios_set_field_attr("npp",enabled=.FALSE.)
356	END IF
357
358	IF ( .NOT. control_flags%do_irrigation ) THEN
359	CALL xios_set_field_attr("irrigation",enabled=.FALSE.)
360	CALL xios_set_field_attr("netirrig",enabled=.FALSE.)
361	CALL xios_set_field_attr("irrigation_alma",enabled=.FALSE.)
362	CALL xios_set_field_attr("netirrig_alma",enabled=.FALSE.)
363	CALL xios_set_field_attr("irrigmap",enabled=.FALSE.)
364	END IF
365
366	IF ( .NOT. control_flags%ok_co2)THEN
367	CALL xios_set_field_attr("vbetaco2",enabled=.FALSE.)
368	CALL xios_set_field_attr("cimean",enabled=.FALSE.)
369	CALL xios_set_field_attr("gpp",enabled=.FALSE.)
370	END IF
371
372	IF ( .NOT. control_flags%ok_inca)THEN
373	CALL xios_set_field_attr("PAR",enabled=.FALSE.)
374	CALL xios_set_field_attr("flx_fertil_no",enabled=.FALSE.)
375	CALL xios_set_field_attr("CRF",enabled=.FALSE.)
376	CALL xios_set_field_attr("ptnlev1",enabled=.FALSE.)
377	CALL xios_set_field_attr("flx_iso",enabled=.FALSE.)
378	CALL xios_set_field_attr("flx_mono",enabled=.FALSE.)
379	CALL xios_set_field_attr("flx_ORVOC",enabled=.FALSE.)
380	CALL xios_set_field_attr("flx_MBO",enabled=.FALSE.)
381	CALL xios_set_field_attr("flx_methanol",enabled=.FALSE.)
382	CALL xios_set_field_attr("flx_acetone",enabled=.FALSE.)
383	CALL xios_set_field_attr("flx_acetal",enabled=.FALSE.)
384	CALL xios_set_field_attr("flx_formal",enabled=.FALSE.)
385	CALL xios_set_field_attr("flx_acetic",enabled=.FALSE.)
386	CALL xios_set_field_attr("flx_formic",enabled=.FALSE.)
387	CALL xios_set_field_attr("flx_no_soil",enabled=.FALSE.)
388	CALL xios_set_field_attr("flx_no",enabled=.FALSE.)
389	END IF
390
391	IF ( .NOT. control_flags%ok_radcanopy)THEN
392	CALL xios_set_field_attr("PARsun",enabled=.FALSE.)
393	CALL xios_set_field_attr("PARsh",enabled=.FALSE.)
394	CALL xios_set_field_attr("laisun",enabled=.FALSE.)
395	CALL xios_set_field_attr("laish",enabled=.FALSE.)
396	CALL xios_set_field_attr("Fdf",enabled=.FALSE.)
397	CALL xios_set_field_attr("PARsuntab",enabled=.FALSE.)
398	CALL xios_set_field_attr("PARshtab",enabled=.FALSE.)
399	CALL xios_set_field_attr("Sinang",enabled=.FALSE.)
400	CALL xios_set_field_attr("PARdf",enabled=.FALSE.)
401	CALL xios_set_field_attr("PARdr",enabled=.FALSE.)
402	CALL xios_set_field_attr("Trans",enabled=.FALSE.)
403	CALL xios_set_field_attr("Day",enabled=.FALSE.)
404	CALL xios_set_field_attr("Year_length",enabled=.FALSE.)
405	END IF
406
407	IF ( .NOT. control_flags%ok_bbgfertil_Nox) THEN
408	CALL xios_set_field_attr("flx_co2_bbg_year",enabled=.FALSE.)
409	END IF
410
411	IF ( .NOT. control_flags%ok_cropsfertil_Nox) THEN
412	CALL xios_set_field_attr("N_qt_WRICE_year",enabled=.FALSE.)
413	CALL xios_set_field_attr("N_qt_OTHER_year",enabled=.FALSE.)
414	END IF
415
416	IF (.NOT. check_waterbal) THEN
417	CALL xios_set_field_attr("TotWater",enabled=.FALSE.)
418	CALL xios_set_field_attr("TotWaterFlux",enabled=.FALSE.)
419	END IF
420
421
422	!
423	!! 7. Close context
424	!
425	CALL xios_close_context_definition()
426
427	!
428	!! 8. Activate almaoutput if needed
429	!! Some extra calculations have to be done for the variables tot_watsoil_end("RootMoist"),
430	!! delsoilmoist("DelSoilMoist"), delintercept, delswe("DelSWE") and soilwet("SoilWet").
431	!! Set almaoutput=true if at least one of these variables are defined in an output file.
432	!! If not, keep the initial value of almaoutput.
433	!
434
435	IF (xios_field_is_active("RootMoist") .OR. xios_field_is_active("DelSoilMoist") .OR. &
436	xios_field_is_active("DelIntercept") .OR. xios_field_is_active("DelSWE") .OR. &
437	xios_field_is_active("SoilWet")) THEN
438
439	almaoutput=.TRUE.
440	WRITE(numout,*) 'almaoutput has been set to true in xios_orchidee_init'
441	END IF
442	#endif
443	END IF
444
445	IF (xios_orchidee_ok) THEN
446	! Send variable almaoutput to all processes
447	CALL bcast(almaoutput)
448	END IF
449
450	IF (long_print) WRITE(numout,*) 'Exit xios_orchidee_init'
451	END SUBROUTINE xios_orchidee_init
452
453
454	!! ==============================================================================================================================
455	!! SUBROUTINE : xios_orchidee_change_context
456	!!
457	!>\BRIEF Use this subroutine to switch between different context.
458	!! This subroutine must be called when running in coupled mode at each time ORCHIDEE is called, in the
459	!! begining and end of intersurf_gathered. First call is done after xios_orchidee_init is done.
460	!!
461	!! DESCRIPTION :\n
462	!!
463	!! \n
464	!_ ================================================================================================================================
465	SUBROUTINE xios_orchidee_change_context(new_context)
466	!
467	!! 0. Variable and parameter declaration
468	!
469	!! Input variable
470	CHARACTER(LEN=*),INTENT(IN) :: new_context
471
472	!! Local variables
473	#ifdef XIOS
474	TYPE(xios_context) :: ctx_hdl
475	#endif
476	!_ ================================================================================================================================
477
478	IF (xios_orchidee_ok .AND. is_omp_root) THEN
479	#ifdef XIOS
480	CALL xios_get_handle(new_context,ctx_hdl)
481	CALL xios_set_current_context(ctx_hdl)
482	#endif
483	END IF
484
485	END SUBROUTINE xios_orchidee_change_context
486
487	!! ==============================================================================================================================
488	!! SUBROUTINE : xios_orchidee_update_calendar
489	!!
490	!>\BRIEF Update the calandar in XIOS.
491	!!
492	!! DESCRIPTION :\n Update the calendar in XIOS : let XIOS know that ORCHIDEE avanced one time-step.
493	!! This subroutine should be called in the beginning of each time-step. The first
494	!! time-step in a new execution should always start at 1. Therefore, first calculate
495	!! an offset that is substracted to the current time step in sechiba.
496	!!
497	!! \n
498	!_ ================================================================================================================================
499	SUBROUTINE xios_orchidee_update_calendar(itau_sechiba)
500	!
501	!! 0. Variable and parameter declaration
502	!
503	!! 0.1 Input variables
504	!
505	INTEGER(i_std), INTENT(IN) :: itau_sechiba !! Current time step of the model
506	!
507	!! 0.2 Local variables
508	!
509	LOGICAL, SAVE :: first=.TRUE. !! Flag for first entering in subroutine
510	INTEGER(i_std), SAVE :: offset !! Offset to substract from itau_sechiba
511	INTEGER(i_std) :: itau_xios !! Current time step for XIOS
512
513	!_ ================================================================================================================================
514
515	IF (xios_orchidee_ok .AND. is_omp_root) THEN
516	#ifdef XIOS
517	! Calculate the offset
518	IF (first) THEN
519	offset=itau_sechiba-1
520	first=.FALSE.
521	END IF
522
523	! Substract the offset to the current time step in sechiba
524	itau_xios=itau_sechiba-offset
525
526	! Send the new time step to XIOS
527	IF (long_print) WRITE(numout,*) 'xios_orchidee_update_calendar: itau_sechiba, itau_xios=',itau_sechiba,itau_xios
528	CALL xios_update_calendar(itau_xios)
529	#endif
530	END IF
531	END SUBROUTINE xios_orchidee_update_calendar
532	!! ==============================================================================================================================
533	!! SUBROUTINE : xios_orchidee_context_finalize
534	!!
535	!>\BRIEF Finalize orchidee context.
536	!!
537	!! DESCRIPTION :\n This subroutine finalizes the orchidee context without finalizing XIOS. In coupled mode, the atmospheric
538	!! modele must finalize XIOS. This subroutine is called in the end of the execution of ORCHIDEE only in
539	!! coupeld mode.
540	!!
541	!! \n
542	!_ ================================================================================================================================
543	SUBROUTINE xios_orchidee_context_finalize
544
545	!_ ================================================================================================================================
546
547	IF (xios_orchidee_ok .AND. is_omp_root) THEN
548	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_context_finalize'
549	#ifdef XIOS
550	CALL xios_context_finalize()
551	#endif
552	END IF
553	END SUBROUTINE xios_orchidee_context_finalize
554
555
556	!! ==============================================================================================================================
557	!! SUBROUTINE : xios_orchidee_finalize
558	!!
559	!>\BRIEF Last call to XIOS for finalization.
560	!!
561	!! DESCRIPTION :\n Last call to XIOS for finalization of the orchidee context and XIOS.
562	!! This subroutine is called only when ORCHIDEE is run in offline mode. In coupled mode it is the atmospheric
563	!! model that finalizes XIOS. In that case, the context orchidee must be finalized using the
564	!! subroutine xios_orchidee_context_finalize
565	!!
566	!! \n
567	!_ ================================================================================================================================
568	SUBROUTINE xios_orchidee_finalize
569
570	!_ ================================================================================================================================
571
572	IF (xios_orchidee_ok .AND. is_omp_root) THEN
573	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_finalize'
574	#ifdef XIOS
575	CALL xios_context_finalize()
576	CALL xios_finalize()
577	#endif
578	END IF
579	END SUBROUTINE xios_orchidee_finalize
580
581
582	!! ==============================================================================================================================
583	!! SUBROUTINE : xios_orchidee_send_field_r1d
584	!!
585	!>\BRIEF Subroutine for sending 1D (array) fields to XIOS.
586	!!
587	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 1D fields (array).
588	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
589	!!
590	!! \n
591	!_ ================================================================================================================================
592	SUBROUTINE xios_orchidee_send_field_r1d(field_id,field)
593	!
594	!! 0. Variable and parameter declaration
595	!
596	!! 0.1 Input variables
597	!
598	CHARACTER(len=*), INTENT(IN) :: field_id
599	REAL(r_std), DIMENSION(:), INTENT(IN) :: field
600
601	!! 0.2 Local variables
602	REAL(r_std), DIMENSION(nbp_mpi) :: field_mpi
603
604	!_ ================================================================================================================================
605	IF (xios_orchidee_ok) THEN
606	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_send_field_r1d, field_id=',field_id
607
608	! Gather all omp domains on the mpi domains
609	CALL gather_omp(field, field_mpi)
610
611	! All master threads send the field to XIOS
612	IF (is_omp_root) THEN
613	#ifdef XIOS
614	CALL xios_send_field(field_id,field_mpi)
615	#endif
616	END IF
617	END IF
618	END SUBROUTINE xios_orchidee_send_field_r1d
619
620
621	!! ==============================================================================================================================
622	!! SUBROUTINE : xios_orchidee_send_field_r2d
623	!!
624	!>\BRIEF Subroutine for sending 2D fields to XIOS.
625	!!
626	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 2D fields.
627	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
628	!!
629	!! \n
630	!_ ================================================================================================================================
631	SUBROUTINE xios_orchidee_send_field_r2d(field_id,field)
632	!
633	!! 0. Variable and parameter declaration
634	!
635	!! 0.1 Input variables
636	!
637	CHARACTER(len=*), INTENT(IN) :: field_id
638	REAL(r_std), DIMENSION(:,:), INTENT(IN) :: field
639
640	!! 0.2 Local variables
641	REAL(r_std), DIMENSION(nbp_mpi,size(field,2)) :: field_mpi
642
643	!_ ================================================================================================================================
644	IF (xios_orchidee_ok) THEN
645	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_send_field_r2d, field_id=',field_id
646
647	! Gather all omp domains on the mpi domains
648	CALL gather_omp(field, field_mpi)
649
650	! All master threads send the field to XIOS
651	IF (is_omp_root) THEN
652	#ifdef XIOS
653	CALL xios_send_field(field_id,field_mpi)
654	#endif
655	END IF
656	END IF
657	END SUBROUTINE xios_orchidee_send_field_r2d
658
659
660	!! ==============================================================================================================================
661	!! SUBROUTINE : xios_orchidee_send_field_r3d
662	!!
663	!>\BRIEF Subroutine for sending 3D fields to XIOS.
664	!!
665	!! DESCRIPTION :\n Send one field to XIOS. This is the interface for 3D fields.
666	!! NB! This subroutine should not be called directly. Use interface xios_orchidee_send_field.
667	!!
668	!! \n
669	!_ ================================================================================================================================
670	SUBROUTINE xios_orchidee_send_field_r3d(field_id,field)
671	!
672	!! 0. Variable and parameter declaration
673	!
674	!! 0.1 Input variables
675	!
676	CHARACTER(len=*), INTENT(IN) :: field_id
677	REAL(r_std), DIMENSION(:,:,:), INTENT(IN) :: field
678
679	!! 0.2 Local variables
680	REAL(r_std), DIMENSION(nbp_mpi,size(field,2),size(field,3)) :: field_mpi
681
682	!_ ================================================================================================================================
683	IF (xios_orchidee_ok) THEN
684	IF (long_print) WRITE(numout,*) 'Entering xios_orchidee_send_field_r3d, field_id=',field_id
685
686	! Gather all omp domains on the mpi domains
687	CALL gather_omp(field, field_mpi)
688
689	! All master threads send the field to XIOS
690	IF (is_omp_root) THEN
691	#ifdef XIOS
692	CALL xios_send_field(field_id,field_mpi)
693	#endif
694	END IF
695	END IF
696	END SUBROUTINE xios_orchidee_send_field_r3d
697
698	END MODULE xios_orchidee
699

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

Download in other formats: