Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

xios_orchidee.f90 @ 7346

Last change on this file since 7346 was 4977, checked in by simon.bowring, 6 years ago
Currently running (13/02/2018) version includes all necessarily changes to include DOC in MICT code... further parametrisation necessary to equate soil pools with those of normal forcesoil restarts
File size: 38.0 KB

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

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd_2018_MICT-LEAK/src_parallel/xios_orchidee.f90 @ 7346

Download in other formats: