16 type,
abstract ::
list
18 class(link),
pointer :: firstLink => null()
19 class(link),
pointer :: lastLink => null()
20 class(link),
pointer :: currLink => null()
21 integer :: index=imiss
23 procedure, non_overridable :: append
24 procedure, non_overridable :: prepend
25 procedure, non_overridable :: insert
26 procedure, non_overridable :: rewind
27 procedure, non_overridable :: forward
28 procedure, non_overridable :: seek
29 procedure, non_overridable :: next
30 procedure, non_overridable :: prev
31 procedure, non_overridable :: currentpoli
32 procedure, non_overridable :: currentindex
33 procedure, non_overridable :: element
34 procedure, non_overridable :: delete
35 procedure, non_overridable :: countelements
45 subroutine displayvalues(this)
70 subroutine display(this)
74 do while(this%element())
76 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)"
79 end subroutine display
83 integer function countelements(this)
86 if (.not.
c_e(this%currentindex()))
call this%rewind()
87 countelements=this%currentindex()
89 do while(this%element())
90 countelements=this%currentindex()
94 if (.not.
c_e(countelements)) countelements =0
96 end function countelements
100 subroutine append(this, value)
102 character(len=*) :: value
103 class(link),
pointer :: newLink
105 newlink =>
link(
value)
106 this%currLink => newlink
108 if (.not.
associated(this%firstLink))
then
109 this%firstLink => newlink
110 this%lastLink => newlink
113 call newlink%setPrevLink(this%lastLink)
114 call this%lastLink%setNextLink(newlink)
116 this%lastLink => newlink
117 this%index=this%index+1
120 end subroutine append
124 subroutine prepend(this, value)
126 character(len=*) :: value
127 class(link),
pointer :: newLink
129 newlink =>
link(
value)
130 this%currLink => newlink
132 if (.not.
associated(this%firstLink))
then
133 this%firstLink => newlink
134 this%lastLink => newlink
137 call newlink%setnextLink(this%firstLink)
138 call this%firstLink%setNextLink(newlink)
140 this%firstLink => newlink
141 this%index=this%index+1
143 end subroutine prepend
146 logical function insert(this, value, index)
148 character(len=*) :: value
149 integer,
optional ::
index
150 class(
link),
pointer :: newlink,nextlink
152 newlink =>
link(
value)
154 if (
present(
index))
then
155 insert = this%seek(
index)
156 if (.not. insert)
return
161 if (.not.
associated(this%currLink))
then
163 this%firstLink => newlink
164 this%lastLink => newlink
168 call newlink%setPrevLink(this%currlink)
169 call newlink%setNextLink(this%currlink%nextlink())
172 nextlink=>this%currlink%nextlink()
173 call this%currLink%setNextLink(newlink)
174 call nextlink%setprevLink(newlink)
176 if (.not. this%element())
then
177 this%firstLink => newlink
178 this%lastLink => newlink
180 this%index=this%index+1
183 this%currLink => newlink
188 integer function currentindex(this)
190 currentindex=this%index
191 end function currentindex
194 subroutine rewind(this)
196 this%currLink => this%firstLink
197 if (.not.
associated(this%firstLink))
then
202 end subroutine rewind
205 subroutine forward(this)
207 this%currLink => this%lastLink
208 if (.not.
associated(this%lastLink))
then
213 end subroutine forward
216 subroutine next(this)
219 if (this%element())
then
220 this%currLink => this%currLink%nextLink()
221 if (this%element())
then
222 if(
c_e(this%index))this%index=this%index+1
231 subroutine prev(this)
234 if (this%element())
then
235 this%currLink => this%currLink%prevLink()
236 if (this%element())
then
237 if(
c_e(this%index))this%index=this%index-1
248 function currentpoli(this)
250 character(len=listcharmaxlen) :: currentpoli
251 currentpoli = this%currLink%getValue()
252 end function currentpoli
256 logical function element(this)
259 element =
associated(this%currLink)
264 logical function seek(this, index)
268 if (
index == this%index)
then
273 if (
index < (this%index) .or. .not.
c_e(this%index))
then
277 do while (this%element())
278 if (
index == this%index)
then
292 logical function delete(this, index)
294 integer,
optional :: index
295 class(
link),
pointer :: itemtodelete
297 if (.not.
associated(this%firstLink))
then
302 delete=this%seek(
index)
303 if(.not. delete)
return
308 do while (this%element())
310 itemtodelete=>this%currlink
312 deallocate(itemtodelete)
314 this%firstLink => null()
315 this%lastLink => null()
316 this%currLink => null()
323 subroutine deleteitem()
325 class(
link),
pointer :: prevlink,nextlink
328 prevlink=>this%currlink%prevlink()
329 nextlink=>this%currlink%nextlink()
331 if (
associated(prevlink))
then
332 call prevlink%setNextLink(nextlink)
334 this%firstLink => nextlink
337 if (
associated(nextlink))
then
338 call nextlink%setPrevLink(prevlink)
340 this%lastLink => prevlink
343 deallocate(this%currlink)
346 this%currLink => prevlink
348 if (
associated(this%firstLink))
then
349 this%index=max(this%index-1,1)
354 end subroutine deleteitem
Function to check whether a value is missing or not.
like abstract class to use character lists in fortran 2003 (gnu gcc 4.8 do not work with character(le...
class to manage links for lists in fortran 2003.
Definitions of constants and functions for working with missing values.
Abstract implementation of doubly-linked list.
Base type to manage links for lists.