Context Navigation

wxios.F90 @ 2055

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

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

Download in other formats:

Original Format