Context Navigation

c_interface.f03 @ 138

Last change on this file since 138 was 138, checked in by hozdoba, 14 years ago
Mise Ã jour
File size: 49.3 KB

Line
1	! ----------------------------------------------- !
2	! IXHANDLE !
3	! Gestion des handle (rÃ©fÃ©rences sur objets C++) !
4	! ----------------------------------------------- !
5	MODULE IXHANDLE
6	USE ISO_C_BINDING
7
8	! Ne jamais modifier les valeurs internes de ce type dans le code fortran.
9	TYPE XHandle
10	INTEGER(kind = C_INT) :: dtype
11	INTEGER(kind = C_INT) :: daddr
12	END TYPE XHandle
13
14	! enum XDType
15	INTEGER(kind = C_INT), PARAMETER :: NOTYPE = 0
16	INTEGER(kind = C_INT), PARAMETER :: DTREATMENT = 1, DDATE = 2, CALENDAR = 3, ECONTEXT = 4
17	INTEGER(kind = C_INT), PARAMETER :: EAXIS = 5 , EDOMAIN = 6 , EFIELD = 7 , EFILE = 8 , EGRID = 9
18	INTEGER(kind = C_INT), PARAMETER :: GAXIS = 10, GDOMAIN = 11, GFIELD = 12, GFILE = 13, GGRID = 14
19
20	! Autres constantes
21	TYPE(XHandle) , PARAMETER :: NULLHANDLE = XHandle(0, 0)
22
23	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
24
25	SUBROUTINE xios_handle_create(ret, dtype, idt, idt_size) BIND(C)
26	import C_CHAR, C_INT
27	INTEGER (kind = C_INT) :: ret
28	INTEGER (kind = C_INT), VALUE :: dtype
29	CHARACTER(kind = C_CHAR), DIMENSION(*) :: idt
30	INTEGER (kind = C_INT), VALUE :: idt_size
31	END SUBROUTINE xios_handle_create
32
33	END INTERFACE
34
35	CONTAINS
36
37	! Permet de crÃ©er un handle sur un objet c++ Ã partir d'un identifiant (dÃ©pend du contexte).
38	SUBROUTINE handle_create(ret, dtype, idt)
39	TYPE(XHandle), INTENT(OUT) :: ret
40	INTEGER, INTENT(IN) :: dtype
41	CHARACTER(len = *), INTENT(IN) :: idt
42	CALL xios_handle_create(ret%daddr, dtype, idt, len(idt))
43
44	IF (ret%daddr == 0) THEN
45	PRINT *, "(F2003 interface) Impossible de crÃ©er un handle sur l'Ã©lÃ©ment !"
46	STOP
47	ELSE
48	ret%dtype = dtype
49	END IF
50	END SUBROUTINE handle_create
51
52	END MODULE IXHANDLE
53
54	! --------------------------------------------- !
55	! ICALENDAR !
56	! Prise en charge des calendriers !
57	! --------------------------------------------- !
58
59	MODULE ICALENDAR
60	USE ISO_C_BINDING
61
62	! enum XCalendarType
63	INTEGER(kind = C_INT), PARAMETER :: D360 = 0 , ALLLEAP = 1 , NOLEAP = 2 , JULIAN = 3 , GREGORIAN = 4
64
65	TYPE XDate
66	INTEGER :: year, month, day, hour, minute, second
67	END TYPE XDate
68
69	TYPE XDuration
70	REAL(kind = 8) :: year, month, day, hour, minute, second
71	END TYPE XDuration
72
73	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
74
75	SUBROUTINE xios_set_timestep(ts_year, ts_month, ts_day, &
76	ts_hour, ts_minute, ts_second) BIND(C)
77	import C_DOUBLE
78	REAL (kind = C_DOUBLE), VALUE :: ts_year, ts_month, ts_day, &
79	ts_hour, ts_minute, ts_second
80	END SUBROUTINE xios_set_timestep
81
82	SUBROUTINE xios_update_calendar(step) BIND(C)
83	import C_INT
84	INTEGER (kind = C_INT), VALUE :: step
85	END SUBROUTINE xios_update_calendar
86
87	END INTERFACE
88
89	CONTAINS ! Fonctions disponibles pour les utilisateurs.
90
91	SUBROUTINE set_timestep(timestep)
92	TYPE(XDuration), INTENT(IN):: timestep
93
94	CALL xios_set_timestep(timestep%year, timestep%month , timestep%day, &
95	timestep%hour, timestep%minute, timestep%second)
96	END SUBROUTINE set_timestep
97
98	SUBROUTINE update_calendar(step)
99	INTEGER, INTENT(IN):: step
100	IF (step < 1) THEN
101	PRINT *, "L'argument 'step' ne peut Ãªtre nÃ©gatif ou nul"
102	STOP
103	END IF
104	CALL xios_update_calendar(step)
105	END SUBROUTINE update_calendar
106
107	END MODULE ICALENDAR
108
109	! --------------------------------------------- !
110	! IXMLTREE !
111	! Modification des document XML !
112	! --------------------------------------------- !
113	MODULE IXMLTREE
114	USE ISO_C_BINDING
115
116	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
117
118	SUBROUTINE xios_xml_tree_add(parent_, parent_type, child_, child_type, child_id, child_id_size) BIND(C)
119	import C_CHAR, C_INT
120	INTEGER (kind = C_INT), VALUE :: parent_
121	INTEGER (kind = C_INT), VALUE :: parent_type
122	INTEGER (kind = C_INT) :: child_
123	INTEGER (kind = C_INT), VALUE :: child_type
124	CHARACTER(kind = C_CHAR), DIMENSION(*) :: child_id
125	INTEGER (kind = C_INT), VALUE :: child_id_size
126	END SUBROUTINE xios_xml_tree_add
127
128	SUBROUTINE xios_xml_tree_show(filename, filename_size) BIND(C)
129	import C_CHAR, C_INT
130	CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename
131	INTEGER (kind = C_INT), VALUE :: filename_size
132	END SUBROUTINE xios_xml_tree_show
133
134	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
135	! Attribut des Ã©lÃ©ments de type field et field_group !
136	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
137	SUBROUTINE xios_xml_set_field_name(field, ftype, fname, fname_size) BIND(C)
138	import C_CHAR, C_INT
139	INTEGER (kind = C_INT), VALUE :: field, ftype
140	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fname
141	INTEGER (kind = C_INT), VALUE :: fname_size
142	END SUBROUTINE xios_xml_set_field_name
143
144	SUBROUTINE xios_xml_set_field_sname(field, ftype, fsname, fsname_size) BIND(C)
145	import C_CHAR, C_INT
146	INTEGER (kind = C_INT), VALUE :: field, ftype
147	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fsname
148	INTEGER (kind = C_INT), VALUE :: fsname_size
149	END SUBROUTINE xios_xml_set_field_sname
150
151	SUBROUTINE xios_xml_set_field_lname(field, ftype, flname, flname_size) BIND(C)
152	import C_CHAR, C_INT
153	INTEGER (kind = C_INT), VALUE :: field, ftype
154	CHARACTER(kind = C_CHAR), DIMENSION(*) :: flname
155	INTEGER (kind = C_INT), VALUE :: flname_size
156	END SUBROUTINE xios_xml_set_field_lname
157
158	SUBROUTINE xios_xml_set_field_unit(field, ftype, funit, funit_size) BIND(C)
159	import C_CHAR, C_INT
160	INTEGER (kind = C_INT), VALUE :: field, ftype
161	CHARACTER(kind = C_CHAR), DIMENSION(*) :: funit
162	INTEGER (kind = C_INT), VALUE :: funit_size
163	END SUBROUTINE xios_xml_set_field_unit
164
165	SUBROUTINE xios_xml_set_field_operation(field, ftype, foperation, foperation_size) BIND(C)
166	import C_CHAR, C_INT
167	INTEGER (kind = C_INT), VALUE :: field, ftype
168	CHARACTER(kind = C_CHAR), DIMENSION(*) :: foperation
169	INTEGER (kind = C_INT), VALUE :: foperation_size
170	END SUBROUTINE xios_xml_set_field_operation
171
172	SUBROUTINE xios_xml_set_field_freq_op(field, ftype, year, month, day, hour, minute, second) BIND(C)
173	import C_DOUBLE, C_INT
174	INTEGER (kind = C_INT), VALUE :: field, ftype
175	REAL (kind = C_DOUBLE), VALUE :: year, month, day, hour, minute, second
176	END SUBROUTINE xios_xml_set_field_freq_op
177
178	SUBROUTINE xios_xml_set_field_level(field, ftype, flevel) BIND(C)
179	import C_INT
180	INTEGER (kind = C_INT), VALUE :: field, ftype
181	INTEGER (kind = C_INT), VALUE :: flevel
182	END SUBROUTINE xios_xml_set_field_level
183
184	SUBROUTINE xios_xml_set_field_prec(field, ftype, fprec) BIND(C)
185	import C_INT
186	INTEGER (kind = C_INT), VALUE :: field, ftype
187	INTEGER (kind = C_INT), VALUE :: fprec
188	END SUBROUTINE xios_xml_set_field_prec
189
190	SUBROUTINE xios_xml_set_field_enabled(field, ftype, fenabled) BIND(C)
191	import C_INT, C_BOOL
192	INTEGER (kind = C_INT), VALUE :: field, ftype
193	LOGICAL (kind = C_BOOL), VALUE :: fenabled
194	END SUBROUTINE xios_xml_set_field_enabled
195
196	SUBROUTINE xios_xml_set_field_dref(field, ftype, fdref, fdref_size) BIND(C)
197	import C_CHAR, C_INT
198	INTEGER (kind = C_INT), VALUE :: field, ftype
199	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fdref
200	INTEGER (kind = C_INT), VALUE :: fdref_size
201	END SUBROUTINE xios_xml_set_field_dref
202
203	SUBROUTINE xios_xml_set_field_aref(field, ftype, faref, faref_size) BIND(C)
204	import C_CHAR, C_INT
205	INTEGER (kind = C_INT), VALUE :: field, ftype
206	CHARACTER(kind = C_CHAR), DIMENSION(*) :: faref
207	INTEGER (kind = C_INT), VALUE :: faref_size
208	END SUBROUTINE xios_xml_set_field_aref
209
210	SUBROUTINE xios_xml_set_field_gref(field, ftype, fgref, fgref_size) BIND(C)
211	import C_CHAR, C_INT
212	INTEGER (kind = C_INT), VALUE :: field, ftype
213	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fgref
214	INTEGER (kind = C_INT), VALUE :: fgref_size
215	END SUBROUTINE xios_xml_set_field_gref
216
217	SUBROUTINE xios_xml_set_field_zref(field, ftype, fzref, fzref_size) BIND(C)
218	import C_CHAR, C_INT
219	INTEGER (kind = C_INT), VALUE :: field, ftype
220	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fzref
221	INTEGER (kind = C_INT), VALUE :: fzref_size
222	END SUBROUTINE xios_xml_set_field_zref
223
224	SUBROUTINE xios_xml_set_field_fref(field, ftype, ffref, ffref_size) BIND(C)
225	import C_CHAR, C_INT
226	INTEGER (kind = C_INT), VALUE :: field, ftype
227	CHARACTER(kind = C_CHAR), DIMENSION(*) :: ffref
228	INTEGER (kind = C_INT), VALUE :: ffref_size
229	END SUBROUTINE xios_xml_set_field_fref
230
231	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
232	! Attribut des Ã©lÃ©ments de type file et file_group !
233	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
234
235	SUBROUTINE xios_xml_set_file_name(file_, ftype, fname, fname_size) BIND(C)
236	import C_CHAR, C_INT
237	INTEGER (kind = C_INT), VALUE :: file_, ftype
238	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fname
239	INTEGER (kind = C_INT), VALUE :: fname_size
240	END SUBROUTINE xios_xml_set_file_name
241
242	SUBROUTINE xios_xml_set_file_description(file_, ftype, fdescription, fdescription_size) BIND(C)
243	import C_CHAR, C_INT
244	INTEGER (kind = C_INT), VALUE :: file_, ftype
245	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fdescription
246	INTEGER (kind = C_INT), VALUE :: fdescription_size
247	END SUBROUTINE xios_xml_set_file_description
248
249	SUBROUTINE xios_xml_set_file_output_freq(file_, ftype, year, month, day, hour, minute, second) BIND(C)
250	import C_DOUBLE, C_INT
251	INTEGER (kind = C_INT), VALUE :: file_, ftype
252	REAL (kind = C_DOUBLE), VALUE :: year, month, day, hour, minute, second
253	END SUBROUTINE xios_xml_set_file_output_freq
254
255	SUBROUTINE xios_xml_set_file_olevel(file_, ftype, folevel) BIND(C)
256	import C_INT
257	INTEGER (kind = C_INT), VALUE :: file_, ftype
258	INTEGER (kind = C_INT), VALUE :: folevel
259	END SUBROUTINE xios_xml_set_file_olevel
260
261	SUBROUTINE xios_xml_set_file_enabled(file_, ftype, fenabled) BIND(C)
262	import C_INT, C_BOOL
263	INTEGER (kind = C_INT), VALUE :: file_, ftype
264	LOGICAL (kind = C_BOOL), VALUE :: fenabled
265	END SUBROUTINE xios_xml_set_file_enabled
266
267	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
268	! Attribut des Ã©lÃ©ments de type grid et grid_group !
269	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
270	SUBROUTINE xios_xml_set_grid_name(grid, ftype, gname, gname_size) BIND(C)
271	import C_CHAR, C_INT
272	INTEGER (kind = C_INT), VALUE :: grid, ftype
273	CHARACTER(kind = C_CHAR), DIMENSION(*) :: gname
274	INTEGER (kind = C_INT), VALUE :: gname_size
275	END SUBROUTINE xios_xml_set_grid_name
276
277	SUBROUTINE xios_xml_set_grid_description(grid, ftype, gdescription, gdescription_size) BIND(C)
278	import C_CHAR, C_INT
279	INTEGER (kind = C_INT), VALUE :: grid, ftype
280	CHARACTER(kind = C_CHAR), DIMENSION(*) :: gdescription
281	INTEGER (kind = C_INT), VALUE :: gdescription_size
282	END SUBROUTINE xios_xml_set_grid_description
283
284	SUBROUTINE xios_xml_set_grid_dref(grid, ftype, dref, dref_size) BIND(C)
285	import C_CHAR, C_INT
286	INTEGER (kind = C_INT), VALUE :: grid, ftype
287	CHARACTER(kind = C_CHAR), DIMENSION(*) :: dref
288	INTEGER (kind = C_INT), VALUE :: dref_size
289	END SUBROUTINE xios_xml_set_grid_dref
290
291	SUBROUTINE xios_xml_set_grid_aref(grid, ftype, aref, aref_size) BIND(C)
292	import C_CHAR, C_INT
293	INTEGER (kind = C_INT), VALUE :: grid, ftype
294	CHARACTER(kind = C_CHAR), DIMENSION(*) :: aref
295	INTEGER (kind = C_INT), VALUE :: aref_size
296	END SUBROUTINE xios_xml_set_grid_aref
297
298	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
299	! Attribut des Ã©lÃ©ments de type axis et axis_group !
300	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
301	SUBROUTINE xios_xml_set_axis_name(axis, ftype, aname, aname_size) BIND(C)
302	import C_CHAR, C_INT
303	INTEGER (kind = C_INT), VALUE :: axis, ftype
304	CHARACTER(kind = C_CHAR), DIMENSION(*) :: aname
305	INTEGER (kind = C_INT), VALUE :: aname_size
306	END SUBROUTINE xios_xml_set_axis_name
307
308	SUBROUTINE xios_xml_set_axis_sname(axis, ftype, asname, asname_size) BIND(C)
309	import C_CHAR, C_INT
310	INTEGER (kind = C_INT), VALUE :: axis, ftype
311	CHARACTER(kind = C_CHAR), DIMENSION(*) :: asname
312	INTEGER (kind = C_INT), VALUE :: asname_size
313	END SUBROUTINE xios_xml_set_axis_sname
314
315	SUBROUTINE xios_xml_set_axis_lname(axis, ftype, alname, alname_size) BIND(C)
316	import C_CHAR, C_INT
317	INTEGER (kind = C_INT), VALUE :: axis, ftype
318	CHARACTER(kind = C_CHAR), DIMENSION(*) :: alname
319	INTEGER (kind = C_INT), VALUE :: alname_size
320	END SUBROUTINE xios_xml_set_axis_lname
321
322	SUBROUTINE xios_xml_set_axis_unit(axis, ftype, aunit, aunit_size) BIND(C)
323	import C_CHAR, C_INT
324	INTEGER (kind = C_INT), VALUE :: axis, ftype
325	CHARACTER(kind = C_CHAR), DIMENSION(*) :: aunit
326	INTEGER (kind = C_INT), VALUE :: aunit_size
327	END SUBROUTINE xios_xml_set_axis_unit
328
329	SUBROUTINE xios_xml_set_axis_value(axis, ftype, avalue, avalue_size) BIND(C)
330	import C_DOUBLE, C_INT
331	INTEGER (kind = C_INT), VALUE :: axis, ftype
332	REAL(kind = C_DOUBLE), DIMENSION(*) :: avalue
333	INTEGER (kind = C_INT), VALUE :: avalue_size
334	END SUBROUTINE xios_xml_set_axis_value
335
336	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
337	! Attribut des Ã©lÃ©ments de type domain et domain_group !
338	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
339
340	SUBROUTINE xios_xml_set_domain_name(domain, ftype, dname, dname_size) BIND(C)
341	import C_CHAR, C_INT
342	INTEGER (kind = C_INT), VALUE :: domain, ftype
343	CHARACTER(kind = C_CHAR), DIMENSION(*) :: dname
344	INTEGER (kind = C_INT), VALUE :: dname_size
345	END SUBROUTINE xios_xml_set_domain_name
346
347	SUBROUTINE xios_xml_set_domain_sname(domain, ftype, dsname, dsname_size) BIND(C)
348	import C_CHAR, C_INT
349	INTEGER (kind = C_INT), VALUE :: domain, ftype
350	CHARACTER(kind = C_CHAR), DIMENSION(*) :: dsname
351	INTEGER (kind = C_INT), VALUE :: dsname_size
352	END SUBROUTINE xios_xml_set_domain_sname
353
354	SUBROUTINE xios_xml_set_domain_lname(domain, ftype, dlname, dlname_size) BIND(C)
355	import C_CHAR, C_INT
356	INTEGER (kind = C_INT), VALUE :: domain, ftype
357	CHARACTER(kind = C_CHAR), DIMENSION(*) :: dlname
358	INTEGER (kind = C_INT), VALUE :: dlname_size
359	END SUBROUTINE xios_xml_set_domain_lname
360
361	SUBROUTINE xios_xml_set_domain_niglo(domain, ftype, niglo) BIND(C)
362	import C_INT
363	INTEGER (kind = C_INT), VALUE :: domain, ftype, niglo
364	END SUBROUTINE xios_xml_set_domain_niglo
365
366	SUBROUTINE xios_xml_set_domain_njglo(domain, ftype, njglo) BIND(C)
367	import C_INT
368	INTEGER (kind = C_INT), VALUE :: domain, ftype, njglo
369	END SUBROUTINE xios_xml_set_domain_njglo
370
371	SUBROUTINE xios_xml_set_domain_ibegin(domain, ftype, ibegin) BIND(C)
372	import C_INT
373	INTEGER (kind = C_INT), VALUE :: domain, ftype, ibegin
374	END SUBROUTINE xios_xml_set_domain_ibegin
375
376	SUBROUTINE xios_xml_set_domain_iend(domain, ftype, iend) BIND(C)
377	import C_INT
378	INTEGER (kind = C_INT), VALUE :: domain, ftype, iend
379	END SUBROUTINE xios_xml_set_domain_iend
380
381	SUBROUTINE xios_xml_set_domain_ni(domain, ftype, ni) BIND(C)
382	import C_INT
383	INTEGER (kind = C_INT), VALUE :: domain, ftype, ni
384	END SUBROUTINE xios_xml_set_domain_ni
385
386	SUBROUTINE xios_xml_set_domain_jbegin(domain, ftype, jbegin) BIND(C)
387	import C_INT
388	INTEGER (kind = C_INT), VALUE :: domain, ftype, jbegin
389	END SUBROUTINE xios_xml_set_domain_jbegin
390
391	SUBROUTINE xios_xml_set_domain_jend(domain, ftype, jend) BIND(C)
392	import C_INT
393	INTEGER (kind = C_INT), VALUE :: domain, ftype, jend
394	END SUBROUTINE xios_xml_set_domain_jend
395
396	SUBROUTINE xios_xml_set_domain_nj(domain, ftype, nj) BIND(C)
397	import C_INT
398	INTEGER (kind = C_INT), VALUE :: domain, ftype, nj
399	END SUBROUTINE xios_xml_set_domain_nj
400
401	SUBROUTINE xios_xml_set_domain_mask(domain, ftype, mask, maskXsize, maskYsize) BIND(C)
402	import C_BOOL, C_INT
403	INTEGER (kind = C_INT), VALUE :: domain, ftype
404	LOGICAL(kind = C_BOOL), DIMENSION(*) :: mask
405	INTEGER (kind = C_INT), VALUE :: maskXsize, maskYsize
406	END SUBROUTINE xios_xml_set_domain_mask
407
408	SUBROUTINE xios_xml_set_domain_ddim(domain, ftype, dadim) BIND(C)
409	import C_INT
410	INTEGER (kind = C_INT), VALUE :: domain, ftype, dadim
411	END SUBROUTINE xios_xml_set_domain_ddim
412
413	SUBROUTINE xios_xml_set_domain_dni(domain, ftype, dni) BIND(C)
414	import C_INT
415	INTEGER (kind = C_INT), VALUE :: domain, ftype, dni
416	END SUBROUTINE xios_xml_set_domain_dni
417
418	SUBROUTINE xios_xml_set_domain_dnj(domain, ftype, dnj) BIND(C)
419	import C_INT
420	INTEGER (kind = C_INT), VALUE :: domain, ftype, dnj
421	END SUBROUTINE xios_xml_set_domain_dnj
422
423	SUBROUTINE xios_xml_set_domain_dibegin(domain, ftype, dibegin) BIND(C)
424	import C_INT
425	INTEGER (kind = C_INT), VALUE :: domain, ftype, dibegin
426	END SUBROUTINE xios_xml_set_domain_dibegin
427
428	SUBROUTINE xios_xml_set_domain_djbegin(domain, ftype, djbegin) BIND(C)
429	import C_INT
430	INTEGER (kind = C_INT), VALUE :: domain, ftype, djbegin
431	END SUBROUTINE xios_xml_set_domain_djbegin
432
433	SUBROUTINE xios_xml_set_domain_dnindex(domain, ftype, dnindex) BIND(C)
434	import C_INT
435	INTEGER (kind = C_INT), VALUE :: domain, ftype, dnindex
436	END SUBROUTINE xios_xml_set_domain_dnindex
437
438	SUBROUTINE xios_xml_set_domain_diindex(domain, ftype, diindex, diindex_size) BIND(C)
439	import C_INT
440	INTEGER (kind = C_INT), VALUE :: domain, ftype
441	INTEGER(kind = C_INT), DIMENSION(*) :: diindex
442	INTEGER (kind = C_INT), VALUE :: diindex_size
443	END SUBROUTINE xios_xml_set_domain_diindex
444
445	SUBROUTINE xios_xml_set_domain_djindex(domain, ftype, djindex, djindex_size) BIND(C)
446	import C_INT
447	INTEGER (kind = C_INT), VALUE :: domain, ftype
448	INTEGER(kind = C_INT), DIMENSION(*) :: djindex
449	INTEGER (kind = C_INT), VALUE :: djindex_size
450	END SUBROUTINE xios_xml_set_domain_djindex
451
452	SUBROUTINE xios_xml_set_domain_lonvalue(domain, ftype, lonvalue, lonvalue_xsize, lonvalue_ysize) BIND(C)
453	import C_DOUBLE, C_INT
454	INTEGER (kind = C_INT), VALUE :: domain, ftype
455	REAL(kind = C_DOUBLE), DIMENSION(*) :: lonvalue
456	INTEGER (kind = C_INT), VALUE :: lonvalue_xsize, lonvalue_ysize
457	END SUBROUTINE xios_xml_set_domain_lonvalue
458
459	SUBROUTINE xios_xml_set_domain_latvalue(domain, ftype, latvalue, latvalue_xsize, lonvalue_ysize) BIND(C)
460	import C_DOUBLE, C_INT
461	INTEGER (kind = C_INT), VALUE :: domain, ftype
462	REAL(kind = C_DOUBLE), DIMENSION(*) :: latvalue
463	INTEGER (kind = C_INT), VALUE :: latvalue_xsize, lonvalue_ysize
464	END SUBROUTINE xios_xml_set_domain_latvalue
465
466	SUBROUTINE xios_xml_set_domain_domtype(domain, ftype, domtype, domtype_size) BIND(C)
467	import C_CHAR, C_INT
468	INTEGER (kind = C_INT), VALUE :: domain, ftype
469	CHARACTER(kind = C_CHAR), DIMENSION(*) :: domtype
470	INTEGER (kind = C_INT), VALUE :: domtype_size
471	END SUBROUTINE xios_xml_set_domain_domtype
472
473	END INTERFACE
474
475	CONTAINS ! Fonctions disponibles pour les utilisateurs.
476
477	SUBROUTINE xml_tree_add(parent_hdl, child_hdl, child_type, child_id)
478	USE IXHANDLE
479	TYPE(XHandle), INTENT(IN) :: parent_hdl
480	TYPE(XHandle), INTENT(OUT) :: child_hdl
481	INTEGER, INTENT(IN) :: child_type
482	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
483	child_hdl = NULLHANDLE
484	IF (((parent_hdl%dtype >= 10) .AND. (parent_hdl%dtype <= 14) .AND. &
485	(parent_hdl%dtype == child_type) .OR. (parent_hdl%dtype == (child_type + 5))) .OR. &
486	((parent_hdl%dtype == EFILE) .AND. ((child_type == EFIELD) .OR. &
487	(child_type == GFIELD)))) THEN
488	IF (PRESENT(child_id)) THEN
489	CALL xios_xml_tree_add(parent_hdl%daddr, parent_hdl%dtype, child_hdl%daddr, child_type, child_id, len(child_id))
490	ELSE
491	CALL xios_xml_tree_add(parent_hdl%daddr, parent_hdl%dtype, child_hdl%daddr, child_type, "NONE", -1)
492	END IF
493	IF (child_hdl%daddr == 0) THEN
494	PRINT *, "(F2003 interface) Impossible d'ajouter un Ã©lÃ©ment Ã l'arborescence 0!"
495	STOP
496	ELSE
497	child_hdl%dtype = child_type
498	END IF
499	ELSE
500	PRINT *, "(F2003 interface) Impossible d'ajouter un Ã©lÃ©ment Ã l'arborescence 1!"
501	STOP
502	END IF
503
504	END SUBROUTINE xml_tree_add
505
506	SUBROUTINE xml_tree_show(filename)
507	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: filename
508	IF (PRESENT(filename)) THEN
509	CALL xios_xml_tree_show(filename, len(filename))
510	ELSE
511	CALL xios_xml_tree_show("NONE", -1)
512	END IF
513	END SUBROUTINE xml_tree_show
514
515	SUBROUTINE xml_field_addAttribut(field_hdl, fname, fstandard_name, flong_name, funit, foperation, ffreq_op, &
516	flevel, fprec, fenabled, fdomain_ref, faxis_ref, fgrid_ref, fzoom_ref, ffield_ref)
517	USE IXHANDLE
518	USE ICALENDAR
519	TYPE(XHandle), INTENT(IN) :: field_hdl
520	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fname, fstandard_name, flong_name, funit, foperation
521	TYPE(XDuration), OPTIONAL, INTENT(IN) :: ffreq_op
522	INTEGER, OPTIONAL, INTENT(IN) :: flevel, fprec
523	LOGICAL (kind = 1), OPTIONAL, INTENT(IN) :: fenabled
524	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fdomain_ref, faxis_ref, fgrid_ref, fzoom_ref, ffield_ref
525	IF ((field_hdl%daddr == 0) .OR. &
526	.NOT.((field_hdl%dtype == EFIELD) .OR. (field_hdl%dtype == GFIELD))) THEN
527	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au champ !"
528	STOP
529	ELSE
530	IF (PRESENT(fname)) THEN
531	CALL xios_xml_set_field_name(field_hdl%daddr, field_hdl%dtype, fname, len(fname));
532	END IF
533	IF (PRESENT(fstandard_name)) THEN
534	CALL xios_xml_set_field_sname(field_hdl%daddr, field_hdl%dtype, fstandard_name, len(fstandard_name));
535	END IF
536	IF (PRESENT(flong_name)) THEN
537	CALL xios_xml_set_field_lname(field_hdl%daddr, field_hdl%dtype, flong_name, len(flong_name));
538	END IF
539	IF (PRESENT(funit)) THEN
540	CALL xios_xml_set_field_unit(field_hdl%daddr, field_hdl%dtype, funit, len(funit));
541	END IF
542	IF (PRESENT(foperation)) THEN
543	CALL xios_xml_set_field_operation(field_hdl%daddr, field_hdl%dtype, foperation, len(foperation));
544	END IF
545	IF (PRESENT(ffreq_op)) THEN
546	CALL xios_xml_set_field_freq_op(field_hdl%daddr, field_hdl%dtype, &
547	ffreq_op%year, ffreq_op%month, ffreq_op%day, &
548	ffreq_op%hour, ffreq_op%minute, ffreq_op%second)
549	END IF
550	IF (PRESENT(flevel)) THEN
551	CALL xios_xml_set_field_level(field_hdl%daddr, field_hdl%dtype, flevel);
552	END IF
553	IF (PRESENT(fprec)) THEN
554	CALL xios_xml_set_field_prec(field_hdl%daddr, field_hdl%dtype, fprec);
555	END IF
556	IF (PRESENT(fenabled)) THEN
557	CALL xios_xml_set_field_enabled(field_hdl%daddr, field_hdl%dtype, fenabled);
558	END IF
559	IF (PRESENT(fdomain_ref)) THEN
560	CALL xios_xml_set_field_dref(field_hdl%daddr, field_hdl%dtype, fdomain_ref, len(fdomain_ref));
561	END IF
562	IF (PRESENT(faxis_ref)) THEN
563	CALL xios_xml_set_field_aref(field_hdl%daddr, field_hdl%dtype, faxis_ref, len(faxis_ref));
564	END IF
565	IF (PRESENT(fgrid_ref)) THEN
566	CALL xios_xml_set_field_gref(field_hdl%daddr, field_hdl%dtype, fgrid_ref, len(fgrid_ref));
567	END IF
568	IF (PRESENT(fzoom_ref)) THEN
569	CALL xios_xml_set_field_zref(field_hdl%daddr, field_hdl%dtype, fzoom_ref, len(fzoom_ref));
570	END IF
571	IF (PRESENT(ffield_ref)) THEN
572	CALL xios_xml_set_field_fref(field_hdl%daddr, field_hdl%dtype, ffield_ref, len(ffield_ref));
573	END IF
574	END IF
575	END SUBROUTINE xml_field_addAttribut
576
577	SUBROUTINE xml_group_field_addAttribut(gfield_hdl, fname, fstandard_name, flong_name, funit, foperation, ffreq_op, &
578	flevel, fprec, fenabled, fdomain_ref, faxis_ref, fgrid_ref, fzoom_ref, ffield_ref)
579	USE IXHANDLE
580	USE ICALENDAR
581	TYPE(XHandle), INTENT(IN) :: gfield_hdl
582	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fname, fstandard_name, flong_name, funit, foperation
583	TYPE(XDuration), OPTIONAL, INTENT(IN) :: ffreq_op
584	INTEGER, OPTIONAL, INTENT(IN) :: flevel, fprec
585	LOGICAL (kind = 1), OPTIONAL, INTENT(IN) :: fenabled
586	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fdomain_ref, faxis_ref, fgrid_ref, fzoom_ref, ffield_ref
587	IF ((gfield_hdl%daddr == 0) .OR. .NOT.(gfield_hdl%dtype == GFIELD)) THEN
588	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au groupe de champs !"
589	STOP
590	ELSE
591	CALL xml_field_addAttribut(gfield_hdl, fname, fstandard_name, flong_name, funit, foperation, ffreq_op, &
592	flevel, fprec, fenabled, fdomain_ref, faxis_ref, fgrid_ref, fzoom_ref, ffield_ref)
593	END IF
594	END SUBROUTINE xml_group_field_addAttribut
595
596	SUBROUTINE xml_file_addAttribut(file_hdl, fname, fdescription, fofreq, folevel, fenabled)
597	USE IXHANDLE
598	USE ICALENDAR
599	TYPE(XHandle), INTENT(IN) :: file_hdl
600	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fname, fdescription
601	TYPE(XDuration), OPTIONAL, INTENT(IN) :: fofreq
602	INTEGER, OPTIONAL, INTENT(IN) :: folevel
603	LOGICAL (kind = 1), OPTIONAL, INTENT(IN) :: fenabled
604	IF ((file_hdl%daddr == 0) .OR. &
605	.NOT.((file_hdl%dtype == EFILE) .OR. (file_hdl%dtype == GFILE))) THEN
606	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au fichier !"
607	STOP
608	ELSE
609	IF (PRESENT(fname)) THEN
610	CALL xios_xml_set_file_name(file_hdl%daddr, file_hdl%dtype, fname, len(fname));
611	END IF
612	IF (PRESENT(fdescription)) THEN
613	CALL xios_xml_set_file_description(file_hdl%daddr, file_hdl%dtype, fdescription, len(fdescription));
614	END IF
615	IF (PRESENT(fofreq)) THEN
616	CALL xios_xml_set_file_output_freq(file_hdl%daddr, file_hdl%dtype, &
617	fofreq%year, fofreq%month, fofreq%day, &
618	fofreq%hour, fofreq%minute, fofreq%second)
619	END IF
620	IF (PRESENT(folevel)) THEN
621	CALL xios_xml_set_file_olevel(file_hdl%daddr, file_hdl%dtype, folevel);
622	END IF
623	IF (PRESENT(fenabled)) THEN
624	CALL xios_xml_set_file_enabled(file_hdl%daddr, file_hdl%dtype, fenabled);
625	END IF
626	END IF
627	END SUBROUTINE xml_file_addAttribut
628
629	SUBROUTINE xml_group_file_addAttribut(gfile_hdl, fname, fdescription, fofreq, folevel, fenabled)
630	USE IXHANDLE
631	USE ICALENDAR
632	TYPE(XHandle), INTENT(IN) :: gfile_hdl
633	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: fname, fdescription
634	TYPE(XDuration), OPTIONAL, INTENT(IN) :: fofreq
635	INTEGER, OPTIONAL, INTENT(IN) :: folevel
636	LOGICAL (kind = 1), OPTIONAL, INTENT(IN) :: fenabled
637	IF ((gfile_hdl%daddr == 0) .OR. .NOT.(gfile_hdl%dtype == GFILE)) THEN
638	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au groupe de fichiers !"
639	STOP
640	ELSE
641	CALL xml_file_addAttribut(gfile_hdl, fname, fdescription, fofreq, folevel, fenabled)
642	END IF
643	END SUBROUTINE xml_group_file_addAttribut
644
645	SUBROUTINE xml_grid_addAttribut(grid_hdl, gname, gdescription, gdomain_ref, gaxis_ref)
646	USE IXHANDLE
647	TYPE(XHandle), INTENT(IN) :: grid_hdl
648	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: gname, gdescription, gdomain_ref, gaxis_ref
649	IF ((grid_hdl%daddr == 0) .OR. &
650	.NOT.((grid_hdl%dtype == EGRID) .OR. (grid_hdl%dtype == GGRID))) THEN
651	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs Ã la grille !"
652	STOP
653	ELSE
654	IF (PRESENT(gname)) THEN
655	CALL xios_xml_set_grid_name(grid_hdl%daddr, grid_hdl%dtype, gname, len(gname));
656	END IF
657	IF (PRESENT(gdescription)) THEN
658	CALL xios_xml_set_grid_description(grid_hdl%daddr, grid_hdl%dtype, gdescription, len(gdescription));
659	END IF
660	IF (PRESENT(gdomain_ref)) THEN
661	CALL xios_xml_set_grid_dref(grid_hdl%daddr, grid_hdl%dtype, gdomain_ref, len(gdomain_ref));
662	END IF
663	IF (PRESENT(gaxis_ref)) THEN
664	CALL xios_xml_set_grid_aref(grid_hdl%daddr, grid_hdl%dtype, gaxis_ref, len(gaxis_ref));
665	END IF
666	END IF
667	END SUBROUTINE xml_grid_addAttribut
668
669	SUBROUTINE xml_group_grid_addAttribut(ggrid_hdl, gname, gdescription, gdomain_ref, gaxis_ref)
670	USE IXHANDLE
671	TYPE(XHandle), INTENT(IN) :: ggrid_hdl
672	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: gname, gdescription, gdomain_ref, gaxis_ref
673	IF ((ggrid_hdl%daddr == 0) .OR. .NOT.(ggrid_hdl%dtype == GGRID)) THEN
674	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au groupe de grilles !"
675	STOP
676	ELSE
677	CALL xml_grid_addAttribut(ggrid_hdl, gname, gdescription, gdomain_ref, gaxis_ref)
678	END IF
679	END SUBROUTINE xml_group_grid_addAttribut
680
681	SUBROUTINE xml_axis_addAttribut(axis_hdl, aname, astandard_name, along_name, aunit, avalue)
682	USE IXHANDLE
683	TYPE(XHandle), INTENT(IN) :: axis_hdl
684	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: aname, astandard_name, along_name, aunit
685	REAL(kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: avalue(:)
686
687	IF ((axis_hdl%daddr == 0) .OR. &
688	.NOT.((axis_hdl%dtype == EAXIS) .OR. (axis_hdl%dtype == GAXIS))) THEN
689	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs Ã l'axe !"
690	STOP
691	ELSE
692	IF (PRESENT(aname)) THEN
693	CALL xios_xml_set_axis_name(axis_hdl%daddr, axis_hdl%dtype, aname, len(aname));
694	END IF
695	IF (PRESENT(astandard_name)) THEN
696	CALL xios_xml_set_axis_sname(axis_hdl%daddr, axis_hdl%dtype, astandard_name, len(astandard_name));
697	END IF
698	IF (PRESENT(along_name)) THEN
699	CALL xios_xml_set_axis_lname(axis_hdl%daddr, axis_hdl%dtype, along_name, len(along_name));
700	END IF
701	IF (PRESENT(aunit)) THEN
702	CALL xios_xml_set_axis_unit(axis_hdl%daddr, axis_hdl%dtype, aunit, len(aunit));
703	END IF
704	IF (PRESENT(avalue)) THEN
705	CALL xios_xml_set_axis_value(axis_hdl%daddr, axis_hdl%dtype, avalue, size(avalue))
706	END IF
707	END IF
708	END SUBROUTINE xml_axis_addAttribut
709
710	SUBROUTINE xml_group_axis_addAttribut(gaxis_hdl, aname, astandard_name, along_name, aunit, avalue)
711	USE IXHANDLE
712	TYPE(XHandle), INTENT(IN) :: gaxis_hdl
713	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: aname, astandard_name, along_name, aunit
714	REAL(kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: avalue(:)
715
716	IF ((gaxis_hdl%daddr == 0) .OR. .NOT.(gaxis_hdl%dtype == GAXIS)) THEN
717	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au groupe d'axes' !"
718	STOP
719	ELSE
720	CALL xml_axis_addAttribut(gaxis_hdl, aname, astandard_name, along_name, aunit, avalue)
721	END IF
722	END SUBROUTINE xml_group_axis_addAttribut
723
724	SUBROUTINE xml_domain_addAttribut(domain_hdl, dname, dstandard_name, dlong_name, &
725	ni_glo, nj_glo, ibegin, iend, ni, jbegin, jend, nj, mask, &
726	data_dim, data_ni, data_nj, data_ibegin, data_jbegin, data_n_index, &
727	data_i_index, data_j_index, lonvalue_rect, latvalue_rect, &
728	lonvalue_curv, latvalue_curv, domtype)
729	USE IXHANDLE
730	TYPE(XHandle), INTENT(IN) :: domain_hdl
731	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: dname, dstandard_name, dlong_name
732	INTEGER, OPTIONAL, INTENT(IN) :: ni_glo, nj_glo, ibegin, iend, ni, jbegin, jend, nj
733	LOGICAL(kind = 1), DIMENSION(*), OPTIONAL, INTENT(IN) :: mask(:,:)
734	INTEGER, OPTIONAL, INTENT(IN) :: data_dim, data_ni, data_nj, data_ibegin, data_jbegin, data_n_index
735	INTEGER, DIMENSION(*), OPTIONAL, INTENT(IN) :: data_i_index(:), data_j_index(:)
736	REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: lonvalue_curv(:,:), latvalue_curv(:,:)
737	REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: lonvalue_rect(:), latvalue_rect(:)
738	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: domtype
739
740	IF ((domain_hdl%daddr == 0) .OR. &
741	.NOT.((domain_hdl%dtype == EDOMAIN) .OR. (domain_hdl%dtype == GDOMAIN))) THEN
742	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au domain !"
743	STOP
744	ELSE
745	IF (PRESENT(dname)) THEN
746	CALL xios_xml_set_domain_name(domain_hdl%daddr, domain_hdl%dtype, dname, len(dname));
747	END IF
748	IF (PRESENT(dstandard_name)) THEN
749	CALL xios_xml_set_domain_sname(domain_hdl%daddr, domain_hdl%dtype, dstandard_name, len(dstandard_name));
750	END IF
751	IF (PRESENT(dlong_name)) THEN
752	CALL xios_xml_set_domain_lname(domain_hdl%daddr, domain_hdl%dtype, dlong_name, len(dlong_name));
753	END IF
754	IF (PRESENT(dlong_name)) THEN
755	CALL xios_xml_set_domain_lname(domain_hdl%daddr, domain_hdl%dtype, dlong_name, len(dlong_name));
756	END IF
757	IF (PRESENT(ni_glo)) THEN
758	CALL xios_xml_set_domain_niglo(domain_hdl%daddr, domain_hdl%dtype, ni_glo);
759	END IF
760	IF (PRESENT(nj_glo)) THEN
761	CALL xios_xml_set_domain_njglo(domain_hdl%daddr, domain_hdl%dtype, nj_glo);
762	END IF
763	IF (PRESENT(ibegin)) THEN
764	CALL xios_xml_set_domain_ibegin(domain_hdl%daddr, domain_hdl%dtype, ibegin);
765	END IF
766	IF (PRESENT(iend)) THEN
767	CALL xios_xml_set_domain_iend(domain_hdl%daddr, domain_hdl%dtype, iend);
768	END IF
769	IF (PRESENT(ni)) THEN
770	CALL xios_xml_set_domain_ni(domain_hdl%daddr, domain_hdl%dtype, ni);
771	END IF
772	IF (PRESENT(jbegin)) THEN
773	CALL xios_xml_set_domain_jbegin(domain_hdl%daddr, domain_hdl%dtype, jbegin);
774	END IF
775	IF (PRESENT(jend)) THEN
776	CALL xios_xml_set_domain_jend(domain_hdl%daddr, domain_hdl%dtype, jend);
777	END IF
778	IF (PRESENT(nj)) THEN
779	CALL xios_xml_set_domain_nj(domain_hdl%daddr, domain_hdl%dtype, nj);
780	END IF
781	IF (PRESENT(mask)) THEN
782	CALL xios_xml_set_domain_mask(domain_hdl%daddr, domain_hdl%dtype, mask, size(mask, 1), size(mask,2))
783	END IF
784	IF (PRESENT(data_dim)) THEN
785	CALL xios_xml_set_domain_ddim(domain_hdl%daddr, domain_hdl%dtype, data_dim)
786	END IF
787	IF (PRESENT(data_ni)) THEN
788	CALL xios_xml_set_domain_dni(domain_hdl%daddr, domain_hdl%dtype, data_ni)
789	END IF
790	IF (PRESENT(data_nj)) THEN
791	CALL xios_xml_set_domain_dnj(domain_hdl%daddr, domain_hdl%dtype, data_nj)
792	END IF
793	IF (PRESENT(data_ibegin)) THEN
794	CALL xios_xml_set_domain_dibegin(domain_hdl%daddr, domain_hdl%dtype, data_ibegin)
795	END IF
796	IF (PRESENT(data_jbegin)) THEN
797	CALL xios_xml_set_domain_djbegin(domain_hdl%daddr, domain_hdl%dtype, data_jbegin)
798	END IF
799	IF (PRESENT(data_n_index)) THEN
800	CALL xios_xml_set_domain_dnindex(domain_hdl%daddr, domain_hdl%dtype, data_n_index)
801	END IF
802	IF (PRESENT(data_i_index)) THEN
803	CALL xios_xml_set_domain_diindex(domain_hdl%daddr, domain_hdl%dtype, data_i_index, size(data_i_index))
804	END IF
805	IF (PRESENT(data_j_index)) THEN
806	CALL xios_xml_set_domain_djindex(domain_hdl%daddr, domain_hdl%dtype, data_j_index, size(data_j_index))
807	END IF
808	IF (PRESENT(lonvalue_curv)) THEN
809	CALL xios_xml_set_domain_lonvalue(domain_hdl%daddr, domain_hdl%dtype, lonvalue_curv, &
810	size(lonvalue_curv, 1), size(lonvalue_curv, 2))
811	ELSE IF (PRESENT(lonvalue_rect)) THEN
812	CALL xios_xml_set_domain_lonvalue(domain_hdl%daddr, domain_hdl%dtype, lonvalue_rect, size(lonvalue_rect, 1), -1)
813	END IF
814	IF (PRESENT(latvalue_curv)) THEN
815	CALL xios_xml_set_domain_latvalue(domain_hdl%daddr, domain_hdl%dtype, latvalue_curv, &
816	size(latvalue_curv, 1), size(latvalue_curv, 2))
817	ELSE IF (PRESENT(latvalue_rect)) THEN
818	CALL xios_xml_set_domain_latvalue(domain_hdl%daddr, domain_hdl%dtype, latvalue_rect, size(latvalue_rect, 1), -1)
819	END IF
820	IF (PRESENT(domtype)) THEN
821	CALL xios_xml_set_domain_domtype(domain_hdl%daddr, domain_hdl%dtype, domtype, len(domtype))
822	END IF
823	END IF
824	END SUBROUTINE xml_domain_addAttribut
825
826	SUBROUTINE xml_group_domain_addAttribut(gdomain_hdl, dname, dstandard_name, dlong_name, &
827	ni_glo, nj_glo, ibegin, iend, ni, jbegin, jend, nj, mask, &
828	data_dim, data_ni, data_nj, data_ibegin, data_jbegin, data_n_index, &
829	data_i_index, data_j_index, lonvalue_rect, latvalue_rect, &
830	lonvalue_curv, latvalue_curv, domtype)
831	USE IXHANDLE
832	TYPE(XHandle), INTENT(IN) :: gdomain_hdl
833	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: dname, dstandard_name, dlong_name
834	INTEGER, OPTIONAL, INTENT(IN) :: ni_glo, nj_glo, ibegin, iend, ni, jbegin, jend, nj
835	LOGICAL(kind = 1), DIMENSION(*), OPTIONAL, INTENT(IN) :: mask(:,:)
836	INTEGER, OPTIONAL, INTENT(IN) :: data_dim, data_ni, data_nj, data_ibegin, data_jbegin, data_n_index
837	INTEGER, DIMENSION(*), OPTIONAL, INTENT(IN) :: data_i_index(:), data_j_index(:)
838	REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: lonvalue_curv(:,:), latvalue_curv(:,:)
839	REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: lonvalue_rect(:), latvalue_rect(:)
840	CHARACTER(len = *), OPTIONAL, INTENT(IN) :: domtype
841
842	IF ((gdomain_hdl%daddr == 0) .OR. .NOT.(gdomain_hdl%dtype == GDOMAIN)) THEN
843	PRINT *, "(F2003 interface) Impossible d'ajouter des attributs au groupe de domaine !"
844	STOP
845	ELSE
846	CALL xml_domain_addAttribut(gdomain_hdl, dname, dstandard_name, dlong_name, &
847	ni_glo, nj_glo, ibegin, iend, ni, jbegin, jend, nj, mask, &
848	data_dim, data_ni, data_nj, data_ibegin, data_jbegin, data_n_index, &
849	data_i_index, data_j_index, lonvalue_rect, latvalue_rect, &
850	lonvalue_curv, latvalue_curv, domtype)
851	END IF
852	END SUBROUTINE xml_group_domain_addAttribut
853
854	END MODULE IXMLTREE
855
856	! --------------------------------------------- !
857	! IXML !
858	! Prise en charge des document XML !
859	! --------------------------------------------- !
860	MODULE IXML
861	USE ISO_C_BINDING
862
863	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
864
865	SUBROUTINE xios_xml_Parse_File(filename, filename_size) BIND(C)
866	import C_CHAR, C_INT
867	CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename
868	INTEGER (kind = C_INT), VALUE :: filename_size
869	END SUBROUTINE xios_xml_Parse_File
870
871	SUBROUTINE xios_xml_Parse_String(xmlcontent, xmlcontent_size) BIND(C)
872	import C_CHAR, C_INT
873	CHARACTER(kind = C_CHAR), DIMENSION(*) :: xmlcontent
874	INTEGER (kind = C_INT), VALUE :: xmlcontent_size
875	END SUBROUTINE xios_xml_Parse_String
876
877	END INTERFACE
878
879	CONTAINS ! Fonctions disponibles pour les utilisateurs.
880
881	! Parsing d'un document XML depuis un fichier dont le chemin est transmis en argument.
882	SUBROUTINE xml_Parse_File(filename)
883	CHARACTER(len = *), INTENT(IN) :: filename
884	CALL xios_xml_Parse_File(filename, len(filename))
885	END SUBROUTINE xml_Parse_File
886
887	! Parsing d'un document XML depuis une chaÃ®ne de caractÃšre.
888	SUBROUTINE xml_Parse_String(xmlcontent)
889	CHARACTER(len = *), INTENT(IN) :: xmlcontent
890	CALL xios_xml_Parse_String(xmlcontent, len(xmlcontent))
891	END SUBROUTINE xml_Parse_String
892
893	END MODULE IXML
894
895	! ------------------------------------------------ !
896	! ICONTEXT !
897	! Ajout, suppression, ... de contextes Ã la config !
898	! ------------------------------------------------ !
899	MODULE ICONTEXT
900	USE ISO_C_BINDING
901
902	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
903
904	SUBROUTINE xios_context_set_current(context, withswap) BIND(C)
905	import C_BOOL, C_INT
906	INTEGER (kind = C_INT), VALUE :: context
907	LOGICAL (kind = C_BOOL), VALUE :: withswap
908	END SUBROUTINE xios_context_set_current
909
910	SUBROUTINE xios_context_create(context, context_id, context_id_size, calendar_type, &
911	year, month, day, hour, minute, second) BIND(C)
912	import C_CHAR, C_INT
913	INTEGER (kind = C_INT) :: context
914	CHARACTER(kind = C_CHAR), DIMENSION(*) :: context_id
915	INTEGER (kind = C_INT), VALUE :: context_id_size
916	INTEGER (kind = C_INT), VALUE :: calendar_type, year, month, day, hour, minute, second
917	END SUBROUTINE xios_context_create
918
919	END INTERFACE
920
921	CONTAINS ! Fonctions disponibles pour les utilisateurs.
922
923	! Permet de changer de contexte de travail.
924	SUBROUTINE context_set_current(context, withswap)
925	USE IXHANDLE
926	TYPE(XHandle), INTENT(IN) :: context
927	LOGICAL (kind = 1), OPTIONAL, INTENT(IN) :: withswap
928	LOGICAL (kind = 1) :: wswap
929	IF (PRESENT(withswap)) THEN
930	wswap = withswap
931	ELSE
932	wswap = .FALSE.
933	END IF
934	IF ((context%dtype .NE. ECONTEXT) .OR. (context%daddr .EQ. 0)) THEN
935	PRINT *, "(F2003 interface) Impossible de se placer dans le nouveau context car le handle est invalide !"
936	STOP
937	END IF
938	CALL xios_context_set_current(context%daddr, wswap)
939	END SUBROUTINE context_set_current
940
941	! CrÃ©er un nouveau contexte Ã partir d'un id, d'un type de calendrier et d'une date.
942	SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date)
943	USE IXHANDLE
944	USE ICALENDAR
945	TYPE(XHandle), INTENT(OUT) :: context_hdl
946	CHARACTER(len = *), INTENT(IN) :: context_id
947	INTEGER, INTENT(IN) :: calendar_type
948	TYPE(XDate), INTENT(IN), OPTIONAL :: init_date
949	IF (PRESENT(init_date)) THEN
950	CALL xios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
951	init_date%year, init_date%month, init_date%day, &
952	init_date%hour, init_date%minute, init_date%second)
953	ELSE
954	CALL xios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
955	0, 1, 1, 0, 0, 0)
956	END IF
957	IF (context_hdl%daddr .EQ. 0) THEN
958	PRINT *, "(F2003 interface) Impossible de crÃ©er le context !"
959	STOP
960	ELSE
961	context_hdl%dtype = ECONTEXT
962	END IF
963	END SUBROUTINE context_create
964
965	END MODULE ICONTEXT
966
967	! --------------------------------------------- !
968	! IDATATREATMENT !
969	! Traitement des donnÃ©es issues des codes. !
970	! --------------------------------------------- !
971
972	MODULE IDATATREATMENT
973	USE ISO_C_BINDING
974
975	! enum XFileType
976	INTEGER, PARAMETER :: NETCDF4 = 0
977
978	INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
979
980	SUBROUTINE xios_dtreatment_start(context_hdl, filetype) BIND(C)
981	import C_INT
982	INTEGER (kind = C_INT), VALUE :: context_hdl
983	INTEGER (kind = C_INT), VALUE :: filetype
984	END SUBROUTINE xios_dtreatment_start
985
986	SUBROUTINE xios_dtreatment_end() BIND(C)
987	! Sans argument
988	END SUBROUTINE xios_dtreatment_end
989
990	SUBROUTINE xios_write_data(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C)
991	import C_INT, C_CHAR, C_PTR, C_FLOAT, C_DOUBLE, C_BOOL
992	CHARACTER(kind = C_CHAR), DIMENSION(*) :: fieldid
993	INTEGER (kind = C_INT), VALUE :: fieldid_size
994	REAL(kind = C_DOUBLE), DIMENSION(*) :: data_k8
995	INTEGER (kind = C_INT), VALUE :: data_Xsize, data_Ysize, data_Zsize
996	END SUBROUTINE xios_write_data
997
998	END INTERFACE
999
1000	CONTAINS ! Fonctions disponibles pour les utilisateurs.
1001
1002	SUBROUTINE dtreatment_start(context_hdl, filetype)
1003	USE ICONTEXT
1004	USE IXHANDLE
1005	TYPE(XHandle), INTENT(IN), VALUE :: context_hdl
1006	INTEGER, INTENT(IN), OPTIONAL :: filetype
1007	INTEGER :: filetype_
1008	IF ((context_hdl%dtype .NE. ECONTEXT) .OR. (context_hdl%daddr .EQ. 0)) THEN
1009	PRINT *, "(F2003 interface) Impossible de traiter un contexte invalide !"
1010	STOP
1011	END IF
1012	IF (PRESENT(filetype)) THEN
1013	filetype_ = filetype
1014	ELSE
1015	filetype_ = NETCDF4
1016	END IF
1017	CALL context_set_current(context_hdl)
1018	CALL xios_dtreatment_start(context_hdl%daddr, filetype_)
1019	END SUBROUTINE dtreatment_start
1020
1021	SUBROUTINE dtreatment_end(context_hdl)
1022	USE ICONTEXT
1023	USE IXHANDLE
1024	TYPE(XHandle), INTENT(IN), VALUE :: context_hdl
1025	IF ((context_hdl%dtype .NE. ECONTEXT) .OR. (context_hdl%daddr .EQ. 0)) THEN
1026	PRINT *, "(F2003 interface) Impossible de traiter un contexte invalide !"
1027	STOP
1028	END IF
1029	CALL context_set_current(context_hdl)
1030	CALL xios_dtreatment_end()
1031	END SUBROUTINE dtreatment_end
1032
1033	SUBROUTINE write_data (fieldid, &
1034	data1d_k8, data2d_k8, data3d_k8)
1035	CHARACTER(len = *), INTENT(IN) :: fieldid
1036	REAL(kind = 8), DIMENSION(*), OPTIONAL, INTENT(IN) :: data1d_k8(:), data2d_k8(:,:), data3d_k8(:,:,:)
1037	IF((.NOT. PRESENT(data1d_k8)) .AND. &
1038	(.NOT. PRESENT(data2d_k8)) .AND. &
1039	(.NOT. PRESENT(data3d_k8))) THEN
1040	PRINT *, "(F2003 interface) Veuillez spÃ©cifier des donnÃ©es Ã Ã©crire !"
1041	STOP
1042	END IF
1043	IF (PRESENT (data1d_k8)) THEN
1044	CALL xios_write_data(fieldid, len(fieldid), data1d_k8, &
1045	size(data1d_k8, 1), -1, -1)
1046	ELSE IF (PRESENT (data2d_k8)) THEN
1047	CALL xios_write_data(fieldid, len(fieldid), data2d_k8, &
1048	size(data2d_k8, 1), size(data2d_k8, 2), -1)
1049	ELSE IF (PRESENT (data3d_k8)) THEN
1050	CALL xios_write_data(fieldid, len(fieldid), data3d_k8, &
1051	size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
1052	END IF
1053	END SUBROUTINE
1054
1055	END MODULE IDATATREATMENT
1056
1057	! --------------------------------------------- !
1058	! IEXTENDED !
1059	! Quelques fonctions pratiques ... !
1060	! --------------------------------------------- !
1061
1062	MODULE IEXTENDED
1063	USE ISO_C_BINDING
1064
1065
1066
1067	END MODULE IEXTENDED
1068

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

Download in other formats:

Original Format