Context Navigation

wxios.F90 @ 2054

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

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

Download in other formats:

Original Format