Context Navigation

wxios.F90 @ 2001

Last change on this file since 2001 was 2001, checked in by Ehouarn Millour, 10 years ago

Updates for XIOS outputs. NMC outputs now OK, as long as these are in output files number 6 and more (phys_out_filenames ordering in config.def).
Among things that need be worked on further with XIOS:

Station outputs form and format.
Extra axes can only be included in XIOS files if linked to given variables.
Further splitting of the XML files as iodef.xml, context_lmdz.xml, field_def_lmdz.xml and file_def_hist*_lmdz.xml.

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: 21.0 KB

Line
1	! $Id: wxios.F90 $
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
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
24
25	CONTAINS
26
27	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28	! 36day => 36d etc !!!!!!!!!!!!!!!!!!!!
29	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
30
31	SUBROUTINE reformadate(odate, ndate)
32	CHARACTER(len=*), INTENT(IN) :: odate
33	CHARACTER(len=100), INTENT(OUT) :: ndate
34
35	INTEGER :: i = 0
36	!!!!!!!!!!!!!!!!!!
37	! Pour XIOS:
38	! year : y
39	! month : mo
40	! day : d
41	! hour : h
42	! minute : mi
43	! second : s
44	!!!!!!!!!!!!!!!!!!
45
46	i = INDEX(odate, "day")
47	IF (i > 0) THEN
48	ndate = odate(1:i-1)//"d"
49	END IF
50
51	i = INDEX(odate, "hr")
52	IF (i > 0) THEN
53	ndate = odate(1:i-1)//"h"
54	END IF
55
56	i = INDEX(odate, "mth")
57	IF (i > 0) THEN
58	ndate = odate(1:i-1)//"mo"
59	END IF
60
61	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
62	END SUBROUTINE reformadate
63
64	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
65	! ave(X) => average etc !!!!!!!!!!!!!!!
66	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
67
68	CHARACTER(len=7) FUNCTION reformaop(op)
69	CHARACTER(len=*), INTENT(IN) :: op
70
71	INTEGER :: i = 0
72	reformaop = "average"
73
74	IF (op.EQ."inst(X)") THEN
75	reformaop = "instant"
76	END IF
77
78	IF (op.EQ."once") THEN
79	reformaop = "once"
80	END IF
81
82	IF (op.EQ."t_max(X)") THEN
83	reformaop = "maximum"
84	END IF
85
86	IF (op.EQ."t_min(X)") THEN
87	reformaop = "minimum"
88	END IF
89
90	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
91	END FUNCTION reformaop
92
93	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
94	! Routine d'initialisation !!!!!!!!!!!!!
95	! A lancer juste après mpi_init !!!!!!!!!!!!!
96	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
97
98	SUBROUTINE wxios_init(xios_ctx_name, locom, outcom)
99	IMPLICIT NONE
100	INCLUDE 'iniprint.h'
101
102	CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
103	INTEGER, INTENT(IN), OPTIONAL :: locom
104	INTEGER, INTENT(OUT), OPTIONAL :: outcom
105
106
107	TYPE(xios_context) :: xios_ctx
108	INTEGER :: xios_comm
109
110	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
111
112
113
114	IF (PRESENT(locom)) THEN
115	CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
116	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
117	ELSE
118	CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
119	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
120	END IF
121
122	IF (PRESENT(outcom)) THEN
123	outcom = xios_comm
124	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
125	END IF
126
127	!Enregistrement des variables globales:
128	g_comm = xios_comm
129	g_ctx_name = xios_ctx_name
130
131	CALL wxios_context_init()
132
133	END SUBROUTINE wxios_init
134
135	SUBROUTINE wxios_context_init()
136	IMPLICIT NONE
137	INCLUDE 'iniprint.h'
138
139	TYPE(xios_context) :: xios_ctx
140
141	!Initialisation du contexte:
142	CALL xios_context_initialize(g_ctx_name, g_comm)
143	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
144	CALL xios_set_current_context(xios_ctx) !Activation
145	g_ctx = xios_ctx
146
147	IF (prt_level >= 10) THEN
148	WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
149	WRITE(lunout,*) " now call xios_solve_inheritance()"
150	ENDIF
151	!Une première analyse des héritages:
152	CALL xios_solve_inheritance()
153	END SUBROUTINE wxios_context_init
154
155	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
156	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
157	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
158
159	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
160	IMPLICIT NONE
161	INCLUDE 'iniprint.h'
162
163	!Paramètres:
164	CHARACTER(len=*), INTENT(IN) :: calendrier
165	INTEGER, INTENT(IN) :: annee, mois, jour
166	REAL, INTENT(IN) :: pasdetemps, heure
167
168	!Variables:
169	CHARACTER(len=80) :: abort_message
170	CHARACTER(len=19) :: date
171	INTEGER :: njour = 1
172
173	!Variables pour xios:
174	TYPE(xios_time) :: mdtime
175	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
176
177	mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
178
179	!Réglage du calendrier:
180	SELECT CASE (calendrier)
181	CASE('earth_360d')
182	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
183	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
184	CASE('earth_365d')
185	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
186	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
187	CASE('earth_366d')
188	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
189	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
190	CASE DEFAULT
191	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
192	CALL abort_gcm('Gcm:Xios',abort_message,1)
193	END SELECT
194
195	!Formatage de la date de départ:
196	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
197
198	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
199
200	CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
201
202	!Et enfin,le pas de temps:
203	CALL xios_set_timestep(mdtime)
204	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
205	END SUBROUTINE wxios_set_cal
206
207	SUBROUTINE wxios_set_timestep(ts)
208	REAL, INTENT(IN) :: ts
209	TYPE(xios_time) :: mdtime
210
211	mdtime = xios_time(0, 0, 0, 0, 0, ts)
212
213	CALL xios_set_timestep(mdtime)
214	END SUBROUTINE wxios_set_timestep
215
216	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
217	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
218	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
219	SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, &
220	ibegin, iend, ii_begin, ii_end, jbegin, jend, &
221	data_ni, data_ibegin, data_iend, &
222	io_lat, io_lon,is_south_pole,mpi_rank)
223
224
225	IMPLICIT NONE
226	INCLUDE 'iniprint.h'
227
228	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
229	LOGICAL,INTENT(IN) :: is_sequential ! flag
230	INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
231	INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
232	INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
233	INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
234	INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
235	INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
236	INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
237	INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
238	INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
239	INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
240	INTEGER,INTENT(IN) :: data_ni
241	INTEGER,INTENT(IN) :: data_ibegin
242	INTEGER,INTENT(IN) :: data_iend
243	REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
244	REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
245	logical,intent(in) :: is_south_pole ! does this process include the south pole?
246	integer,intent(in) :: mpi_rank ! rank of process
247
248	TYPE(xios_domain) :: dom
249	LOGICAL :: boool
250
251	!Masque pour les problèmes de recouvrement MPI:
252	LOGICAL :: mask(ni,nj)
253
254	!On récupère le handle:
255	CALL xios_get_domain_handle(dom_id, dom)
256
257	IF (prt_level >= 10) THEN
258	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
259	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
260	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
261	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
262	ENDIF
263
264	!On parametrise le domaine:
265	CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin, ni=ni)
266	CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin, nj=nj, data_dim=2)
267	CALL xios_set_domain_attr_hdl(dom, lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
268
269	IF (.NOT.is_sequential) THEN
270	mask(:,:)=.TRUE.
271	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
272	if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
273	! special case for south pole
274	if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
275	IF (prt_level >= 10) THEN
276	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
277	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
278	ENDIF
279	CALL xios_set_domain_attr_hdl(dom, mask=mask)
280	END IF
281
282	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
283	!Vérification:
284	IF (xios_is_valid_domain(dom_id)) THEN
285	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
286	ELSE
287	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
288	END IF
289	END SUBROUTINE wxios_domain_param
290
291	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
292	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
293	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
294	SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file, axis_size, axis_value)
295	IMPLICIT NONE
296	INCLUDE 'iniprint.h'
297
298	CHARACTER (len=*), INTENT(IN) :: axisgroup_id, axis_file
299	INTEGER, INTENT(IN) :: axis_size
300	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
301
302	TYPE(xios_axisgroup) :: axgroup
303	TYPE(xios_axis) :: ax
304	CHARACTER(len=50) :: axis_id
305
306	IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
307	WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
308	WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
309	CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
310	ENDIF
311	axis_id=trim(axisgroup_id)
312
313	!On récupère le groupe d'axes qui va bien:
314	CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
315
316	!On ajoute l'axe correspondant à ce fichier:
317	CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
318
319	!Et on le parametrise:
320	CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
321
322	!Vérification:
323	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
324	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
325	ELSE
326	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
327	END IF
328
329	END SUBROUTINE wxios_add_vaxis
330
331
332	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
333	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
334	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
335	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
336	IMPLICIT NONE
337	INCLUDE 'iniprint.h'
338
339	CHARACTER(len=*), INTENT(IN) :: fname
340	CHARACTER(len=*), INTENT(IN) :: ffreq
341	INTEGER, INTENT(IN) :: flvl
342
343	TYPE(xios_file) :: x_file
344	TYPE(xios_filegroup) :: x_fg
345	CHARACTER(len=100) :: nffreq
346
347	!On regarde si le fichier n'est pas défini par XML:
348	IF (.NOT.xios_is_valid_file(fname)) THEN
349	!On créé le noeud:
350	CALL xios_get_filegroup_handle("defile", x_fg)
351	CALL xios_add_file(x_fg, x_file, fname)
352
353	!On reformate la fréquence:
354	CALL reformadate(ffreq, nffreq)
355
356	!On configure:
357	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
358	output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
359
360	IF (xios_is_valid_file("X"//fname)) THEN
361	IF (prt_level >= 10) THEN
362	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
363	WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
364	ENDIF
365	ELSE
366	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
367	WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
368	END IF
369	ELSE
370	IF (prt_level >= 10) THEN
371	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
372	ENDIF
373	! Ehouarn: add an enable=.true. on top of xml definitions... why???
374	CALL xios_set_file_attr(fname, enabled=.TRUE.)
375	END IF
376	END SUBROUTINE wxios_add_file
377
378	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
379	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
380	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
381	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
382	USE netcdf, only: nf90_fill_real
383
384	IMPLICIT NONE
385	INCLUDE 'iniprint.h'
386
387	CHARACTER(len=*), INTENT(IN) :: fieldname
388	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
389	CHARACTER(len=*), INTENT(IN) :: fieldlongname
390	CHARACTER(len=*), INTENT(IN) :: fieldunit
391
392	TYPE(xios_field) :: field
393	CHARACTER(len=10) :: newunit
394	REAL(KIND=8) :: def
395
396	!La valeur par défaut des champs non définis:
397	def = nf90_fill_real
398
399	IF (fieldunit .EQ. " ") THEN
400	newunit = "-"
401	ELSE
402	newunit = fieldunit
403	ENDIF
404
405	!On ajoute le champ:
406	CALL xios_add_field(fieldgroup, field, fieldname)
407	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
408
409	!On rentre ses paramètres:
410	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
411	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
412	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
413
414	END SUBROUTINE wxios_add_field
415
416	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
417	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
418	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
419	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
420	IMPLICIT NONE
421	INCLUDE 'iniprint.h'
422
423	CHARACTER(len=*), INTENT(IN) :: fieldname
424	INTEGER, INTENT(IN) :: fdim, fid
425	CHARACTER(len=*), INTENT(IN) :: fname
426	CHARACTER(len=*), INTENT(IN) :: fieldlongname
427	CHARACTER(len=*), INTENT(IN) :: fieldunit
428	INTEGER, INTENT(IN) :: field_level
429	CHARACTER(len=*), INTENT(IN) :: op
430
431	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
432	CHARACTER(len=100) :: operation
433	TYPE(xios_file) :: f
434	TYPE(xios_field) :: field
435	TYPE(xios_fieldgroup) :: fieldgroup
436	LOGICAL :: bool=.FALSE.
437	INTEGER :: lvl =0
438
439
440	! Ajout Abd pour NMC:
441	IF (fid.LE.6) THEN
442	axis_id="presnivs"
443	ELSE
444	axis_id="plev"
445	ENDIF
446
447	!on prépare le nom de l'opération:
448	operation = reformaop(op)
449
450
451	!On selectionne le bon groupe de champs:
452	IF (fdim.EQ.2) THEN
453	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
454	ELSE
455	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
456	ENDIF
457
458	!On regarde si le champ à déjà été créé ou non:
459	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
460	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
461	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
462	g_flag_xml = .TRUE.
463	g_field_name = fieldname
464
465	ELSE IF (.NOT. g_field_name == fieldname) THEN
466	!Si premier pssage et champ indéfini, alors on le créé
467
468	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
469
470	!On le créé:
471	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
472	IF (xios_is_valid_field(fieldname)) THEN
473	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
474	ENDIF
475
476	g_flag_xml = .FALSE.
477	g_field_name = fieldname
478
479	END IF
480
481	IF (.NOT. g_flag_xml) THEN
482	!Champ existe déjà, mais pas XML, alors on l'ajoute
483	!On ajoute le champ:
484	CALL xios_get_file_handle(fname, f)
485	CALL xios_add_fieldtofile(f, field)
486
487
488	!L'operation, sa frequence:
489	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
490
491
492	!On rentre ses paramètres:
493	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
494
495	IF (fdim.EQ.2) THEN
496	!Si c'est un champ 2D:
497	IF (prt_level >= 10) THEN
498	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
499	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
500	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
501	ENDIF
502	ELSE
503	!Si 3D :
504	!On ajoute l'axe vertical qui va bien:
505	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
506
507	IF (prt_level >= 10) THEN
508	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
509	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
510	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
511	ENDIF
512	END IF
513
514	ELSE
515	!Sinon on se contente de l'activer:
516	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
517	ENDIF
518
519	END SUBROUTINE wxios_add_field_to_file
520
521	SUBROUTINE wxios_update_calendar(ito)
522	INTEGER, INTENT(IN) :: ito
523	CALL xios_update_calendar(ito)
524	END SUBROUTINE wxios_update_calendar
525
526	SUBROUTINE wxios_write_2D(fieldname, fdata)
527	CHARACTER(len=*), INTENT(IN) :: fieldname
528	REAL, DIMENSION(:,:), INTENT(IN) :: fdata
529
530	CALL xios_send_field(fieldname, fdata)
531	END SUBROUTINE wxios_write_2D
532
533	SUBROUTINE wxios_write_3D(fieldname, fdata)
534	CHARACTER(len=*), INTENT(IN) :: fieldname
535	REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
536
537	CALL xios_send_field(fieldname, fdata)
538	END SUBROUTINE wxios_write_3D
539
540	SUBROUTINE wxios_closedef()
541	CALL xios_close_context_definition()
542	CALL xios_update_calendar(0)
543	END SUBROUTINE wxios_closedef
544
545	SUBROUTINE wxios_close()
546	CALL xios_context_finalize()
547	CALL xios_finalize()
548	END SUBROUTINE wxios_close
549	END MODULE wxios
550	#endif

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

Download in other formats:

Original Format