Context Navigation

xios_orchidee.f90 @ 6145

Last change on this file since 6145 was 4482, checked in by fuxing.wang, 7 years ago

Modifing testrouting to make it work for XIOS. Finding the usable GRDC observation stations by comparing upstream basin area and distance between GRDC and model subbasin. The GRDC and the corresponding model subbasion information (Lon, Lat, Area, Discharge, etc.) is then written into river_grdc_XXXX.nc output. This nc file also contains the information of the pre-defined number of largest river basins. Another output grdc_river_desc.nc describes the all the matched GRDC river basins (for post-processing).

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

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

Context Navigation

source: branches/publications/ORCHIDEE_gmd-2018-57/src_parallel/xios_orchidee.f90 @ 6145

Download in other formats: