source: XIOS/trunk/src/interface/fortran/ixml_tree.F90 @ 472

Last change on this file since 472 was 472, checked in by ymipsl, 8 years ago

Enhancement : user defined global and field attribute can be output in the netcdfcf file.
A variable child element inclosed into a file element will be output as a global file attribute.
A variable child element inclosed into a field element will be output as a field attribute.

+ variable fortran interface added

YM

File size: 16.6 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IXML_TREE
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE IAXIS
6   USE IFILE
7   USE IFIELD
8   USE IGRID
9   USE IDOMAIN
10   USE IVARIABLE
11     
12   INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
13     
14      SUBROUTINE cxios_xml_tree_add_field(parent_, child_, child_id, child_id_size) BIND(C)
15         USE ISO_C_BINDING
16         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
17         INTEGER  (kind = C_INTPTR_T)               :: child_
18         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
19         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
20      END SUBROUTINE cxios_xml_tree_add_field
21     
22      SUBROUTINE cxios_xml_tree_add_grid(parent_, child_, child_id, child_id_size) BIND(C)
23         USE ISO_C_BINDING
24         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
25         INTEGER  (kind = C_INTPTR_T)               :: child_
26         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
27         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
28      END SUBROUTINE cxios_xml_tree_add_grid
29     
30      SUBROUTINE cxios_xml_tree_add_file(parent_, child_, child_id, child_id_size) BIND(C)
31         USE ISO_C_BINDING
32         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
33         INTEGER  (kind = C_INTPTR_T)               :: child_
34         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
35         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
36      END SUBROUTINE cxios_xml_tree_add_file
37     
38      SUBROUTINE cxios_xml_tree_add_axis(parent_, child_, child_id, child_id_size) BIND(C)
39         USE ISO_C_BINDING
40         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
41         INTEGER  (kind = C_INTPTR_T)               :: child_
42         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
43         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
44      END SUBROUTINE cxios_xml_tree_add_axis
45     
46      SUBROUTINE cxios_xml_tree_add_domain(parent_, child_, child_id, child_id_size) BIND(C)
47         USE ISO_C_BINDING
48         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
49         INTEGER  (kind = C_INTPTR_T)               :: child_
50         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
51         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
52      END SUBROUTINE cxios_xml_tree_add_domain
53     
54      SUBROUTINE cxios_xml_tree_add_fieldtofile(parent_, child_, child_id, child_id_size) BIND(C)
55         USE ISO_C_BINDING
56         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
57         INTEGER  (kind = C_INTPTR_T)               :: child_
58         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
59         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
60      END SUBROUTINE cxios_xml_tree_add_fieldtofile
61
62      SUBROUTINE cxios_xml_tree_add_variabletofile(parent_, child_, child_id, child_id_size) BIND(C)
63         USE ISO_C_BINDING
64         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
65         INTEGER  (kind = C_INTPTR_T)               :: child_
66         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
67         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
68      END SUBROUTINE cxios_xml_tree_add_variabletofile
69
70
71      SUBROUTINE cxios_xml_tree_add_variabletofield(parent_, child_, child_id, child_id_size) BIND(C)
72         USE ISO_C_BINDING
73         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
74         INTEGER  (kind = C_INTPTR_T)               :: child_
75         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
76         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
77      END SUBROUTINE cxios_xml_tree_add_variabletofield
78
79
80      SUBROUTINE cxios_xml_tree_add_fieldgroup(parent_, child_, child_id, child_id_size) BIND(C)
81         USE ISO_C_BINDING
82         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
83         INTEGER  (kind = C_INTPTR_T)               :: child_
84         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
85         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
86      END SUBROUTINE cxios_xml_tree_add_fieldgroup
87
88      SUBROUTINE cxios_xml_tree_add_gridgroup(parent_, child_, child_id, child_id_size) BIND(C)
89         USE ISO_C_BINDING
90         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
91         INTEGER  (kind = C_INTPTR_T)               :: child_
92         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
93         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
94      END SUBROUTINE cxios_xml_tree_add_gridgroup
95
96      SUBROUTINE cxios_xml_tree_add_filegroup(parent_, child_, child_id, child_id_size) BIND(C)
97         USE ISO_C_BINDING
98         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
99         INTEGER  (kind = C_INTPTR_T)               :: child_
100         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
101         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
102      END SUBROUTINE cxios_xml_tree_add_filegroup
103
104      SUBROUTINE cxios_xml_tree_add_axisgroup(parent_, child_, child_id, child_id_size) BIND(C)
105         USE ISO_C_BINDING
106         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
107         INTEGER  (kind = C_INTPTR_T)               :: child_
108         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
109         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
110      END SUBROUTINE cxios_xml_tree_add_axisgroup
111
112      SUBROUTINE cxios_xml_tree_add_domaingroup(parent_, child_, child_id, child_id_size) BIND(C)
113         USE ISO_C_BINDING
114         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
115         INTEGER  (kind = C_INTPTR_T)               :: child_
116         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
117         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
118      END SUBROUTINE cxios_xml_tree_add_domaingroup
119     
120      SUBROUTINE cxios_xml_tree_add_fieldgrouptofile(parent_, child_, child_id, child_id_size) BIND(C)
121         USE ISO_C_BINDING
122         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
123         INTEGER  (kind = C_INTPTR_T)               :: child_
124         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
125         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
126      END SUBROUTINE cxios_xml_tree_add_fieldgrouptofile   
127
128      SUBROUTINE cxios_xml_tree_add_variablegrouptofile(parent_, child_, child_id, child_id_size) BIND(C)
129         USE ISO_C_BINDING
130         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
131         INTEGER  (kind = C_INTPTR_T)               :: child_
132         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
133         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
134      END SUBROUTINE cxios_xml_tree_add_variablegrouptofile   
135
136      SUBROUTINE cxios_xml_tree_add_variablegrouptofield(parent_, child_, child_id, child_id_size) BIND(C)
137         USE ISO_C_BINDING
138         INTEGER  (kind = C_INTPTR_T), VALUE        :: parent_
139         INTEGER  (kind = C_INTPTR_T)               :: child_
140         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: child_id
141         INTEGER  (kind = C_INT)     , VALUE        :: child_id_size
142      END SUBROUTINE cxios_xml_tree_add_variablegrouptofield   
143
144      SUBROUTINE cxios_xml_tree_show(filename, filename_size) BIND(C)
145         USE ISO_C_BINDING
146         CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename
147         INTEGER  (kind = C_INT) , VALUE        :: filename_size
148      END SUBROUTINE cxios_xml_tree_show
149
150      SUBROUTINE cxios_xml_parse_file(filename, filename_size) BIND(C)
151         USE ISO_C_BINDING
152         CHARACTER(kind = C_CHAR), DIMENSION(*) :: filename
153         INTEGER  (kind = C_INT) , VALUE        :: filename_size
154      END SUBROUTINE cxios_xml_parse_file
155
156      SUBROUTINE cxios_xml_parse_string(xmlcontent, xmlcontent_size) BIND(C)
157         USE ISO_C_BINDING
158         CHARACTER(kind = C_CHAR), DIMENSION(*) :: xmlcontent
159         INTEGER  (kind = C_INT) , VALUE        :: xmlcontent_size
160      END SUBROUTINE cxios_xml_parse_string
161     
162   END INTERFACE
163
164   
165   CONTAINS ! Fonctions disponibles pour les utilisateurs.
166
167
168   SUBROUTINE xios(add_axis)(parent_hdl, child_hdl, child_id)
169      TYPE(txios(axisgroup))     , INTENT(IN) :: parent_hdl
170      TYPE(txios(axis))          , INTENT(OUT):: child_hdl
171      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
172
173      IF (PRESENT(child_id)) THEN
174         CALL cxios_xml_tree_add_axis(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
175      ELSE
176         CALL cxios_xml_tree_add_axis(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
177      END IF
178
179   END SUBROUTINE xios(add_axis)
180   
181   SUBROUTINE xios(add_file)(parent_hdl, child_hdl, child_id)
182      TYPE(txios(filegroup))      , INTENT(IN) :: parent_hdl
183      TYPE(txios(file))           , INTENT(OUT):: child_hdl
184      CHARACTER(len = *), OPTIONAL, INTENT(IN)  :: child_id
185
186      IF (PRESENT(child_id)) THEN
187         CALL cxios_xml_tree_add_file(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
188      ELSE
189         CALL cxios_xml_tree_add_file(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
190      END IF
191
192   END SUBROUTINE xios(add_file)
193   
194   SUBROUTINE xios(add_grid)(parent_hdl, child_hdl, child_id)
195      TYPE(txios(gridgroup))     , INTENT(IN) :: parent_hdl
196      TYPE(txios(grid))          , INTENT(OUT):: child_hdl
197      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
198      IF (PRESENT(child_id)) THEN
199         CALL cxios_xml_tree_add_grid(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
200      ELSE
201         CALL cxios_xml_tree_add_grid(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
202      END IF
203
204   END SUBROUTINE xios(add_grid)
205   
206   
207   SUBROUTINE xios(add_field)(parent_hdl, child_hdl, child_id)
208      TYPE(txios(fieldgroup))     , INTENT(IN) :: parent_hdl
209      TYPE(txios(field))          , INTENT(OUT):: child_hdl
210      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
211
212      IF (PRESENT(child_id)) THEN
213         CALL cxios_xml_tree_add_field(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
214      ELSE
215         CALL cxios_xml_tree_add_field(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
216      END IF
217
218   END SUBROUTINE xios(add_field)
219   
220   
221   SUBROUTINE xios(add_domain)(parent_hdl, child_hdl, child_id)
222      TYPE(txios(domaingroup))     , INTENT(IN) :: parent_hdl
223      TYPE(txios(domain))     , INTENT(OUT):: child_hdl
224      CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
225
226      IF (PRESENT(child_id)) THEN
227         CALL cxios_xml_tree_add_domain(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
228      ELSE
229         CALL cxios_xml_tree_add_domain(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
230      END IF
231
232   END SUBROUTINE xios(add_domain)
233   
234   SUBROUTINE xios(add_fieldtofile)(parent_hdl, child_hdl, child_id)
235      TYPE(txios(file))            , INTENT(IN) :: parent_hdl
236      TYPE(txios(field))           , INTENT(OUT):: child_hdl
237      CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
238
239      IF (PRESENT(child_id)) THEN
240         CALL cxios_xml_tree_add_fieldtofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
241      ELSE
242         CALL cxios_xml_tree_add_fieldtofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
243      END IF
244
245   END SUBROUTINE xios(add_fieldtofile)
246
247   SUBROUTINE xios(add_variabletofile)(parent_hdl, child_hdl, child_id)
248      TYPE(txios(file))            , INTENT(IN) :: parent_hdl
249      TYPE(txios(variable))           , INTENT(OUT):: child_hdl
250      CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
251
252      IF (PRESENT(child_id)) THEN
253         CALL cxios_xml_tree_add_variabletofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
254      ELSE
255         CALL cxios_xml_tree_add_variabletofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
256      END IF
257
258   END SUBROUTINE xios(add_variabletofile)
259
260   SUBROUTINE xios(add_variabletofield)(parent_hdl, child_hdl, child_id)
261      TYPE(txios(field))            , INTENT(IN) :: parent_hdl
262      TYPE(txios(variable))           , INTENT(OUT):: child_hdl
263      CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
264
265      IF (PRESENT(child_id)) THEN
266         CALL cxios_xml_tree_add_variabletofield(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
267      ELSE
268         CALL cxios_xml_tree_add_variabletofield(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
269      END IF
270
271   END SUBROUTINE xios(add_variabletofield)
272
273
274   SUBROUTINE xios(add_axisgroup)(parent_hdl, child_hdl, child_id)
275      TYPE(txios(axisgroup))      , INTENT(IN) :: parent_hdl
276      TYPE(txios(axisgroup))      , INTENT(OUT):: child_hdl
277      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
278
279      IF (PRESENT(child_id)) THEN
280         CALL cxios_xml_tree_add_axisgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
281      ELSE
282         CALL cxios_xml_tree_add_axisgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
283      END IF
284
285   END SUBROUTINE xios(add_axisgroup)
286
287
288   SUBROUTINE xios(add_filegroup)(parent_hdl, child_hdl, child_id)
289      TYPE(txios(filegroup))      , INTENT(IN) :: parent_hdl
290      TYPE(txios(filegroup))      , INTENT(OUT):: child_hdl
291      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
292
293      IF (PRESENT(child_id)) THEN
294         CALL cxios_xml_tree_add_filegroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
295      ELSE
296         CALL cxios_xml_tree_add_filegroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
297      END IF
298
299   END SUBROUTINE xios(add_filegroup)
300
301   SUBROUTINE xios(add_gridgroup)(parent_hdl, child_hdl, child_id)
302      TYPE(txios(gridgroup))      , INTENT(IN) :: parent_hdl
303      TYPE(txios(gridgroup))      , INTENT(OUT):: child_hdl
304      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
305
306      IF (PRESENT(child_id)) THEN
307         CALL cxios_xml_tree_add_gridgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
308      ELSE
309         CALL cxios_xml_tree_add_gridgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
310      END IF
311     
312   END SUBROUTINE xios(add_gridgroup)
313
314
315   SUBROUTINE xios(add_fieldgroup)(parent_hdl, child_hdl, child_id)
316      TYPE(txios(fieldgroup))     , INTENT(IN) :: parent_hdl
317      TYPE(txios(fieldgroup))     , INTENT(OUT):: child_hdl
318      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: child_id
319      IF (PRESENT(child_id)) THEN
320         CALL cxios_xml_tree_add_fieldgroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
321      ELSE
322         CALL cxios_xml_tree_add_fieldgroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
323      END IF
324   END SUBROUTINE xios(add_fieldgroup)
325
326   SUBROUTINE xios(add_domaingroup)(parent_hdl, child_hdl, child_id)
327      TYPE(txios(domaingroup))     , INTENT(IN) :: parent_hdl
328      TYPE(txios(domaingroup))     , INTENT(OUT):: child_hdl
329      CHARACTER(len = *), OPTIONAL , INTENT(IN) :: child_id
330
331      IF (PRESENT(child_id)) THEN
332         CALL cxios_xml_tree_add_domaingroup(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
333      ELSE
334         CALL cxios_xml_tree_add_domaingroup(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
335      END IF
336
337   END SUBROUTINE xios(add_domaingroup)
338
339   SUBROUTINE xios(add_fieldgrouptofile)(parent_hdl, child_hdl, child_id)
340      TYPE(txios(file))            , INTENT(IN) :: parent_hdl
341      TYPE(txios(fieldgroup))     , INTENT(OUT):: child_hdl
342      CHARACTER(len = *), OPTIONAL  , INTENT(IN) :: child_id
343
344      IF (PRESENT(child_id)) THEN
345         CALL cxios_xml_tree_add_fieldgrouptofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
346      ELSE
347         CALL cxios_xml_tree_add_fieldgrouptofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
348      END IF
349
350   END SUBROUTINE xios(add_fieldgrouptofile)
351
352   SUBROUTINE xios(add_variablegrouptofile)(parent_hdl, child_hdl, child_id)
353      TYPE(txios(file))            , INTENT(IN) :: parent_hdl
354      TYPE(txios(variablegroup))     , INTENT(OUT):: child_hdl
355      CHARACTER(len = *), OPTIONAL  , INTENT(IN) :: child_id
356
357      IF (PRESENT(child_id)) THEN
358         CALL cxios_xml_tree_add_variablegrouptofile(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
359      ELSE
360         CALL cxios_xml_tree_add_variablegrouptofile(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
361      END IF
362
363   END SUBROUTINE xios(add_variablegrouptofile)
364
365   SUBROUTINE xios(add_variablegrouptofield)(parent_hdl, child_hdl, child_id)
366      TYPE(txios(field))            , INTENT(IN) :: parent_hdl
367      TYPE(txios(variablegroup))     , INTENT(OUT):: child_hdl
368      CHARACTER(len = *), OPTIONAL  , INTENT(IN) :: child_id
369
370      IF (PRESENT(child_id)) THEN
371         CALL cxios_xml_tree_add_variablegrouptofield(parent_hdl%daddr, child_hdl%daddr, child_id, len(child_id))
372      ELSE
373         CALL cxios_xml_tree_add_variablegrouptofield(parent_hdl%daddr, child_hdl%daddr, "NONE", -1)
374      END IF
375
376   END SUBROUTINE xios(add_variablegrouptofield) 
377         
378END MODULE IXML_TREE
Note: See TracBrowser for help on using the repository browser.