source: XMLF90/src/sax/m_elstack.f90 @ 295

Last change on this file since 295 was 6, checked in by ymipsl, 12 years ago

Import des sources XMLF90

File size: 3.5 KB
Line 
1module m_elstack
2
3use m_buffer
4
5private
6
7!
8! Simple stack to keep track of which elements have appeared so far
9!
10integer, parameter, private            :: STACK_SIZE = 40
11
12type, public :: elstack_t
13private
14      integer                                :: n_items
15      type(buffer_t), dimension(STACK_SIZE)  :: data
16end type elstack_t
17
18public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
19public  :: init_elstack
20public  :: get_top_elstack, is_empty, get_elstack_signature
21
22interface is_empty
23      module procedure is_empty_elstack
24end interface
25private :: is_empty_elstack
26
27CONTAINS
28
29!-----------------------------------------------------------------
30subroutine init_elstack(elstack)
31type(elstack_t), intent(inout)  :: elstack
32
33integer :: i
34
35elstack%n_items = 0
36do i = 1, STACK_SIZE                   ! to avoid "undefined status"
37      call init_buffer(elstack%data(i))
38enddo
39end subroutine init_elstack
40
41!-----------------------------------------------------------------
42subroutine reset_elstack(elstack)
43type(elstack_t), intent(inout)  :: elstack
44
45integer :: i
46
47elstack%n_items = 0
48do i = 1, STACK_SIZE                 
49      call reset_buffer(elstack%data(i))
50enddo
51end subroutine reset_elstack
52
53!-----------------------------------------------------------------
54function is_empty_elstack(elstack) result(answer)
55type(elstack_t), intent(in)  :: elstack
56logical                    :: answer
57
58answer = (elstack%n_items == 0)
59end function is_empty_elstack
60
61!-----------------------------------------------------------------
62subroutine push_elstack(item,elstack)
63type(buffer_t), intent(in)      :: item
64type(elstack_t), intent(inout)  :: elstack
65
66integer   :: n
67
68n = elstack%n_items
69if (n == STACK_SIZE) then
70      stop "*Element stack full"
71endif
72n = n + 1
73elstack%data(n) = item
74elstack%n_items = n
75
76end subroutine push_elstack
77
78!-----------------------------------------------------------------
79subroutine pop_elstack(elstack,item)
80type(elstack_t), intent(inout)     :: elstack
81type(buffer_t), intent(out)        :: item
82
83!
84! We assume the elstack is not empty... (the user has called is_empty first)
85!
86integer   :: n
87
88n = elstack%n_items
89if (n == 0) then
90      stop "*********Element stack empty"
91endif
92item = elstack%data(n)
93elstack%n_items = n - 1
94
95end subroutine pop_elstack
96
97!-----------------------------------------------------------------
98subroutine get_top_elstack(elstack,item)
99!
100! Get the top element of the stack, *without popping it*.
101!
102type(elstack_t), intent(in)        :: elstack
103type(buffer_t), intent(out)        :: item
104
105!
106! We assume the elstack is not empty... (the user has called is_empty first)
107!
108integer   :: n
109
110n = elstack%n_items
111if (n == 0) then
112      stop "*********Element stack empty"
113endif
114item = elstack%data(n)
115
116end subroutine get_top_elstack
117
118!-----------------------------------------------------------------
119subroutine print_elstack(elstack,unit)
120type(elstack_t), intent(in)   :: elstack
121integer, intent(in)           :: unit
122integer   :: i
123
124do i = elstack%n_items, 1, -1
125      write(unit=unit,fmt=*) str(elstack%data(i))
126enddo
127
128end subroutine print_elstack
129
130!-------------------------------------------------------------
131subroutine get_elstack_signature(elstack,string)
132type(elstack_t), intent(in)   :: elstack
133character(len=*), intent(out) :: string
134integer   :: i, length, j
135
136string = ""
137j = 0
138do i = 1, elstack%n_items
139   length = len(elstack%data(i))
140   string(j+1:j+1) = "/"
141   j = j+1
142   string(j+1:j+length) = str(elstack%data(i))
143   j = j + length
144enddo
145
146end subroutine get_elstack_signature
147
148end module m_elstack
149
150
151
152
153
Note: See TracBrowser for help on using the repository browser.