Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

xios_orchidee.f90 @ 7326

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

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd_mict_peat_ch4/src_parallel/xios_orchidee.f90 @ 7326

Download in other formats: