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