Context Navigation

wxios.F90 @ 2095

Last change on this file since 2095 was 2095, checked in by Laurent Fairhead, 10 years ago

Modifications nécessaires pour la bonne définition du temps dans les
fichier Xios

Necessary modifications for the definition of time in Xios files

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

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

Download in other formats:

Original Format