1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
! { dg-do compile }
!
! Test the fix for PR83196 comment #4 (there by mistake)
!
! Contributed by Arjen Markus <arjen.markus895@gmail.com>
!____________________________________________________________
! keyindex.f90 --
! Class implementing a straightforward keyword/index list
! The idea is to have a very simple implementation to
! store keywords (strings) and return the position in the
! list or vice versa.
!____________________________________________________________
module keyindices
implicit none
private
integer, parameter :: default_keylength = 40
type keyindex
integer :: keylength
integer :: lastindex = 0
character(len=:), dimension(:), allocatable :: keyword
contains
procedure :: init => init_keyindex
procedure :: get_index => get_index_from_list
procedure :: get_key => get_keyword_from_list
procedure :: has_key => has_keyword_in_list
end type keyindex
public :: keyindex
contains
! init_keyindex --
! Initialise the object
!
! Arguments:
! this Keyindex object
! initial_size Initial size of the list (optimisation)
! keylength Maximum length of a keyword (optional)
!
subroutine init_keyindex( this, initial_size, keylength )
class(keyindex), intent(inout) :: this
integer, intent(in) :: initial_size
integer, intent(in), optional :: keylength
integer :: keylength_
if ( present(keylength) ) then
keylength_ = keylength
else
keylength_ = default_keylength
endif
!
! Allocate the list of keywords
!
if ( allocated(this%keyword) ) then
deallocate( this%keyword )
endif
allocate( character(len=keylength_):: this%keyword(initial_size) )
this%lastindex = 0
this%keylength = keylength_
end subroutine init_keyindex
! get_index_from_list --
! Look up the keyword in the list and return its index
!
! Arguments:
! this Keyindex object
! keyword Keyword to be looked up
!
! Returns:
! Index in the list
!
! Note:
! If the keyword does not yet exist, add it to the list
!
integer function get_index_from_list( this, keyword )
class(keyindex), intent(inout) :: this
character(len=*), intent(in) :: keyword
integer :: i
character(len=this%keylength), dimension(:), allocatable :: newlist
if ( .not. allocated(this%keyword) ) then
call this%init( 50 )
endif
get_index_from_list = 0
do i = 1,this%lastindex
if ( this%keyword(i) == keyword ) then
get_index_from_list = i
exit
endif
enddo
!
! Do we need to add it?
!
if ( get_index_from_list == 0 ) then
if ( size(this%keyword) <= this%lastindex ) then
!
! Allocate a larger list
!
allocate( character(len=this%keylength):: newlist(2*size(this%keyword)) )
newlist(1:size(this%keyword)) = this%keyword
call move_alloc( newlist, this%keyword )
endif
get_index_from_list = this%lastindex + 1
this%lastindex = get_index_from_list
this%keyword(get_index_from_list) = keyword
endif
end function get_index_from_list
! get_keyword_from_list --
! Look up the keyword in the list by the given index
!
! Arguments:
! this Keyindex object
! idx Index of the keyword
!
! Returns:
! Keyword as stored in the list
!
! Note:
! If the index does not exist, an empty string is returned
!
function get_keyword_from_list( this, idx )
class(keyindex), intent(inout) :: this
integer, intent(in) :: idx
character(len=this%keylength) :: get_keyword_from_list
get_keyword_from_list = ' '
if ( idx >= 1 .and. idx <= this%lastindex ) then
get_keyword_from_list = this%keyword(idx)
endif
end function get_keyword_from_list
! has_keyword_in_list --
! Look up whether the keyword is stored in the list or not
!
! Arguments:
! this Keyindex object
! keyword Keyword to be looked up
!
! Returns:
! True if the keyword is in the list or false if not
!
logical function has_keyword_in_list( this, keyword )
class(keyindex), intent(inout) :: this
character(len=*), intent(in) :: keyword
integer :: i
has_keyword_in_list = .false.
do i = 1,this%lastindex
if ( this%keyword(i) == keyword ) then
has_keyword_in_list = .true.
exit
endif
enddo
end function has_keyword_in_list
end module keyindices
use keyindices
type(keyindex) :: idx
call idx%init (3, 8)
if (idx%get_index ("one") .ne. 1) stop 1
if (idx%get_index ("two") .ne. 2) stop 2
if (idx%get_index ("three") .ne. 3) stop 3
! Check that new span is generated as list is extended.
if (idx%get_index ("four") .ne. 4) stop 4
if (idx%get_index ("five") .ne. 5) stop 5
if (idx%get_index ("six") .ne. 6) stop 6
! Search by keyword
if (.not.idx%has_key ("four")) stop 7
if (idx%has_key ("seven")) stop 8
! Search by index
if (idx%get_key (4) .ne. "four") stop 9
if (idx%get_key (10) .ne. "") stop 10
end
|
