Context Navigation

wxios.F90 @ 2225

Last change on this file since 2225 was 2137, checked in by idelkadi, 10 years ago
Implementation de XIOS pour les sorties du simulateur COSP
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: 22.0 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, nam_axvert)
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=20), INTENT(IN), OPTIONAL :: nam_axvert
448	CHARACTER(len=100) :: operation
449	TYPE(xios_file) :: f
450	TYPE(xios_field) :: field
451	TYPE(xios_fieldgroup) :: fieldgroup
452	LOGICAL :: bool=.FALSE.
453	INTEGER :: lvl =0
454
455
456	! Ajout Abd pour NMC:
457	IF (fid.LE.6) THEN
458	axis_id="presnivs"
459	ELSE
460	axis_id="plev"
461	ENDIF
462
463	IF (PRESENT(nam_axvert)) THEN
464	axis_id=nam_axvert
465	print*,'nam_axvert=',axis_id
466	ENDIF
467
468	!on prépare le nom de l'opération:
469	operation = reformaop(op)
470
471
472	!On selectionne le bon groupe de champs:
473	IF (fdim.EQ.2) THEN
474	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
475	ELSE
476	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
477	ENDIF
478
479	!On regarde si le champ à déjà été créé ou non:
480	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
481	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
482	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
483	g_flag_xml = .TRUE.
484	g_field_name = fieldname
485
486	ELSE IF (.NOT. g_field_name == fieldname) THEN
487	!Si premier pssage et champ indéfini, alors on le créé
488
489	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
490
491	!On le créé:
492	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
493	IF (xios_is_valid_field(fieldname)) THEN
494	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
495	ENDIF
496
497	g_flag_xml = .FALSE.
498	g_field_name = fieldname
499
500	END IF
501
502	IF (.NOT. g_flag_xml) THEN
503	!Champ existe déjà, mais pas XML, alors on l'ajoute
504	!On ajoute le champ:
505	CALL xios_get_file_handle(fname, f)
506	CALL xios_add_fieldtofile(f, field)
507
508
509	!L'operation, sa frequence:
510	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
511
512
513	!On rentre ses paramètres:
514	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
515
516	IF (fdim.EQ.2) THEN
517	!Si c'est un champ 2D:
518	IF (prt_level >= 10) THEN
519	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
520	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
521	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
522	ENDIF
523	ELSE
524	!Si 3D :
525	!On ajoute l'axe vertical qui va bien:
526	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
527
528	IF (prt_level >= 10) THEN
529	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
530	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
531	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
532	ENDIF
533	END IF
534
535	ELSE
536	!Sinon on se contente de l'activer:
537	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
538	!NB: This will override an enable=.false. set by a user in the xml file;
539	! then the only way to not output the field is by changing its
540	! output level
541	ENDIF
542
543	END SUBROUTINE wxios_add_field_to_file
544
545	! SUBROUTINE wxios_update_calendar(ito)
546	! INTEGER, INTENT(IN) :: ito
547	! CALL xios_update_calendar(ito)
548	! END SUBROUTINE wxios_update_calendar
549	!
550	! SUBROUTINE wxios_write_2D(fieldname, fdata)
551	! CHARACTER(len=*), INTENT(IN) :: fieldname
552	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
553	!
554	! CALL xios_send_field(fieldname, fdata)
555	! END SUBROUTINE wxios_write_2D
556
557	! SUBROUTINE wxios_write_3D(fieldname, fdata)
558	! CHARACTER(len=*), INTENT(IN) :: fieldname
559	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
560	!
561	! CALL xios_send_field(fieldname, fdata)
562	! END SUBROUTINE wxios_write_3D
563
564	SUBROUTINE wxios_closedef()
565	CALL xios_close_context_definition()
566	! CALL xios_update_calendar(0)
567	END SUBROUTINE wxios_closedef
568
569	SUBROUTINE wxios_close()
570	CALL xios_context_finalize()
571	CALL xios_finalize()
572	END SUBROUTINE wxios_close
573	END MODULE wxios
574	#endif

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

Download in other formats:

Original Format