New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
m_dom_parse.f90 in vendors/XMLF90/current/src/dom – NEMO

source: vendors/XMLF90/current/src/dom/m_dom_parse.f90 @ 1963

Last change on this file since 1963 was 1963, checked in by flavoni, 14 years ago

importing XMLF90 r_53 vendor

File size: 3.7 KB
Line 
1module m_dom_parse
2
3  use m_dom_types
4  use m_dom_element
5  use m_dom_document
6  use m_dom_node
7!  use m_dom_namednodemap
8  use m_dom_debug
9
10  use flib_sax
11
12  implicit none
13 
14  private
15
16  public :: parsefile
17
18  type(fnode), pointer, private, save  :: main
19  type(fnode), pointer, private, save  :: current
20
21
22CONTAINS
23
24  subroutine begin_element_handler(name,attrs)
25
26    character(len=*),   intent(in) :: name
27    type(dictionary_t), intent(in) :: attrs
28   
29    type(fnode), pointer :: temp
30    character(len=400)   :: attr_name, attr_value
31    integer              :: status
32    integer              :: i
33
34    if (dom_debug) print *, "Adding node for element: ", name
35
36    temp => createElement(name)
37    current => appendChild(current,temp)
38!
39!   Add attributes
40!
41    do i = 1, len(attrs)
42       call get_name(attrs, i, attr_name, status)
43       call get_value(attrs, attr_name, attr_value, status)
44       if (dom_debug) print *, "Adding attribute: ", &
45                       trim(attr_name), ":",trim(attr_value)
46       call setAttribute(current,attr_name,attr_value)
47    enddo
48
49  end subroutine begin_element_handler
50
51!---------------------------------------------------------
52
53  subroutine end_element_handler(name)
54    character(len=*), intent(in)     :: name
55
56!!AG for IBM    type(fnode), pointer :: np
57
58    if (dom_debug) print *, "End of element: ", name
59!!AG for IBM    np => getParentNode(current)
60!!AG for IBM    current => np
61    current => getParentNode(current)
62  end subroutine end_element_handler
63
64!---------------------------------------------------------
65
66  subroutine pcdata_chunk_handler(chunk)
67    character(len=*), intent(in) :: chunk
68
69    type(fnode), pointer :: temp, dummy
70   
71    if (dom_debug) print *, "Got PCDATA: |", chunk, "|"
72
73    temp => createTextNode(chunk)
74    dummy => appendChild(current,temp)
75
76  end subroutine pcdata_chunk_handler
77
78!---------------------------------------------------------
79
80  subroutine comment_handler(comment)
81    character(len=*), intent(in) :: comment
82
83    type(fnode), pointer :: temp, dummy
84
85    if (dom_debug) print *, "Got COMMENT: |", comment, "|"
86
87    temp => createComment(comment)
88    dummy => appendChild(current,temp)
89
90  end subroutine comment_handler
91!---------------------------------------------------------
92  subroutine cdata_section_handler(chunk)
93    character(len=*), intent(in) :: chunk
94
95    type(fnode), pointer :: temp, dummy
96   
97    if (dom_debug) print *, "Got CDATA_SECTION: |", chunk, "|"
98
99    temp => createCdataSection(chunk)
100    dummy => appendChild(current,temp)
101
102  end subroutine cdata_section_handler
103
104!***************************************************
105!   PUBLIC PROCEDURES
106!***************************************************
107
108
109  function parsefile(filename, verbose, sax_verbose)
110
111    character(len=*), intent(in) :: filename
112    logical, intent(in), optional :: verbose
113    logical, intent(in), optional :: sax_verbose
114
115    type(fnode), pointer :: parsefile
116
117    logical :: sax_debug = .false.
118
119    type(xml_t) :: fxml
120    integer :: iostat
121
122    if (present(verbose)) then
123       dom_debug = verbose
124    endif
125
126    if (present(sax_verbose)) then
127       sax_debug = sax_verbose
128    endif
129   
130    call open_xmlfile(filename, fxml, iostat)
131
132    PRINT *,'filename : ',filename
133    if (iostat /= 0) then
134       stop "Cannot open file."
135    endif
136
137    main => createDocumentNode()
138    current => main
139
140    call xml_parse(fxml,  &
141           begin_element_handler, end_element_handler, pcdata_chunk_handler, &
142           comment_handler, cdata_section_handler=cdata_section_handler, &
143           verbose = sax_debug)   
144    call close_xmlfile(fxml)
145
146    parsefile => main
147    if (dom_debug) print *, "Number of allocated nodes: ", getNumberofAllocatedNodes()
148
149  end function parsefile
150
151
152END MODULE m_dom_parse
Note: See TracBrowser for help on using the repository browser.