source: XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90 @ 8

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

Importation des sources du serveur XMLIO
File size: 18.1 KB
Line 
1MODULE parsing_xml
2  USE flib_dom
3  USE error_msg
4  USE string_function
5 
6CONTAINS
7
8  SUBROUTINE parsing_xml_file(name)
9  IMPLICIT NONE
10    CHARACTER(len=*), INTENT(IN) :: name
11    TYPE(fnode), POINTER :: myDoc
12
13    myDoc => parsefile(name)
14    CALL parsing_root(myDoc)
15
16    PRINT *, 'Le parsing est termine !!! '
17 
18  END SUBROUTINE parsing_xml_file
19 
20 
21  SUBROUTINE parsing_root(root)
22  IMPLICIT NONE
23    TYPE(fnode), POINTER :: root
24    TYPE(fnode), POINTER :: child_node
25    TYPE(fnodeList), POINTER :: child_list
26
27    INTEGER :: il
28    CHARACTER(len=100) :: node_name
29     
30     IF (hasChildNodes(root)) THEN
31      child_list => getChildnodes(root)
32
33      DO il=0,getLength(child_list)-1
34        child_node => item(child_list,il)
35        node_name=getNodename(child_node)
36         
37        SELECT CASE (TRIM(node_name)) 
38         
39           CASE ('simulation') 
40             CALL parsing_definition(child_node)
41
42           CASE DEFAULT
43             IF (is_bad_node(node_name)) THEN
44               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing root'
45               CALL Warning("mod_parse_xml:parsing_root")
46             ENDIF
47         END SELECT
48       
49       ENDDO
50    ENDIF
51             
52  END SUBROUTINE parsing_root
53
54
55  SUBROUTINE parsing_definition(root)
56  USE mod_axis_definition
57  USE mod_grid_definition
58  USE mod_field_definition
59  USE mod_file_definition
60 
61  IMPLICIT NONE
62    TYPE(fnode), POINTER :: root
63    TYPE(fnode), POINTER :: child_node
64    TYPE(fnodeList), POINTER :: child_list
65
66    INTEGER :: il
67    CHARACTER(len=100) :: node_name
68
69    IF (hasChildNodes(root)) THEN
70      child_list => getChildnodes(root)
71      DO il=0,getLength(child_list)-1
72        child_node => item(child_list,il)
73        node_name=getNodename(child_node)
74         
75        SELECT CASE (TRIM(node_name)) 
76         
77           CASE ('axis_definition') 
78             CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
79               
80           CASE ('grid_definition')
81             CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
82               
83           CASE ('field_definition')
84             CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
85               
86           CASE ('file_definition')
87             CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
88               
89           CASE DEFAULT
90             IF (is_bad_node(node_name)) THEN
91               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing definition'
92               CALL Warning("mod_parse_xml:parsing_definition")
93             ENDIF   
94         END SELECT
95       
96       ENDDO
97    ENDIF
98   
99  END SUBROUTINE parsing_definition
100 
101
102
103
104
105 
106  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
107  USE mod_axis_definition
108  USE mod_axis_group
109  USE mod_axis
110  IMPLICIT NONE 
111    TYPE(fnode), POINTER         :: node
112    TYPE(axis_group),POINTER     :: parent
113    LOGICAL,INTENT(IN),OPTIONAL :: root
114   
115    TYPE(axis_group),POINTER :: pt_axis_group
116    TYPE(fnode), POINTER     :: child_node
117    TYPE(fnodeList), POINTER :: child_list
118    TYPE(axis),POINTER       :: attribute
119    LOGICAL                  :: is_root
120    INTEGER :: il
121    CHARACTER(len=100) :: node_name
122    CHARACTER(len=100) :: value
123   
124    is_root=.FALSE.
125    IF (PRESENT(root)) is_root=root
126 
127    IF (is_root) THEN
128      pt_axis_group=>parent
129    ELSE 
130      IF (is_attribute_exist(node,"id")) THEN
131        value=getAttribute(node,"id")
132        CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
133      ELSE
134        CALL axis_group__get_new_group(parent,pt_axis_group)
135      ENDIF
136    ENDIF
137     
138    CALL axis_group__get_default_attribut(pt_axis_group,attribute)
139    CALL parsing_axis_attribute(node,attribute)
140   
141    IF (hasChildNodes(node)) THEN
142      child_list => getChildnodes(node)
143
144      DO il=0,getLength(child_list)-1
145        child_node => item(child_list,il)
146        node_name=getNodename(child_node)
147       
148        SELECT CASE (TRIM(node_name)) 
149       
150          CASE ('group') 
151            CALL parsing_axis_group(child_node,pt_axis_group)
152             
153          CASE ('axis')
154            CALL parsing_axis(child_node,pt_axis_group)
155
156          CASE DEFAULT
157            IF (is_bad_node(node_name)) THEN
158              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
159              CALL Warning("mod_parse_xml:parsing_group_axis")
160            ENDIF
161        END SELECT
162      ENDDO
163    ENDIF
164
165  END SUBROUTINE parsing_axis_group
166
167  SUBROUTINE parsing_axis(node,parent)
168  USE mod_axis_group
169  USE mod_axis
170  IMPLICIT NONE 
171    TYPE(fnode), POINTER     :: node
172    TYPE(axis_group),POINTER :: parent
173   
174    TYPE(axis),POINTER :: pt_axis
175    TYPE(axis),POINTER       :: attribute
176    INTEGER :: il
177    CHARACTER(len=100) :: node_name
178    CHARACTER(len=100) :: value
179 
180     
181    IF (is_attribute_exist(node,"id")) THEN
182      value=getAttribute(node,"id")
183      CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
184    ELSE
185      CALL axis_group__get_new_axis(parent,pt_axis)
186    ENDIF
187     
188    CALL parsing_axis_attribute(node,pt_axis)
189 
190  END SUBROUTINE parsing_axis
191
192 
193  SUBROUTINE parsing_axis_attribute(node,pt_axis)
194  USE mod_axis
195  IMPLICIT NONE
196    TYPE(fnode), POINTER     :: node
197    TYPE(axis),POINTER :: pt_axis
198
199    CHARACTER(len=100) :: value
200   
201    IF (is_attribute_exist(node,"name")) THEN
202      value =  getAttribute(node,"name")
203      CALL axis__set(pt_axis,name=TRIM(value))
204    ENDIF
205
206    IF (is_attribute_exist(node,"description")) THEN
207      value =  getAttribute(node,"description")
208      CALL axis__set(pt_axis,description=TRIM(value))
209    ENDIF
210       
211    IF (is_attribute_exist(node,"unit")) THEN
212      value =  getAttribute(node,"unit")
213      CALL axis__set(pt_axis,unit=TRIM(value))
214    ENDIF
215   
216  END SUBROUTINE parsing_axis_attribute 
217
218
219
220
221
222
223
224
225  RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
226  USE mod_grid_definition
227  USE mod_grid_group
228  USE mod_grid
229  IMPLICIT NONE 
230    TYPE(fnode), POINTER     :: node
231    TYPE(grid_group),POINTER :: parent
232    LOGICAL,INTENT(IN),OPTIONAL :: root
233
234    TYPE(grid_group),POINTER :: pt_grid_group
235    TYPE(fnode), POINTER     :: child_node
236    TYPE(fnodeList), POINTER :: child_list
237    TYPE(grid),POINTER       :: attribute
238    LOGICAL                  :: is_root
239    INTEGER :: il
240    CHARACTER(len=100) :: node_name
241    CHARACTER(len=100) :: value
242 
243    is_root=.FALSE.
244    IF (PRESENT(root)) is_root=root
245 
246    IF (is_root) THEN
247      pt_grid_group=>parent
248    ELSE 
249      IF (is_attribute_exist(node,"id")) THEN
250        value=getAttribute(node,"id")
251        CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
252      ELSE
253        CALL grid_group__get_new_group(parent,pt_grid_group)
254      ENDIF
255    ENDIF
256     
257    CALL grid_group__get_default_attribut(pt_grid_group,attribute)
258    CALL parsing_grid_attribute(node,attribute)
259   
260    IF (hasChildNodes(node)) THEN
261      child_list => getChildnodes(node)
262
263      DO il=0,getLength(child_list)-1
264        child_node => item(child_list,il)
265        node_name=getNodename(child_node)
266       
267        SELECT CASE (TRIM(node_name)) 
268       
269          CASE ('group') 
270            CALL parsing_grid_group(child_node,pt_grid_group)
271             
272          CASE ('grid')
273            CALL parsing_grid(child_node,pt_grid_group)
274
275          CASE DEFAULT
276            IF (is_bad_node(node_name)) THEN
277              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
278              CALL Warning("mod_parse_xml:parsing_group_grid")
279            ENDIF
280        END SELECT
281      ENDDO
282    ENDIF
283
284  END SUBROUTINE parsing_grid_group
285
286  SUBROUTINE parsing_grid(node,parent)
287  USE mod_grid_group
288  USE mod_grid
289  IMPLICIT NONE 
290    TYPE(fnode), POINTER     :: node
291    TYPE(grid_group),POINTER :: parent
292   
293    TYPE(grid),POINTER :: pt_grid
294    TYPE(grid),POINTER       :: attribute
295    INTEGER :: il
296    CHARACTER(len=100) :: node_name
297    CHARACTER(len=100) :: value
298 
299     
300    IF (is_attribute_exist(node,"id")) THEN
301      value=getAttribute(node,"id")
302      CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
303    ELSE
304      CALL grid_group__get_new_grid(parent,pt_grid)
305    ENDIF
306     
307    CALL parsing_grid_attribute(node,pt_grid)
308 
309  END SUBROUTINE parsing_grid
310
311 
312  SUBROUTINE parsing_grid_attribute(node,pt_grid)
313  USE mod_grid
314  IMPLICIT NONE
315    TYPE(fnode), POINTER     :: node
316    TYPE(grid),POINTER :: pt_grid
317
318    CHARACTER(len=100) :: value
319   
320    IF (is_attribute_exist(node,"name")) THEN
321      value =  getAttribute(node,"name")
322      CALL grid__set(pt_grid,name=TRIM(value))
323    ENDIF
324
325    IF (is_attribute_exist(node,"description")) THEN
326      value =  getAttribute(node,"description")
327      CALL grid__set(pt_grid,description=TRIM(value))
328    ENDIF
329       
330  END SUBROUTINE parsing_grid_attribute 
331
332
333
334
335
336
337
338  RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
339  USE mod_field_definition
340  USE mod_field_group
341  USE mod_field
342  IMPLICIT NONE 
343    TYPE(fnode), POINTER          :: node
344    TYPE(field_group),POINTER     :: parent
345    LOGICAL,INTENT(IN),OPTIONAL   :: root
346   
347    TYPE(field_group),POINTER :: pt_field_group
348    TYPE(fnode), POINTER     :: child_node
349    TYPE(fnodeList), POINTER :: child_list
350    TYPE(field),POINTER       :: attribute
351    INTEGER :: il
352    CHARACTER(len=100) :: node_name
353    CHARACTER(len=100) :: value
354    LOGICAL            :: is_root
355   
356    is_root=.FALSE.
357    IF (PRESENT(root)) is_root=root
358   
359    IF (is_root) THEN
360      pt_field_group=>parent
361    ELSE 
362      IF (is_attribute_exist(node,"id")) THEN
363        value=getAttribute(node,"id")
364        CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
365      ELSE
366        CALL field_group__get_new_group(parent,pt_field_group)
367      ENDIF
368    ENDIF
369     
370    CALL field_group__get_default_attribut(pt_field_group,attribute)
371    CALL parsing_field_attribute(node,attribute)
372   
373    IF (hasChildNodes(node)) THEN
374      child_list => getChildnodes(node)
375
376      DO il=0,getLength(child_list)-1
377        child_node => item(child_list,il)
378        node_name=getNodename(child_node)
379       
380        SELECT CASE (TRIM(node_name)) 
381       
382          CASE ('group') 
383            CALL parsing_field_group(child_node,pt_field_group)
384             
385          CASE ('field')
386            CALL parsing_field(child_node,pt_field_group)
387
388          CASE DEFAULT
389            IF (is_bad_node(node_name)) THEN
390              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
391              CALL Warning("mod_parse_xml:parsing_group_field")
392            ENDIF
393        END SELECT
394      ENDDO
395    ENDIF
396
397  END SUBROUTINE parsing_field_group
398
399  SUBROUTINE parsing_field(node,parent)
400  USE mod_field_group
401  USE mod_field
402  IMPLICIT NONE 
403    TYPE(fnode), POINTER     :: node
404    TYPE(field_group),POINTER :: parent
405   
406    TYPE(field),POINTER :: pt_field
407    TYPE(field),POINTER       :: attribute
408    INTEGER :: il
409    CHARACTER(len=100) :: node_name
410    CHARACTER(len=100) :: value
411 
412     
413    IF (is_attribute_exist(node,"id")) THEN
414      value=getAttribute(node,"id")
415      CALL field_group__get_new_field(parent,pt_field,TRIM(value))
416    ELSE
417      CALL field_group__get_new_field(parent,pt_field)
418    ENDIF
419     
420    CALL parsing_field_attribute(node,pt_field)
421 
422  END SUBROUTINE parsing_field
423
424 
425  SUBROUTINE parsing_field_attribute(node,pt_field)
426  USE mod_field
427  IMPLICIT NONE
428    TYPE(fnode), POINTER     :: node
429    TYPE(field),POINTER :: pt_field
430
431    CHARACTER(len=100) :: value
432   
433    IF (is_attribute_exist(node,"name")) THEN
434      value =  getAttribute(node,"name")
435      CALL field__set(pt_field,name=TRIM(value))
436    ENDIF
437
438    IF (is_attribute_exist(node,"description")) THEN
439      value =  getAttribute(node,"description")
440      CALL field__set(pt_field,description=TRIM(value))
441    ENDIF
442       
443    IF (is_attribute_exist(node,"unit")) THEN
444      value =  getAttribute(node,"unit")
445      CALL field__set(pt_field,unit=TRIM(value))
446    ENDIF
447
448    IF (is_attribute_exist(node,"operation")) THEN
449      value =  getAttribute(node,"operation")
450      CALL field__set(pt_field,operation=TRIM(value))
451    ENDIF
452
453    IF (is_attribute_exist(node,"freq_op")) THEN
454      value =  getAttribute(node,"freq_op")
455      CALL field__set(pt_field,freq_op=string_to_integer(value))
456    ENDIF
457   
458    IF (is_attribute_exist(node,"axis_ref")) THEN
459      value =  getAttribute(node,"axis_ref")
460      CALL field__set(pt_field,axis_ref=TRIM(value))
461    ENDIF
462
463    IF (is_attribute_exist(node,"grid_ref")) THEN
464      value =  getAttribute(node,"grid_ref")
465      CALL field__set(pt_field,grid_ref=TRIM(value))
466    ENDIF
467
468    IF (is_attribute_exist(node,"level")) THEN
469      value =  getAttribute(node,"level")
470      CALL field__set(pt_field,level=string_to_integer(value))
471    ENDIF
472   
473    IF (is_attribute_exist(node,"prec")) THEN
474      value =  getAttribute(node,"prec")
475      CALL field__set(pt_field,prec=string_to_integer(value))
476    ENDIF
477
478    IF (is_attribute_exist(node,"ref")) THEN
479      value =  getAttribute(node,"ref")
480      CALL field__set(pt_field,ref=TRIM(value))
481    ENDIF
482
483    IF (is_attribute_exist(node,"enabled")) THEN
484      value =  getAttribute(node,"enabled")
485      CALL field__set(pt_field,enabled=string_to_logical(value))
486    ENDIF
487 
488
489  END SUBROUTINE parsing_field_attribute 
490 
491 
492 
493
494
495  RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
496  USE mod_file_definition
497  USE mod_file_group
498  USE mod_file
499  IMPLICIT NONE 
500    TYPE(fnode), POINTER          :: node
501    TYPE(file_group),POINTER      :: parent
502    LOGICAL,INTENT(IN),OPTIONAL   :: root
503
504    TYPE(file_group),POINTER :: pt_file_group
505    TYPE(fnode), POINTER     :: child_node
506    TYPE(fnodeList), POINTER :: child_list
507    TYPE(file),POINTER       :: attribute
508    LOGICAL                  :: is_root
509    INTEGER :: il
510    CHARACTER(len=100) :: node_name
511    CHARACTER(len=100) :: value
512   
513    is_root=.FALSE.
514    IF (PRESENT(root)) is_root=root
515 
516    IF (is_root) THEN
517      pt_file_group=>parent
518    ELSE 
519      IF (is_attribute_exist(node,"id")) THEN
520        value=getAttribute(node,"id")
521        CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
522      ELSE
523        CALL file_group__get_new_group(parent,pt_file_group)
524      ENDIF
525    ENDIF
526     
527    CALL file_group__get_default_attribut(pt_file_group,attribute)
528    CALL parsing_file_attribute(node,attribute)
529   
530    IF (hasChildNodes(node)) THEN
531      child_list => getChildnodes(node)
532
533      DO il=0,getLength(child_list)-1
534        child_node => item(child_list,il)
535        node_name=getNodename(child_node)
536       
537        SELECT CASE (TRIM(node_name)) 
538       
539          CASE ('group') 
540            CALL parsing_file_group(child_node,pt_file_group)
541             
542          CASE ('file')
543            CALL parsing_file(child_node,pt_file_group)
544
545          CASE DEFAULT
546            IF (is_bad_node(node_name)) THEN
547              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
548              CALL Warning("mod_parse_xml:parsing_group_file")
549            ENDIF
550        END SELECT
551      ENDDO
552    ENDIF
553
554  END SUBROUTINE parsing_file_group
555
556  SUBROUTINE parsing_file(node,parent)
557  USE mod_file_group
558  USE mod_file
559  IMPLICIT NONE 
560    TYPE(fnode), POINTER     :: node
561    TYPE(file_group),POINTER :: parent
562   
563    TYPE(file),POINTER :: pt_file
564    TYPE(file),POINTER       :: attribute
565    TYPE(fnode), POINTER     :: child_node
566    TYPE(fnodeList), POINTER :: child_list
567    INTEGER :: il
568    CHARACTER(len=100) :: node_name
569    CHARACTER(len=100) :: value
570 
571     
572    IF (is_attribute_exist(node,"id")) THEN
573      value=getAttribute(node,"id")
574      CALL file_group__get_new_file(parent,pt_file,TRIM(value))
575    ELSE
576      CALL file_group__get_new_file(parent,pt_file)
577    ENDIF
578     
579    CALL parsing_file_attribute(node,pt_file)
580 
581    IF (hasChildNodes(node)) THEN
582      child_list => getChildnodes(node)
583
584      DO il=0,getLength(child_list)-1
585        child_node => item(child_list,il)
586        node_name=getNodename(child_node)
587       
588        SELECT CASE (TRIM(node_name)) 
589       
590          CASE ('group') 
591            CALL parsing_field_group(child_node,pt_file%field_list)
592             
593          CASE ('field')
594            CALL parsing_field(child_node,pt_file%field_list)
595
596          CASE DEFAULT
597            IF (is_bad_node(node_name)) THEN
598              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
599              CALL Warning("mod_parse_xml:parsing_group_file")
600            ENDIF
601        END SELECT
602      ENDDO
603    ENDIF
604  END SUBROUTINE parsing_file
605
606 
607  SUBROUTINE parsing_file_attribute(node,pt_file)
608  USE mod_file
609  IMPLICIT NONE
610    TYPE(fnode), POINTER     :: node
611    TYPE(file),POINTER :: pt_file
612
613    CHARACTER(len=100) :: value
614   
615    IF (is_attribute_exist(node,"name")) THEN
616      value =  getAttribute(node,"name")
617      CALL file__set(pt_file,name=TRIM(value))
618    ENDIF
619
620    IF (is_attribute_exist(node,"description")) THEN
621      value =  getAttribute(node,"description")
622      CALL file__set(pt_file,description=TRIM(value))
623    ENDIF
624       
625    IF (is_attribute_exist(node,"output_freq")) THEN
626      value =  getAttribute(node,"output_freq")
627      CALL file__set(pt_file,output_freq=string_to_integer(value))
628    ENDIF
629   
630    IF (is_attribute_exist(node,"output_level")) THEN
631      value =  getAttribute(node,"output_level")
632      CALL file__set(pt_file,output_level=string_to_integer(value))
633    ENDIF
634
635    IF (is_attribute_exist(node,"enabled")) THEN
636      value =  getAttribute(node,"enabled")
637      CALL file__set(pt_file,enabled=string_to_logical(value))
638    ENDIF
639
640  END SUBROUTINE parsing_file_attribute
641 
642
643   
644 
645  FUNCTION is_attribute_exist(node, name)
646
647    LOGICAL :: is_attribute_exist
648    TYPE(fnode), POINTER :: node
649    CHARACTER(len=*) :: name
650    CHARACTER(len=100) :: value
651
652    value=""
653   
654    is_attribute_exist= .false.
655    value=getAttribute(node, TRIM(name))
656    IF (value .NE. "") is_attribute_exist= .true.
657
658  END FUNCTION is_attribute_exist
659
660  FUNCTION is_bad_node(node_name)
661  IMPLICIT NONE
662    CHARACTER(len=*),INTENT(IN) :: node_name
663    LOGICAL                     :: is_bad_node
664   
665    IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
666      is_bad_node=.FALSE.
667    ELSE
668      is_bad_node=.TRUE.
669    ENDIF
670     
671  END FUNCTION is_bad_node
672 
673END MODULE parsing_xml
Note: See TracBrowser for help on using the repository browser.