Context Navigation

wxios.F90 @ 5440

Last change on this file since 5440 was 2002, checked in by Ehouarn Millour, 11 years ago
Further cleanup concerning XIOS (mainly about axes being defined as axes and not as groups of axes). EM
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.3 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(axis_id, axis_size, axis_value)
295	IMPLICIT NONE
296	INCLUDE 'iniprint.h'
297
298	CHARACTER (len=*), INTENT(IN) :: axis_id
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	! Ehouarn: New way to declare axis, without axis_group:
323	CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value)
324
325	!Vérification:
326	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
327	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
328	ELSE
329	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
330	END IF
331
332	END SUBROUTINE wxios_add_vaxis
333
334
335	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
336	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
337	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
338	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
339	IMPLICIT NONE
340	INCLUDE 'iniprint.h'
341
342	CHARACTER(len=*), INTENT(IN) :: fname
343	CHARACTER(len=*), INTENT(IN) :: ffreq
344	INTEGER, INTENT(IN) :: flvl
345
346	TYPE(xios_file) :: x_file
347	TYPE(xios_filegroup) :: x_fg
348	CHARACTER(len=100) :: nffreq
349
350	!On regarde si le fichier n'est pas défini par XML:
351	IF (.NOT.xios_is_valid_file(fname)) THEN
352	!On créé le noeud:
353	CALL xios_get_filegroup_handle("defile", x_fg)
354	CALL xios_add_file(x_fg, x_file, fname)
355
356	!On reformate la fréquence:
357	CALL reformadate(ffreq, nffreq)
358
359	!On configure:
360	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
361	output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
362
363	IF (xios_is_valid_file("X"//fname)) THEN
364	IF (prt_level >= 10) THEN
365	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
366	WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
367	ENDIF
368	ELSE
369	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
370	WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
371	END IF
372	ELSE
373	IF (prt_level >= 10) THEN
374	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
375	ENDIF
376	! Ehouarn: add an enable=.true. on top of xml definitions... why???
377	CALL xios_set_file_attr(fname, enabled=.TRUE.)
378	END IF
379	END SUBROUTINE wxios_add_file
380
381	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
382	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
383	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
384	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
385	USE netcdf, only: nf90_fill_real
386
387	IMPLICIT NONE
388	INCLUDE 'iniprint.h'
389
390	CHARACTER(len=*), INTENT(IN) :: fieldname
391	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
392	CHARACTER(len=*), INTENT(IN) :: fieldlongname
393	CHARACTER(len=*), INTENT(IN) :: fieldunit
394
395	TYPE(xios_field) :: field
396	CHARACTER(len=10) :: newunit
397	REAL(KIND=8) :: def
398
399	!La valeur par défaut des champs non définis:
400	def = nf90_fill_real
401
402	IF (fieldunit .EQ. " ") THEN
403	newunit = "-"
404	ELSE
405	newunit = fieldunit
406	ENDIF
407
408	!On ajoute le champ:
409	CALL xios_add_field(fieldgroup, field, fieldname)
410	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
411
412	!On rentre ses paramètres:
413	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
414	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
415	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
416
417	END SUBROUTINE wxios_add_field
418
419	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
420	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
421	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
422	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op)
423	IMPLICIT NONE
424	INCLUDE 'iniprint.h'
425
426	CHARACTER(len=*), INTENT(IN) :: fieldname
427	INTEGER, INTENT(IN) :: fdim, fid
428	CHARACTER(len=*), INTENT(IN) :: fname
429	CHARACTER(len=*), INTENT(IN) :: fieldlongname
430	CHARACTER(len=*), INTENT(IN) :: fieldunit
431	INTEGER, INTENT(IN) :: field_level
432	CHARACTER(len=*), INTENT(IN) :: op
433
434	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
435	CHARACTER(len=100) :: operation
436	TYPE(xios_file) :: f
437	TYPE(xios_field) :: field
438	TYPE(xios_fieldgroup) :: fieldgroup
439	LOGICAL :: bool=.FALSE.
440	INTEGER :: lvl =0
441
442
443	! Ajout Abd pour NMC:
444	IF (fid.LE.6) THEN
445	axis_id="presnivs"
446	ELSE
447	axis_id="plev"
448	ENDIF
449
450	!on prépare le nom de l'opération:
451	operation = reformaop(op)
452
453
454	!On selectionne le bon groupe de champs:
455	IF (fdim.EQ.2) THEN
456	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
457	ELSE
458	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
459	ENDIF
460
461	!On regarde si le champ à déjà été créé ou non:
462	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
463	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
464	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
465	g_flag_xml = .TRUE.
466	g_field_name = fieldname
467
468	ELSE IF (.NOT. g_field_name == fieldname) THEN
469	!Si premier pssage et champ indéfini, alors on le créé
470
471	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
472
473	!On le créé:
474	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
475	IF (xios_is_valid_field(fieldname)) THEN
476	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
477	ENDIF
478
479	g_flag_xml = .FALSE.
480	g_field_name = fieldname
481
482	END IF
483
484	IF (.NOT. g_flag_xml) THEN
485	!Champ existe déjà, mais pas XML, alors on l'ajoute
486	!On ajoute le champ:
487	CALL xios_get_file_handle(fname, f)
488	CALL xios_add_fieldtofile(f, field)
489
490
491	!L'operation, sa frequence:
492	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
493
494
495	!On rentre ses paramètres:
496	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
497
498	IF (fdim.EQ.2) THEN
499	!Si c'est un champ 2D:
500	IF (prt_level >= 10) THEN
501	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
502	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
503	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
504	ENDIF
505	ELSE
506	!Si 3D :
507	!On ajoute l'axe vertical qui va bien:
508	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
509
510	IF (prt_level >= 10) THEN
511	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
512	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
513	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
514	ENDIF
515	END IF
516
517	ELSE
518	!Sinon on se contente de l'activer:
519	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
520	!NB: This will override an enable=.false. set by a user in the xml file;
521	! then the only way to not output the field is by changing its
522	! output level
523	ENDIF
524
525	END SUBROUTINE wxios_add_field_to_file
526
527	! SUBROUTINE wxios_update_calendar(ito)
528	! INTEGER, INTENT(IN) :: ito
529	! CALL xios_update_calendar(ito)
530	! END SUBROUTINE wxios_update_calendar
531	!
532	! SUBROUTINE wxios_write_2D(fieldname, fdata)
533	! CHARACTER(len=*), INTENT(IN) :: fieldname
534	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
535	!
536	! CALL xios_send_field(fieldname, fdata)
537	! END SUBROUTINE wxios_write_2D
538
539	! SUBROUTINE wxios_write_3D(fieldname, fdata)
540	! CHARACTER(len=*), INTENT(IN) :: fieldname
541	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
542	!
543	! CALL xios_send_field(fieldname, fdata)
544	! END SUBROUTINE wxios_write_3D
545
546	SUBROUTINE wxios_closedef()
547	CALL xios_close_context_definition()
548	CALL xios_update_calendar(0)
549	END SUBROUTINE wxios_closedef
550
551	SUBROUTINE wxios_close()
552	CALL xios_context_finalize()
553	CALL xios_finalize()
554	END SUBROUTINE wxios_close
555	END MODULE wxios
556	#endif

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

Download in other formats:

Original Format