Context Navigation

wxios.F90 @ 5080

Last change on this file since 5080 was 2381, checked in by acozic, 9 years ago

Make some commit to fit with INCA coupling

merge with rev 2180 on trunk
merge with rev 2185 on trunk
merge with rev 2200 on trunk
change gregorian calendar in wxios

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

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

Download in other formats:

Original Format