Context Navigation

wxios.F90 @ 3442

Last change on this file since 3442 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

File size: 24.7 KB

Line
1	! $Id$
2	#ifdef CPP_XIOS
3	MODULE wxios
4	USE xios
5	USE iaxis
6	USE iaxis_attr
7	USE icontext_attr
8	USE idate
9	USE idomain_attr
10	USE ifield_attr
11	USE ifile_attr
12	USE ixml_tree
13
14	!Variables disponibles pendant toute l'execution du programme:
15
16	INTEGER, SAVE :: g_comm
17	CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
18	TYPE(xios_context), SAVE :: g_ctx
19	!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
20	LOGICAL, SAVE :: g_flag_xml = .FALSE.
21	CHARACTER(len=100) :: g_field_name = "nofield"
22	!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
23	REAL :: missing_val_omp
24	REAL :: missing_val
25	!$OMP THREADPRIVATE(missing_val)
26
27	#ifdef XIOS1
28	#error "XIOS v1 no longer supported, use XIOS v2."
29	#endif
30
31	CONTAINS
32
33	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
34	! 36day => 36d etc !!!!!!!!!!!!!!!!!!!!
35	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36
37	SUBROUTINE reformadate(odate, ndate)
38	CHARACTER(len=*), INTENT(IN) :: odate
39	TYPE(xios_duration) :: ndate
40
41	INTEGER :: i = 0
42	!!!!!!!!!!!!!!!!!!
43	! Pour XIOS:
44	! year : y
45	! month : mo
46	! day : d
47	! hour : h
48	! minute : mi
49	! second : s
50	!!!!!!!!!!!!!!!!!!
51
52	i = INDEX(odate, "day")
53	IF (i > 0) THEN
54	read(odate(1:i-1),*) ndate%day
55	END IF
56
57	i = INDEX(odate, "hr")
58	IF (i > 0) THEN
59	read(odate(1:i-1),*) ndate%hour
60	END IF
61
62	i = INDEX(odate, "mth")
63	IF (i > 0) THEN
64	read(odate(1:i-1),*) ndate%month
65	END IF
66
67	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
68	END SUBROUTINE reformadate
69
70	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
71	! ave(X) => average etc !!!!!!!!!!!!!!!
72	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
73
74	CHARACTER(len=7) FUNCTION reformaop(op)
75	CHARACTER(len=*), INTENT(IN) :: op
76
77	INTEGER :: i = 0
78	reformaop = "average"
79
80	IF (op.EQ."inst(X)") THEN
81	reformaop = "instant"
82	END IF
83
84	IF (op.EQ."once") THEN
85	reformaop = "once"
86	END IF
87
88	IF (op.EQ."t_max(X)") THEN
89	reformaop = "maximum"
90	END IF
91
92	IF (op.EQ."t_min(X)") THEN
93	reformaop = "minimum"
94	END IF
95
96	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
97	END FUNCTION reformaop
98
99	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
100	! Routine d'initialisation !!!!!!!!!!!!!
101	! A lancer juste après mpi_init !!!!!!!!!!!!!
102	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
103
104	SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
105	USE print_control_mod, ONLY : prt_level, lunout
106	IMPLICIT NONE
107
108	CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
109	INTEGER, INTENT(IN), OPTIONAL :: locom
110	INTEGER, INTENT(OUT), OPTIONAL :: outcom
111	CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
112
113
114	TYPE(xios_context) :: xios_ctx
115	INTEGER :: xios_comm
116
117	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
118
119
120
121	IF (PRESENT(locom)) THEN
122	CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
123	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
124	ELSE
125	CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
126	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
127	END IF
128
129	IF (PRESENT(outcom)) THEN
130	outcom = xios_comm
131	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
132	END IF
133
134	!Enregistrement des variables globales:
135	g_comm = xios_comm
136	g_ctx_name = xios_ctx_name
137
138	! ! Si couple alors init fait dans cpl_init
139	! IF (.not. PRESENT(type_ocean)) THEN
140	! CALL wxios_context_init()
141	! ENDIF
142
143	END SUBROUTINE wxios_init
144
145	SUBROUTINE wxios_context_init()
146	USE print_control_mod, ONLY : prt_level, lunout
147	USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
148	IMPLICIT NONE
149
150	TYPE(xios_context) :: xios_ctx
151
152	!$OMP MASTER
153	!Initialisation du contexte:
154	!!CALL xios_context_initialize(g_ctx_name, g_comm)
155	CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
156	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
157	CALL xios_set_current_context(xios_ctx) !Activation
158	g_ctx = xios_ctx
159
160	IF (prt_level >= 10) THEN
161	WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
162	WRITE(lunout,*) " now call xios_solve_inheritance()"
163	ENDIF
164	!Une première analyse des héritages:
165	CALL xios_solve_inheritance()
166	!$OMP END MASTER
167	END SUBROUTINE wxios_context_init
168
169
170	SUBROUTINE wxios_set_context()
171	IMPLICIT NONE
172	TYPE(xios_context) :: xios_ctx
173
174	!$OMP MASTER
175	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
176	CALL xios_set_current_context(xios_ctx) !Activation
177	!$OMP END MASTER
178
179	END SUBROUTINE wxios_set_context
180
181	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
182	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
183	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
184
185	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
186	USE print_control_mod, ONLY : prt_level, lunout
187	IMPLICIT NONE
188
189	!Paramètres:
190	CHARACTER(len=*), INTENT(IN) :: calendrier
191	INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
192	REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
193
194	!Variables:
195	CHARACTER(len=80) :: abort_message
196	CHARACTER(len=19) :: date
197	INTEGER :: njour = 1
198
199	!Variables pour xios:
200	TYPE(xios_duration) :: mdtime
201	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
202
203	mdtime%second=pasdetemps
204
205	!Réglage du calendrier:
206	SELECT CASE (calendrier)
207	CASE('earth_360d')
208	CALL xios_define_calendar("D360")
209	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
210	CASE('earth_365d')
211	CALL xios_define_calendar("NoLeap")
212	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
213	CASE('gregorian')
214	CALL xios_define_calendar("Gregorian")
215	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
216	CASE DEFAULT
217	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
218	CALL abort_physic('Gcm:Xios',abort_message,1)
219	END SELECT
220
221	!Formatage de la date d'origine:
222	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
223
224	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
225	CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
226
227	!Formatage de la date de debut:
228
229	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
230
231	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
232
233	CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
234
235	!Et enfin,le pas de temps:
236	CALL xios_set_timestep(mdtime)
237	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
238	END SUBROUTINE wxios_set_cal
239
240	SUBROUTINE wxios_set_timestep(ts)
241	REAL, INTENT(IN) :: ts
242	TYPE(xios_duration) :: mdtime
243
244	mdtime%timestep = ts
245
246	CALL xios_set_timestep(mdtime)
247	END SUBROUTINE wxios_set_timestep
248
249	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
250	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
251	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
252	SUBROUTINE wxios_domain_param(dom_id)
253	USE dimphy, only: klon
254	USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
255	USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
256	mpi_size, mpi_rank, klon_mpi, &
257	is_sequential, is_south_pole_dyn
258	USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
259	USE print_control_mod, ONLY : prt_level, lunout
260	USE geometry_mod
261
262	IMPLICIT NONE
263	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
264
265	REAL :: rlat_glo(klon_glo)
266	REAL :: rlon_glo(klon_glo)
267	REAL :: io_lat(nbp_lat)
268	REAL :: io_lon(nbp_lon)
269	LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
270	TYPE(xios_domain) :: dom
271	INTEGER :: i
272	LOGICAL :: boool
273
274
275
276	CALL gather(latitude_deg,rlat_glo)
277	CALL bcast(rlat_glo)
278	CALL gather(longitude_deg,rlon_glo)
279	CALL bcast(rlon_glo)
280
281	!$OMP MASTER
282	io_lat(1)=rlat_glo(1)
283	io_lat(nbp_lat)=rlat_glo(klon_glo)
284	IF ((nbp_lon*nbp_lat) > 1) then
285	DO i=2,nbp_lat-1
286	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
287	ENDDO
288	ENDIF
289
290	IF (klon_glo == 1) THEN
291	io_lon(1)=rlon_glo(1)
292	ELSE
293	io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
294	ENDIF
295
296
297	!On récupère le handle:
298	CALL xios_get_domain_handle(dom_id, dom)
299
300	!On parametrise le domaine:
301	CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
302	CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
303	CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
304	CALL xios_set_domain_attr("dom_out", domain_ref=dom_id)
305
306	!On definit un axe de latitudes pour les moyennes zonales
307	IF (xios_is_valid_axis("axis_lat")) THEN
308	CALL xios_set_axis_attr( "axis_lat", n_glo=nbp_lat, n=jj_nb, begin=jj_begin-1, value=io_lat(jj_begin:jj_end))
309	ENDIF
310
311	IF (.NOT.is_sequential) THEN
312	mask(:,:)=.TRUE.
313	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
314	if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
315	! special case for south pole
316	if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
317	IF (prt_level >= 10) THEN
318	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
319	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
320	ENDIF
321	CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
322	END IF
323
324	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
325	!Vérification:
326	IF (xios_is_valid_domain(dom_id)) THEN
327	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
328	ELSE
329	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
330	END IF
331	!$OMP END MASTER
332
333	END SUBROUTINE wxios_domain_param
334
335
336	SUBROUTINE wxios_domain_param_unstructured(dom_id)
337	USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
338	USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
339	USE mod_phys_lmdz_para
340	USE nrtype, ONLY : PI
341	USE ioipsl_getin_p_mod, ONLY : getin_p
342	IMPLICIT NONE
343	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
344	REAL :: lon_mpi(klon_mpi)
345	REAL :: lat_mpi(klon_mpi)
346	REAL :: boundslon_mpi(klon_mpi,nvertex)
347	REAL :: boundslat_mpi(klon_mpi,nvertex)
348	INTEGER :: ind_cell_glo_mpi(klon_mpi)
349	TYPE(xios_domain) :: dom
350	LOGICAL :: remap_output
351
352	CALL gather_omp(longitude*180/PI,lon_mpi)
353	CALL gather_omp(latitude*180/PI,lat_mpi)
354	CALL gather_omp(boundslon*180/PI,boundslon_mpi)
355	CALL gather_omp(boundslat*180/PI,boundslat_mpi)
356	CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
357
358	remap_output=.TRUE.
359	CALL getin_p("remap_output",remap_output)
360
361	!$OMP MASTER
362	CALL xios_get_domain_handle(dom_id, dom)
363
364	!On parametrise le domaine:
365	CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
366	CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
367	bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
368	CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
369	IF (remap_output) THEN
370	CALL xios_set_domain_attr("dom_out", domain_ref="dom_regular")
371	CALL xios_set_fieldgroup_attr("dom_out", domain_ref="dom_regular")
372	CALL xios_set_fieldgroup_attr("remap_expr", expr="@this_ref")
373	ENDIF
374	!$OMP END MASTER
375
376	END SUBROUTINE wxios_domain_param_unstructured
377
378
379
380
381	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
382	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
383	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
384	SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value, &
385	positif, bnds)
386	USE print_control_mod, ONLY : prt_level, lunout
387	IMPLICIT NONE
388
389	CHARACTER (len=*), INTENT(IN) :: axis_id
390	INTEGER, INTENT(IN) :: axis_size
391	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
392	CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
393	REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
394
395	! TYPE(xios_axisgroup) :: axgroup
396	! TYPE(xios_axis) :: ax
397	! CHARACTER(len=50) :: axis_id
398
399	! IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
400	! WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
401	! WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
402	! CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
403	! ENDIF
404	! axis_id=trim(axisgroup_id)
405
406	!On récupère le groupe d'axes qui va bien:
407	!CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
408
409	!On ajoute l'axe correspondant à ce fichier:
410	!CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
411
412	!Et on le parametrise:
413	!CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
414
415	! Ehouarn: New way to declare axis, without axis_group:
416	if (PRESENT(positif) .AND. PRESENT(bnds)) then
417	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
418	positive=positif, bounds=bnds)
419	else if (PRESENT(positif)) then
420	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
421	positive=positif)
422	else if (PRESENT(bnds)) then
423	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
424	bounds=bnds)
425	else
426	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
427	endif
428
429	!Vérification:
430	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
431	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
432	ELSE
433	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
434	END IF
435
436	END SUBROUTINE wxios_add_vaxis
437
438
439	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
440	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
441	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
442	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
443	USE print_control_mod, ONLY : prt_level, lunout
444	IMPLICIT NONE
445
446	CHARACTER(len=*), INTENT(IN) :: fname
447	CHARACTER(len=*), INTENT(IN) :: ffreq
448	INTEGER, INTENT(IN) :: flvl
449
450	TYPE(xios_file) :: x_file
451	TYPE(xios_filegroup) :: x_fg
452	TYPE(xios_duration) :: nffreq
453
454	!On regarde si le fichier n'est pas défini par XML:
455	IF (.NOT.xios_is_valid_file(fname)) THEN
456	!On créé le noeud:
457	CALL xios_get_filegroup_handle("defile", x_fg)
458	CALL xios_add_file(x_fg, x_file, fname)
459
460	!On reformate la fréquence:
461	CALL reformadate(ffreq, nffreq)
462
463	!On configure:
464	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
465	output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
466
467	IF (xios_is_valid_file("X"//fname)) THEN
468	IF (prt_level >= 10) THEN
469	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
470	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
471	ENDIF
472	ELSE
473	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
474	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
475	END IF
476	ELSE
477	IF (prt_level >= 10) THEN
478	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
479	ENDIF
480	! Ehouarn: add an enable=.true. on top of xml definitions... why???
481	CALL xios_set_file_attr(fname, enabled=.TRUE.)
482	END IF
483	END SUBROUTINE wxios_add_file
484
485	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
486	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
487	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
488	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
489	USE netcdf, only: nf90_fill_real
490
491	IMPLICIT NONE
492	INCLUDE 'iniprint.h'
493
494	CHARACTER(len=*), INTENT(IN) :: fieldname
495	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
496	CHARACTER(len=*), INTENT(IN) :: fieldlongname
497	CHARACTER(len=*), INTENT(IN) :: fieldunit
498
499	TYPE(xios_field) :: field
500	CHARACTER(len=10) :: newunit
501	REAL(KIND=8) :: def
502
503	!La valeur par défaut des champs non définis:
504	def = nf90_fill_real
505
506	IF (fieldunit .EQ. " ") THEN
507	newunit = "-"
508	ELSE
509	newunit = fieldunit
510	ENDIF
511
512	!On ajoute le champ:
513	CALL xios_add_field(fieldgroup, field, fieldname)
514	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
515
516	!On rentre ses paramètres:
517	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
518	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
519	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
520
521	END SUBROUTINE wxios_add_field
522
523	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
524	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
525	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
526	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
527	USE print_control_mod, ONLY : prt_level, lunout
528	IMPLICIT NONE
529
530	CHARACTER(len=*), INTENT(IN) :: fieldname
531	INTEGER, INTENT(IN) :: fdim, fid
532	CHARACTER(len=*), INTENT(IN) :: fname
533	CHARACTER(len=*), INTENT(IN) :: fieldlongname
534	CHARACTER(len=*), INTENT(IN) :: fieldunit
535	INTEGER, INTENT(IN) :: field_level
536	CHARACTER(len=*), INTENT(IN) :: op
537
538	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
539	CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
540	CHARACTER(len=100) :: operation
541	TYPE(xios_file) :: f
542	TYPE(xios_field) :: field
543	TYPE(xios_fieldgroup) :: fieldgroup
544	TYPE(xios_duration) :: freq_op
545
546	LOGICAL :: bool=.FALSE.
547	INTEGER :: lvl =0
548
549
550	! Ajout Abd pour NMC:
551	IF (fid.LE.6) THEN
552	axis_id="presnivs"
553	ELSE
554	axis_id="plev"
555	ENDIF
556
557	IF (PRESENT(nam_axvert)) THEN
558	axis_id=nam_axvert
559	print*,'nam_axvert=',axis_id
560	ENDIF
561
562	!on prépare le nom de l'opération:
563	operation = reformaop(op)
564
565
566	!On selectionne le bon groupe de champs:
567	IF (fdim.EQ.2) THEN
568	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
569	ELSE
570	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
571	ENDIF
572
573	!On regarde si le champ à déjà été créé ou non:
574	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
575	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
576	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
577	g_flag_xml = .TRUE.
578	g_field_name = fieldname
579
580	ELSE IF (.NOT. g_field_name == fieldname) THEN
581	!Si premier pssage et champ indéfini, alors on le créé
582
583	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
584
585	!On le créé:
586	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
587	IF (xios_is_valid_field(fieldname)) THEN
588	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
589	ENDIF
590
591	g_flag_xml = .FALSE.
592	g_field_name = fieldname
593
594	END IF
595
596	IF (.NOT. g_flag_xml) THEN
597	!Champ existe déjà, mais pas XML, alors on l'ajoute
598	!On ajoute le champ:
599	CALL xios_get_file_handle(fname, f)
600	CALL xios_add_fieldtofile(f, field)
601
602
603	!L'operation, sa frequence:
604	freq_op%timestep=1
605	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
606
607
608	!On rentre ses paramètres:
609	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
610
611	IF (fdim.EQ.2) THEN
612	!Si c'est un champ 2D:
613	IF (prt_level >= 10) THEN
614	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
615	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
616	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
617	ENDIF
618	ELSE
619	!Si 3D :
620	!On ajoute l'axe vertical qui va bien:
621	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
622
623	IF (prt_level >= 10) THEN
624	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
625	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
626	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
627	ENDIF
628	END IF
629
630	ELSE
631	!Sinon on se contente de l'activer:
632	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
633	!NB: This will override an enable=.false. set by a user in the xml file;
634	! then the only way to not output the field is by changing its
635	! output level
636	ENDIF
637
638	END SUBROUTINE wxios_add_field_to_file
639
640	! SUBROUTINE wxios_update_calendar(ito)
641	! INTEGER, INTENT(IN) :: ito
642	! CALL xios_update_calendar(ito)
643	! END SUBROUTINE wxios_update_calendar
644	!
645	! SUBROUTINE wxios_write_2D(fieldname, fdata)
646	! CHARACTER(len=*), INTENT(IN) :: fieldname
647	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
648	!
649	! CALL xios_send_field(fieldname, fdata)
650	! END SUBROUTINE wxios_write_2D
651
652	! SUBROUTINE wxios_write_3D(fieldname, fdata)
653	! CHARACTER(len=*), INTENT(IN) :: fieldname
654	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
655	!
656	! CALL xios_send_field(fieldname, fdata)
657	! END SUBROUTINE wxios_write_3D
658
659	SUBROUTINE wxios_closedef()
660	CALL xios_close_context_definition()
661	! CALL xios_update_calendar(0)
662	END SUBROUTINE wxios_closedef
663
664	SUBROUTINE wxios_close()
665	CALL xios_context_finalize()
666	CALL xios_finalize()
667	END SUBROUTINE wxios_close
668	END MODULE wxios
669	#endif

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

Download in other formats:

Original Format