Context Navigation

wxios.F90 @ 1985

Last change on this file since 1985 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

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: 20.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	! str + i => str_i !!!!!!!!!!!!!!!!!!!!
29	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
30
31	SUBROUTINE concat(str, str2, str_str2)
32	CHARACTER(len=*), INTENT(IN) :: str, str2
33	CHARACTER(len=20), INTENT(OUT) :: str_str2
34
35
36	str_str2 = TRIM(ADJUSTL(str//"_"//TRIM(ADJUSTL(str2))))
37	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ",str,"+",str2,"=",str_str2
38	END SUBROUTINE concat
39
40	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41	! 36day => 36d etc !!!!!!!!!!!!!!!!!!!!
42	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
43
44	SUBROUTINE reformadate(odate, ndate)
45	CHARACTER(len=*), INTENT(IN) :: odate
46	CHARACTER(len=100), INTENT(OUT) :: ndate
47
48	INTEGER :: i = 0
49	!!!!!!!!!!!!!!!!!!
50	! Pour XIOS:
51	! year : y
52	! month : mo
53	! day : d
54	! hour : h
55	! minute : mi
56	! second : s
57	!!!!!!!!!!!!!!!!!!
58
59	i = INDEX(odate, "day")
60	IF (i > 0) THEN
61	ndate = odate(1:i-1)//"d"
62	END IF
63
64	i = INDEX(odate, "hr")
65	IF (i > 0) THEN
66	ndate = odate(1:i-1)//"h"
67	END IF
68
69	i = INDEX(odate, "mth")
70	IF (i > 0) THEN
71	ndate = odate(1:i-1)//"mo"
72	END IF
73
74	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
75	END SUBROUTINE reformadate
76
77	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
78	! ave(X) => average etc !!!!!!!!!!!!!!!
79	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
80
81	CHARACTER(len=7) FUNCTION reformaop(op)
82	CHARACTER(len=*), INTENT(IN) :: op
83
84	INTEGER :: i = 0
85	reformaop = "average"
86
87	IF (op.EQ."inst(X)") THEN
88	reformaop = "instant"
89	END IF
90
91	IF (op.EQ."once") THEN
92	reformaop = "once"
93	END IF
94
95	IF (op.EQ."t_max(X)") THEN
96	reformaop = "maximum"
97	END IF
98
99	IF (op.EQ."t_min(X)") THEN
100	reformaop = "minimum"
101	END IF
102
103	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
104	END FUNCTION reformaop
105
106	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
107	! Routine d'initialisation !!!!!!!!!!!!!
108	! A lancer juste après mpi_init !!!!!!!!!!!!!
109	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
110
111	SUBROUTINE wxios_init(xios_ctx_name, locom, outcom)
112	IMPLICIT NONE
113	INCLUDE 'iniprint.h'
114
115	CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
116	INTEGER, INTENT(IN), OPTIONAL :: locom
117	INTEGER, INTENT(OUT), OPTIONAL :: outcom
118
119
120	TYPE(xios_context) :: xios_ctx
121	INTEGER :: xios_comm
122
123	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
124
125
126
127	IF (PRESENT(locom)) THEN
128	CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
129	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
130	ELSE
131	CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
132	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
133	END IF
134
135	IF (PRESENT(outcom)) THEN
136	outcom = xios_comm
137	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
138	END IF
139
140	!Enregistrement des variables globales:
141	g_comm = xios_comm
142	g_ctx_name = xios_ctx_name
143
144	CALL wxios_context_init()
145
146	END SUBROUTINE wxios_init
147
148	SUBROUTINE wxios_context_init()
149	IMPLICIT NONE
150	INCLUDE 'iniprint.h'
151
152	TYPE(xios_context) :: xios_ctx
153
154	!Initialisation du contexte:
155	CALL xios_context_initialize(g_ctx_name, g_comm)
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) WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
161
162	!Une première analyse des héritages:
163	CALL xios_solve_inheritance()
164	END SUBROUTINE wxios_context_init
165
166	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
167	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
168	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
169
170	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure)
171	IMPLICIT NONE
172	INCLUDE 'iniprint.h'
173
174	!Paramètres:
175	CHARACTER(len=*), INTENT(IN) :: calendrier
176	INTEGER, INTENT(IN) :: annee, mois, jour
177	REAL, INTENT(IN) :: pasdetemps, heure
178
179	!Variables:
180	CHARACTER(len=80) :: abort_message
181	CHARACTER(len=19) :: date
182	INTEGER :: njour = 1
183
184	!Variables pour xios:
185	TYPE(xios_time) :: mdtime
186	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
187
188	mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
189
190	!Réglage du calendrier:
191	SELECT CASE (calendrier)
192	CASE('earth_360d')
193	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
194	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
195	CASE('earth_365d')
196	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
197	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
198	CASE('earth_366d')
199	CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
200	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
201	CASE DEFAULT
202	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
203	CALL abort_gcm('Gcm:Xios',abort_message,1)
204	END SELECT
205
206	!Formatage de la date de départ:
207	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
208
209	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
210
211	CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
212
213	!Et enfin,le pas de temps:
214	CALL xios_set_timestep(mdtime)
215	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
216	END SUBROUTINE wxios_set_cal
217
218	SUBROUTINE wxios_set_timestep(ts)
219	REAL, INTENT(IN) :: ts
220	TYPE(xios_time) :: mdtime
221
222	mdtime = xios_time(0, 0, 0, 0, 0, ts)
223
224	CALL xios_set_timestep(mdtime)
225	END SUBROUTINE wxios_set_timestep
226
227	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
228	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
229	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
230	SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, &
231	ibegin, iend, ii_begin, ii_end, jbegin, jend, &
232	data_ni, data_ibegin, data_iend, &
233	io_lat, io_lon,is_south_pole,mpi_rank)
234
235
236	IMPLICIT NONE
237	INCLUDE 'iniprint.h'
238
239	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
240	LOGICAL,INTENT(IN) :: is_sequential ! flag
241	INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
242	INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
243	INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
244	INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
245	INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
246	INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
247	INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
248	INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
249	INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
250	INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
251	INTEGER,INTENT(IN) :: data_ni
252	INTEGER,INTENT(IN) :: data_ibegin
253	INTEGER,INTENT(IN) :: data_iend
254	REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
255	REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
256	logical,intent(in) :: is_south_pole ! does this process include the south pole?
257	integer,intent(in) :: mpi_rank ! rank of process
258
259	TYPE(xios_domain) :: dom
260	LOGICAL :: boool
261
262	!Masque pour les problèmes de recouvrement MPI:
263	LOGICAL :: mask(ni,nj)
264
265	!On récupère le handle:
266	CALL xios_get_domain_handle(dom_id, dom)
267
268	IF (prt_level >= 10) THEN
269	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
270	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
271	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
272	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
273	ENDIF
274
275	!On parametrise le domaine:
276	CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin, ni=ni)
277	CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin, nj=nj, data_dim=2)
278	CALL xios_set_domain_attr_hdl(dom, lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
279
280	IF (.NOT.is_sequential) THEN
281	mask(:,:)=.TRUE.
282	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
283	if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
284	! special case for south pole
285	if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
286	IF (prt_level >= 10) THEN
287	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
288	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
289	ENDIF
290	CALL xios_set_domain_attr_hdl(dom, mask=mask)
291	END IF
292
293	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
294	!Vérification:
295	IF (xios_is_valid_domain(dom_id)) THEN
296	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
297	ELSE
298	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
299	END IF
300	END SUBROUTINE wxios_domain_param
301
302	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
303	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
304	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
305	SUBROUTINE wxios_add_vaxis(axisgroup_id, axis_file, axis_size, axis_value)
306	IMPLICIT NONE
307	INCLUDE 'iniprint.h'
308
309	CHARACTER (len=*), INTENT(IN) :: axisgroup_id, axis_file
310	INTEGER, INTENT(IN) :: axis_size
311	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
312
313	TYPE(xios_axisgroup) :: axgroup
314	TYPE(xios_axis) :: ax
315	CHARACTER(len=20) :: axis_id
316
317
318	!Préparation du nom de l'axe:
319	CALL concat(axisgroup_id, axis_file, axis_id)
320
321	!On récupère le groupe d'axes qui va bien:
322	CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
323
324	!On ajoute l'axe correspondant à ce fichier:
325	CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
326
327	!Et on le parametrise:
328	CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
329
330	!Vérification:
331	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
332	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
333	ELSE
334	WRITE(,) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
335	END IF
336
337	END SUBROUTINE wxios_add_vaxis
338
339
340	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
341	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
342	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
343	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
344	IMPLICIT NONE
345	INCLUDE 'iniprint.h'
346
347	CHARACTER(len=*), INTENT(IN) :: fname
348	CHARACTER(len=*), INTENT(IN) :: ffreq
349	INTEGER, INTENT(IN) :: flvl
350
351	TYPE(xios_file) :: x_file
352	TYPE(xios_filegroup) :: x_fg
353	CHARACTER(len=100) :: nffreq
354
355	!On regarde si le fichier n'est pas défini par XML:
356	IF (.NOT.xios_is_valid_file(fname)) THEN
357	!On créé le noeud:
358	CALL xios_get_filegroup_handle("defile", x_fg)
359	CALL xios_add_file(x_fg, x_file, fname)
360
361	!On reformate la fréquence:
362	CALL reformadate(ffreq, nffreq)
363
364	!On configure:
365	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
366	output_freq=TRIM(ADJUSTL(nffreq)), output_level=flvl, enabled=.TRUE.)
367
368	IF (xios_is_valid_file("X"//fname)) THEN
369	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
370	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
371	ELSE
372	WRITE(,) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
373	WRITE(,) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
374	END IF
375	ELSE
376	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
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
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	!Préparation du nom de l'axe:
444	CALL concat("presnivs", fname, axis_id)
445
446	!on prépare le nom de l'opération:
447	operation = reformaop(op)
448
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