Context Navigation

source: branches/publications/ORCHIDEE-ICE_SurfaceMassBalance/src_parallel/xios_orchidee.f90 @ 8398

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

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

Download in other formats: