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

Last change on this file since 29 was 29, checked in by ymipsl, 13 years ago

New Features :

  • Les zoom sont maintenant utilisables.
  • Lorsqu'un serveur ne sort pas de données dans un fichier, le fichier n'est pas crée.
  • Lorsqu'un serveur est le seul a sortir un fichier, l'indexation par numero de process est supprimé.
  • Les axes verticaux ont maintenant un attribut << positive [TRUE/FALSE]>>
File size: 22.2 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_simulation(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      ENDDO
49    ENDIF
50             
51  END SUBROUTINE parsing_root
52
53  SUBROUTINE parsing_simulation(root)
54  IMPLICIT NONE
55    TYPE(fnode), POINTER :: root
56    TYPE(fnode), POINTER :: child_node
57    TYPE(fnodeList), POINTER :: child_list
58
59    INTEGER :: il
60    CHARACTER(len=100) :: node_name
61     
62     IF (hasChildNodes(root)) THEN
63      child_list => getChildnodes(root)
64
65      DO il=0,getLength(child_list)-1
66        child_node => item(child_list,il)
67        node_name=getNodename(child_node)
68         
69        SELECT CASE (TRIM(node_name)) 
70         
71           CASE ('context') 
72             CALL parsing_context(child_node)
73
74           CASE DEFAULT
75             IF (is_bad_node(node_name)) THEN
76               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation'
77               CALL Warning("mod_parse_xml:parsing_simulationt")
78             ENDIF
79         END SELECT
80       
81       ENDDO
82    ENDIF
83             
84  END SUBROUTINE parsing_simulation
85
86  SUBROUTINE parsing_context(node)
87  USE mod_context
88  USE mod_axis_definition
89  USE mod_grid_definition
90  USE mod_field_definition
91  USE mod_file_definition
92  IMPLICIT NONE 
93    TYPE(fnode), POINTER         :: node
94   
95    TYPE(fnode), POINTER     :: child_node
96    TYPE(fnodeList), POINTER :: child_list
97    TYPE(axis),POINTER       :: attribute
98    LOGICAL                  :: is_root
99    INTEGER :: il
100    CHARACTER(len=100) :: node_name
101    CHARACTER(len=100) :: value
102   
103    IF (is_attribute_exist(node,"id")) THEN
104      value=getAttribute(node,"id")
105      CALL context__create(TRIM(value)) 
106      CALL context__swap(TRIM(value))
107    ENDIF
108   
109    IF (hasChildNodes(node)) THEN
110      child_list => getChildnodes(node)
111
112      DO il=0,getLength(child_list)-1
113        child_node => item(child_list,il)
114        node_name=getNodename(child_node)
115       
116        SELECT CASE (TRIM(node_name)) 
117         
118           CASE ('axis_definition') 
119             CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
120               
121           CASE ('grid_definition')
122             CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
123               
124           CASE ('field_definition')
125             CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
126               
127           CASE ('file_definition')
128             CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
129               
130           CASE DEFAULT
131             IF (is_bad_node(node_name)) THEN
132               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context'
133               CALL Warning("mod_parse_xml:parsing_context")
134             ENDIF   
135        END SELECT
136      ENDDO
137
138    ENDIF
139
140  END SUBROUTINE parsing_context
141
142
143  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
144  USE mod_axis_definition
145  USE mod_axis_group
146  USE mod_axis
147  IMPLICIT NONE 
148    TYPE(fnode), POINTER         :: node
149    TYPE(axis_group),POINTER     :: parent
150    LOGICAL,INTENT(IN),OPTIONAL :: root
151   
152    TYPE(axis_group),POINTER :: pt_axis_group
153    TYPE(fnode), POINTER     :: child_node
154    TYPE(fnodeList), POINTER :: child_list
155    TYPE(axis),POINTER       :: attribute
156    LOGICAL                  :: is_root
157    INTEGER :: il
158    CHARACTER(len=100) :: node_name
159    CHARACTER(len=100) :: value
160   
161    is_root=.FALSE.
162    IF (PRESENT(root)) is_root=root
163 
164    IF (is_root) THEN
165      pt_axis_group=>parent
166    ELSE 
167      IF (is_attribute_exist(node,"id")) THEN
168        value=getAttribute(node,"id")
169        CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
170      ELSE
171        CALL axis_group__get_new_group(parent,pt_axis_group)
172      ENDIF
173    ENDIF
174     
175    CALL axis_group__get_default_attrib(pt_axis_group,attribute)
176    CALL parsing_axis_attribute(node,attribute)
177   
178    IF (hasChildNodes(node)) THEN
179      child_list => getChildnodes(node)
180
181      DO il=0,getLength(child_list)-1
182        child_node => item(child_list,il)
183        node_name=getNodename(child_node)
184       
185        SELECT CASE (TRIM(node_name)) 
186       
187          CASE ('group') 
188            CALL parsing_axis_group(child_node,pt_axis_group)
189             
190          CASE ('axis')
191            CALL parsing_axis(child_node,pt_axis_group)
192
193          CASE DEFAULT
194            IF (is_bad_node(node_name)) THEN
195              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
196              CALL Warning("mod_parse_xml:parsing_group_axis")
197            ENDIF
198        END SELECT
199      ENDDO
200    ENDIF
201
202  END SUBROUTINE parsing_axis_group
203
204  SUBROUTINE parsing_axis(node,parent)
205  USE mod_axis_group
206  USE mod_axis
207  IMPLICIT NONE 
208    TYPE(fnode), POINTER     :: node
209    TYPE(axis_group),POINTER :: parent
210   
211    TYPE(axis),POINTER :: pt_axis
212    TYPE(axis),POINTER       :: attribute
213    INTEGER :: il
214    CHARACTER(len=100) :: node_name
215    CHARACTER(len=100) :: value
216 
217     
218    IF (is_attribute_exist(node,"id")) THEN
219      value=getAttribute(node,"id")
220      CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
221    ELSE
222      CALL axis_group__get_new_axis(parent,pt_axis)
223    ENDIF
224     
225    CALL parsing_axis_attribute(node,pt_axis)
226 
227  END SUBROUTINE parsing_axis
228
229 
230  SUBROUTINE parsing_axis_attribute(node,pt_axis)
231  USE mod_axis
232  IMPLICIT NONE
233    TYPE(fnode), POINTER     :: node
234    TYPE(axis),POINTER :: pt_axis
235
236    CHARACTER(len=100) :: value
237   
238    IF (is_attribute_exist(node,"name")) THEN
239      value =  getAttribute(node,"name")
240      CALL axis__set(pt_axis,name=TRIM(value))
241    ENDIF
242
243    IF (is_attribute_exist(node,"description")) THEN
244      value =  getAttribute(node,"description")
245      CALL axis__set(pt_axis,description=TRIM(value))
246    ENDIF
247       
248    IF (is_attribute_exist(node,"unit")) THEN
249      value =  getAttribute(node,"unit")
250      CALL axis__set(pt_axis,unit=TRIM(value))
251    ENDIF
252
253    IF (is_attribute_exist(node,"size")) THEN
254      value =  getAttribute(node,"size")
255      CALL axis__set(pt_axis,a_size=string_to_integer(value))
256    ENDIF
257
258    IF (is_attribute_exist(node,"positive")) THEN
259      value =  getAttribute(node,"positive")
260      CALL axis__set(pt_axis,positive=string_to_logical(value))
261    ENDIF
262   
263  END SUBROUTINE parsing_axis_attribute 
264
265
266
267
268
269
270
271
272  RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
273  USE mod_grid_definition
274  USE mod_grid_group
275  USE mod_grid
276  IMPLICIT NONE 
277    TYPE(fnode), POINTER     :: node
278    TYPE(grid_group),POINTER :: parent
279    LOGICAL,INTENT(IN),OPTIONAL :: root
280
281    TYPE(grid_group),POINTER :: pt_grid_group
282    TYPE(fnode), POINTER     :: child_node
283    TYPE(fnodeList), POINTER :: child_list
284    TYPE(grid),POINTER       :: attribute
285    LOGICAL                  :: is_root
286    INTEGER :: il
287    CHARACTER(len=100) :: node_name
288    CHARACTER(len=100) :: value
289 
290    is_root=.FALSE.
291    IF (PRESENT(root)) is_root=root
292 
293    IF (is_root) THEN
294      pt_grid_group=>parent
295    ELSE 
296      IF (is_attribute_exist(node,"id")) THEN
297        value=getAttribute(node,"id")
298        CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
299      ELSE
300        CALL grid_group__get_new_group(parent,pt_grid_group)
301      ENDIF
302    ENDIF
303     
304    CALL grid_group__get_default_attrib(pt_grid_group,attribute)
305    CALL parsing_grid_attribute(node,attribute)
306   
307    IF (hasChildNodes(node)) THEN
308      child_list => getChildnodes(node)
309
310      DO il=0,getLength(child_list)-1
311        child_node => item(child_list,il)
312        node_name=getNodename(child_node)
313       
314        SELECT CASE (TRIM(node_name)) 
315       
316          CASE ('group') 
317            CALL parsing_grid_group(child_node,pt_grid_group)
318             
319          CASE ('grid')
320            CALL parsing_grid(child_node,pt_grid_group)
321
322          CASE DEFAULT
323            IF (is_bad_node(node_name)) THEN
324              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
325              CALL Warning("mod_parse_xml:parsing_group_grid")
326            ENDIF
327        END SELECT
328      ENDDO
329    ENDIF
330
331  END SUBROUTINE parsing_grid_group
332
333  SUBROUTINE parsing_grid(node,parent)
334  USE mod_grid_group
335  USE mod_grid
336  IMPLICIT NONE 
337    TYPE(fnode), POINTER     :: node
338    TYPE(grid_group),POINTER :: parent
339   
340    TYPE(grid),POINTER       :: pt_grid
341    TYPE(fnode), POINTER     :: child_node
342    TYPE(fnodeList), POINTER :: child_list
343    INTEGER :: il
344    CHARACTER(len=100) :: node_name
345    CHARACTER(len=100) :: value
346 
347     
348    IF (is_attribute_exist(node,"id")) THEN
349      value=getAttribute(node,"id")
350      CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
351    ELSE
352      CALL grid_group__get_new_grid(parent,pt_grid)
353    ENDIF
354     
355    CALL parsing_grid_attribute(node,pt_grid)
356   
357
358   IF (hasChildNodes(node)) THEN
359      child_list => getChildnodes(node)
360
361      DO il=0,getLength(child_list)-1
362        child_node => item(child_list,il)
363        node_name=getNodename(child_node)
364       
365        SELECT CASE (TRIM(node_name)) 
366       
367          CASE ('zoom') 
368            CALL parsing_zoom(child_node,pt_grid)
369             
370          CASE DEFAULT
371            IF (is_bad_node(node_name)) THEN
372              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid'
373              CALL Warning("mod_parse_xml:parsing_grid")
374            ENDIF
375        END SELECT
376      ENDDO
377    ENDIF
378 
379  END SUBROUTINE parsing_grid
380
381  SUBROUTINE parsing_grid_attribute(node,pt_grid)
382  USE mod_grid
383  IMPLICIT NONE
384    TYPE(fnode), POINTER     :: node
385    TYPE(grid),POINTER :: pt_grid
386
387    CHARACTER(len=100) :: value
388   
389    IF (is_attribute_exist(node,"name")) THEN
390      value =  getAttribute(node,"name")
391      CALL grid__set(pt_grid,name=TRIM(value))
392    ENDIF
393
394    IF (is_attribute_exist(node,"description")) THEN
395      value =  getAttribute(node,"description")
396      CALL grid__set(pt_grid,description=TRIM(value))
397    ENDIF
398       
399  END SUBROUTINE parsing_grid_attribute 
400
401  SUBROUTINE parsing_zoom(node,parent)
402  USE mod_zoom
403  USE mod_grid 
404  IMPLICIT NONE 
405    TYPE(fnode), POINTER     :: node
406    TYPE(grid),POINTER       :: parent
407   
408    TYPE(zoom),POINTER       :: pt_zoom
409    INTEGER :: il
410    CHARACTER(len=100) :: node_name
411    CHARACTER(len=100) :: value
412 
413     
414    IF (is_attribute_exist(node,"id")) THEN
415      value=getAttribute(node,"id")
416      CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value))
417    ELSE
418      CALL grid__get_new_zoom(parent,pt_zoom)
419    ENDIF
420     
421    CALL parsing_zoom_attribute(node,pt_zoom)
422   
423  END SUBROUTINE parsing_zoom
424
425
426  SUBROUTINE parsing_zoom_attribute(node,pt_zoom)
427  USE mod_zoom
428  IMPLICIT NONE
429    TYPE(fnode), POINTER     :: node
430    TYPE(zoom),POINTER       :: pt_zoom
431
432    CHARACTER(len=100) :: value
433   
434    IF (is_attribute_exist(node,"name")) THEN
435      value =  getAttribute(node,"name")
436      CALL zoom__set(pt_zoom,name=TRIM(value))
437    ENDIF
438
439    IF (is_attribute_exist(node,"description")) THEN
440      value =  getAttribute(node,"description")
441      CALL zoom__set(pt_zoom,description=TRIM(value))
442    ENDIF
443
444    IF (is_attribute_exist(node,"ni")) THEN
445      value =  getAttribute(node,"ni")
446      CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value))
447    ENDIF
448
449    IF (is_attribute_exist(node,"nj")) THEN
450      value =  getAttribute(node,"nj")
451      CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value))
452    ENDIF
453
454    IF (is_attribute_exist(node,"ibegin")) THEN
455      value =  getAttribute(node,"ibegin")
456      CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value))
457    ENDIF
458
459    IF (is_attribute_exist(node,"jbegin")) THEN
460      value =  getAttribute(node,"jbegin")
461      CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value))
462    ENDIF
463       
464  END SUBROUTINE parsing_zoom_attribute 
465
466
467
468  RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
469  USE mod_field_definition
470  USE mod_field_group
471  USE mod_field
472  IMPLICIT NONE 
473    TYPE(fnode), POINTER          :: node
474    TYPE(field_group),POINTER     :: parent
475    LOGICAL,INTENT(IN),OPTIONAL   :: root
476   
477    TYPE(field_group),POINTER :: pt_field_group
478    TYPE(fnode), POINTER     :: child_node
479    TYPE(fnodeList), POINTER :: child_list
480    TYPE(field),POINTER       :: attribute
481    INTEGER :: il
482    CHARACTER(len=100) :: node_name
483    CHARACTER(len=100) :: value
484    LOGICAL            :: is_root
485   
486    is_root=.FALSE.
487    IF (PRESENT(root)) is_root=root
488   
489    IF (is_root) THEN
490      pt_field_group=>parent
491    ELSE 
492      IF (is_attribute_exist(node,"id")) THEN
493        value=getAttribute(node,"id")
494        CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
495      ELSE
496        CALL field_group__get_new_group(parent,pt_field_group)
497      ENDIF
498    ENDIF
499     
500    CALL field_group__get_default_attrib(pt_field_group,attribute)
501    CALL parsing_field_attribute(node,attribute)
502   
503    IF (hasChildNodes(node)) THEN
504      child_list => getChildnodes(node)
505
506      DO il=0,getLength(child_list)-1
507        child_node => item(child_list,il)
508        node_name=getNodename(child_node)
509       
510        SELECT CASE (TRIM(node_name)) 
511       
512          CASE ('group') 
513            CALL parsing_field_group(child_node,pt_field_group)
514             
515          CASE ('field')
516            CALL parsing_field(child_node,pt_field_group)
517
518          CASE DEFAULT
519            IF (is_bad_node(node_name)) THEN
520              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
521              CALL Warning("mod_parse_xml:parsing_group_field")
522            ENDIF
523        END SELECT
524      ENDDO
525    ENDIF
526
527  END SUBROUTINE parsing_field_group
528
529  SUBROUTINE parsing_field(node,parent)
530  USE mod_field_group
531  USE mod_field
532  IMPLICIT NONE 
533    TYPE(fnode), POINTER     :: node
534    TYPE(field_group),POINTER :: parent
535   
536    TYPE(field),POINTER :: pt_field
537    TYPE(field),POINTER       :: attribute
538    INTEGER :: il
539    CHARACTER(len=100) :: node_name
540    CHARACTER(len=100) :: value
541 
542     
543    IF (is_attribute_exist(node,"id")) THEN
544      value=getAttribute(node,"id")
545      CALL field_group__get_new_field(parent,pt_field,TRIM(value))
546    ELSE
547      CALL field_group__get_new_field(parent,pt_field)
548    ENDIF
549     
550    CALL parsing_field_attribute(node,pt_field)
551 
552  END SUBROUTINE parsing_field
553
554 
555  SUBROUTINE parsing_field_attribute(node,pt_field)
556  USE mod_field
557  IMPLICIT NONE
558    TYPE(fnode), POINTER     :: node
559    TYPE(field),POINTER :: pt_field
560
561    CHARACTER(len=100) :: value
562   
563    IF (is_attribute_exist(node,"name")) THEN
564      value =  getAttribute(node,"name")
565      CALL field__set(pt_field,name=TRIM(value))
566    ENDIF
567
568    IF (is_attribute_exist(node,"description")) THEN
569      value =  getAttribute(node,"description")
570      CALL field__set(pt_field,description=TRIM(value))
571    ENDIF
572       
573    IF (is_attribute_exist(node,"unit")) THEN
574      value =  getAttribute(node,"unit")
575      CALL field__set(pt_field,unit=TRIM(value))
576    ENDIF
577
578    IF (is_attribute_exist(node,"operation")) THEN
579      value =  getAttribute(node,"operation")
580      CALL field__set(pt_field,operation=TRIM(value))
581    ENDIF
582
583    IF (is_attribute_exist(node,"freq_op")) THEN
584      value =  getAttribute(node,"freq_op")
585      CALL field__set(pt_field,freq_op=string_to_integer(value))
586    ENDIF
587   
588    IF (is_attribute_exist(node,"axis_ref")) THEN
589      value =  getAttribute(node,"axis_ref")
590      CALL field__set(pt_field,axis_ref=TRIM(value))
591    ENDIF
592
593    IF (is_attribute_exist(node,"grid_ref")) THEN
594      value =  getAttribute(node,"grid_ref")
595      CALL field__set(pt_field,grid_ref=TRIM(value))
596    ENDIF
597
598    IF (is_attribute_exist(node,"zoom_ref")) THEN
599      value =  getAttribute(node,"zoom_ref")
600      CALL field__set(pt_field,zoom_ref=TRIM(value))
601    ENDIF
602
603    IF (is_attribute_exist(node,"level")) THEN
604      value =  getAttribute(node,"level")
605      CALL field__set(pt_field,level=string_to_integer(value))
606    ENDIF
607   
608    IF (is_attribute_exist(node,"prec")) THEN
609      value =  getAttribute(node,"prec")
610      CALL field__set(pt_field,prec=string_to_integer(value))
611    ENDIF
612
613    IF (is_attribute_exist(node,"ref")) THEN
614      value =  getAttribute(node,"ref")
615      CALL field__set(pt_field,ref=TRIM(value))
616    ENDIF
617
618    IF (is_attribute_exist(node,"enabled")) THEN
619      value =  getAttribute(node,"enabled")
620      CALL field__set(pt_field,enabled=string_to_logical(value))
621    ENDIF
622 
623
624  END SUBROUTINE parsing_field_attribute 
625
626
627  RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
628  USE mod_file_definition
629  USE mod_file_group
630  USE mod_file
631  IMPLICIT NONE 
632    TYPE(fnode), POINTER          :: node
633    TYPE(file_group),POINTER      :: parent
634    LOGICAL,INTENT(IN),OPTIONAL   :: root
635
636    TYPE(file_group),POINTER :: pt_file_group
637    TYPE(fnode), POINTER     :: child_node
638    TYPE(fnodeList), POINTER :: child_list
639    TYPE(file),POINTER       :: attribute
640    LOGICAL                  :: is_root
641    INTEGER :: il
642    CHARACTER(len=100) :: node_name
643    CHARACTER(len=100) :: value
644   
645    is_root=.FALSE.
646    IF (PRESENT(root)) is_root=root
647 
648    IF (is_root) THEN
649      pt_file_group=>parent
650    ELSE 
651      IF (is_attribute_exist(node,"id")) THEN
652        value=getAttribute(node,"id")
653        CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
654      ELSE
655        CALL file_group__get_new_group(parent,pt_file_group)
656      ENDIF
657    ENDIF
658     
659    CALL file_group__get_default_attrib(pt_file_group,attribute)
660    CALL parsing_file_attribute(node,attribute)
661   
662    IF (hasChildNodes(node)) THEN
663      child_list => getChildnodes(node)
664
665      DO il=0,getLength(child_list)-1
666        child_node => item(child_list,il)
667        node_name=getNodename(child_node)
668       
669        SELECT CASE (TRIM(node_name)) 
670       
671          CASE ('group') 
672            CALL parsing_file_group(child_node,pt_file_group)
673             
674          CASE ('file')
675            CALL parsing_file(child_node,pt_file_group)
676
677          CASE DEFAULT
678            IF (is_bad_node(node_name)) THEN
679              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
680              CALL Warning("mod_parse_xml:parsing_group_file")
681            ENDIF
682        END SELECT
683      ENDDO
684    ENDIF
685
686  END SUBROUTINE parsing_file_group
687
688  SUBROUTINE parsing_file(node,parent)
689  USE mod_file_group
690  USE mod_file
691  IMPLICIT NONE 
692    TYPE(fnode), POINTER     :: node
693    TYPE(file_group),POINTER :: parent
694   
695    TYPE(file),POINTER :: pt_file
696    TYPE(file),POINTER       :: attribute
697    TYPE(fnode), POINTER     :: child_node
698    TYPE(fnodeList), POINTER :: child_list
699    INTEGER :: il
700    CHARACTER(len=100) :: node_name
701    CHARACTER(len=100) :: value
702 
703     
704    IF (is_attribute_exist(node,"id")) THEN
705      value=getAttribute(node,"id")
706      CALL file_group__get_new_file(parent,pt_file,TRIM(value))
707    ELSE
708      CALL file_group__get_new_file(parent,pt_file)
709    ENDIF
710     
711    CALL parsing_file_attribute(node,pt_file)
712 
713    IF (hasChildNodes(node)) THEN
714      child_list => getChildnodes(node)
715
716      DO il=0,getLength(child_list)-1
717        child_node => item(child_list,il)
718        node_name=getNodename(child_node)
719       
720        SELECT CASE (TRIM(node_name)) 
721       
722          CASE ('group') 
723            CALL parsing_field_group(child_node,pt_file%field_list)
724             
725          CASE ('field')
726            CALL parsing_field(child_node,pt_file%field_list)
727
728          CASE DEFAULT
729            IF (is_bad_node(node_name)) THEN
730              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
731              CALL Warning("mod_parse_xml:parsing_group_file")
732            ENDIF
733        END SELECT
734      ENDDO
735    ENDIF
736  END SUBROUTINE parsing_file
737
738 
739  SUBROUTINE parsing_file_attribute(node,pt_file)
740  USE mod_file
741  IMPLICIT NONE
742    TYPE(fnode), POINTER     :: node
743    TYPE(file),POINTER :: pt_file
744
745    CHARACTER(len=100) :: value
746   
747    IF (is_attribute_exist(node,"name")) THEN
748      value =  getAttribute(node,"name")
749      CALL file__set(pt_file,name=TRIM(value))
750    ENDIF
751
752    IF (is_attribute_exist(node,"description")) THEN
753      value =  getAttribute(node,"description")
754      CALL file__set(pt_file,description=TRIM(value))
755    ENDIF
756       
757    IF (is_attribute_exist(node,"output_freq")) THEN
758      value =  getAttribute(node,"output_freq")
759      CALL file__set(pt_file,output_freq=string_to_integer(value))
760    ENDIF
761   
762    IF (is_attribute_exist(node,"output_level")) THEN
763      value =  getAttribute(node,"output_level")
764      CALL file__set(pt_file,output_level=string_to_integer(value))
765    ENDIF
766
767    IF (is_attribute_exist(node,"enabled")) THEN
768      value =  getAttribute(node,"enabled")
769      CALL file__set(pt_file,enabled=string_to_logical(value))
770    ENDIF
771
772  END SUBROUTINE parsing_file_attribute
773 
774
775   
776 
777  FUNCTION is_attribute_exist(node, name)
778
779    LOGICAL :: is_attribute_exist
780    TYPE(fnode), POINTER :: node
781    CHARACTER(len=*) :: name
782    CHARACTER(len=100) :: value
783
784    value=""
785   
786    is_attribute_exist= .false.
787    value=getAttribute(node, TRIM(name))
788    IF (value .NE. "") is_attribute_exist= .true.
789
790  END FUNCTION is_attribute_exist
791
792  FUNCTION is_bad_node(node_name)
793  IMPLICIT NONE
794    CHARACTER(len=*),INTENT(IN) :: node_name
795    LOGICAL                     :: is_bad_node
796   
797    IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
798      is_bad_node=.FALSE.
799    ELSE
800      is_bad_node=.TRUE.
801    ENDIF
802     
803  END FUNCTION is_bad_node
804 
805END MODULE parsing_xml
Note: See TracBrowser for help on using the repository browser.