3 ! Test the fix for PR83196 comment #4 (there by mistake)
5 ! Contributed by Arjen Markus <arjen.markus895@gmail.com>
6 !____________________________________________________________
8 ! Class implementing a straightforward keyword/index list
9 ! The idea is to have a very simple implementation to
10 ! store keywords (strings) and return the position in the
12 !____________________________________________________________
18 integer, parameter :: default_keylength = 40
22 integer :: lastindex = 0
23 character(len=:), dimension(:), allocatable :: keyword
25 procedure :: init => init_keyindex
26 procedure :: get_index => get_index_from_list
27 procedure :: get_key => get_keyword_from_list
28 procedure :: has_key => has_keyword_in_list
35 ! Initialise the object
38 ! this Keyindex object
39 ! initial_size Initial size of the list (optimisation)
40 ! keylength Maximum length of a keyword (optional)
42 subroutine init_keyindex( this, initial_size, keylength )
43 class(keyindex), intent(inout) :: this
44 integer, intent(in) :: initial_size
45 integer, intent(in), optional :: keylength
49 if ( present(keylength) ) then
50 keylength_ = keylength
52 keylength_ = default_keylength
56 ! Allocate the list of keywords
58 if ( allocated(this%keyword) ) then
59 deallocate( this%keyword )
63 allocate( character(len=keylength_):: this%keyword(initial_size) )
66 this%keylength = keylength_
67 end subroutine init_keyindex
69 ! get_index_from_list --
70 ! Look up the keyword in the list and return its index
73 ! this Keyindex object
74 ! keyword Keyword to be looked up
80 ! If the keyword does not yet exist, add it to the list
82 integer function get_index_from_list( this, keyword )
83 class(keyindex), intent(inout) :: this
84 character(len=*), intent(in) :: keyword
87 character(len=this%keylength), dimension(:), allocatable :: newlist
89 if ( .not. allocated(this%keyword) ) then
93 get_index_from_list = 0
95 do i = 1,this%lastindex
96 if ( this%keyword(i) == keyword ) then
97 get_index_from_list = i
103 ! Do we need to add it?
105 if ( get_index_from_list == 0 ) then
106 if ( size(this%keyword) <= this%lastindex ) then
108 ! Allocate a larger list
110 allocate( character(len=this%keylength):: newlist(2*size(this%keyword)) )
112 newlist(1:size(this%keyword)) = this%keyword
113 call move_alloc( newlist, this%keyword )
116 get_index_from_list = this%lastindex + 1
117 this%lastindex = get_index_from_list
118 this%keyword(get_index_from_list) = keyword
120 end function get_index_from_list
122 ! get_keyword_from_list --
123 ! Look up the keyword in the list by the given index
126 ! this Keyindex object
127 ! idx Index of the keyword
130 ! Keyword as stored in the list
133 ! If the index does not exist, an empty string is returned
135 function get_keyword_from_list( this, idx )
136 class(keyindex), intent(inout) :: this
137 integer, intent(in) :: idx
139 character(len=this%keylength) :: get_keyword_from_list
141 get_keyword_from_list = ' '
143 if ( idx >= 1 .and. idx <= this%lastindex ) then
144 get_keyword_from_list = this%keyword(idx)
146 end function get_keyword_from_list
148 ! has_keyword_in_list --
149 ! Look up whether the keyword is stored in the list or not
152 ! this Keyindex object
153 ! keyword Keyword to be looked up
156 ! True if the keyword is in the list or false if not
158 logical function has_keyword_in_list( this, keyword )
159 class(keyindex), intent(inout) :: this
160 character(len=*), intent(in) :: keyword
164 has_keyword_in_list = .false.
166 do i = 1,this%lastindex
167 if ( this%keyword(i) == keyword ) then
168 has_keyword_in_list = .true.
172 end function has_keyword_in_list
174 end module keyindices
177 type(keyindex) :: idx
181 if (idx%get_index ("one") .ne. 1) stop 1
182 if (idx%get_index ("two") .ne. 2) stop 2
183 if (idx%get_index ("three") .ne. 3) stop 3
185 ! Check that new span is generated as list is extended.
186 if (idx%get_index ("four") .ne. 4) stop 4
187 if (idx%get_index ("five") .ne. 5) stop 5
188 if (idx%get_index ("six") .ne. 6) stop 6
191 if (.not.idx%has_key ("four")) stop 7
192 if (idx%has_key ("seven")) stop 8
195 if (idx%get_key (4) .ne. "four") stop 9
196 if (idx%get_key (10) .ne. "") stop 10