26 type,
abstract ::
list
28 class(link),
pointer :: firstLink => null()
29 class(link),
pointer :: lastLink => null()
30 class(link),
pointer :: currLink => null()
31 integer :: index=imiss
33 procedure, non_overridable :: append
34 procedure, non_overridable :: prepend
35 procedure, non_overridable :: insert
36 procedure, non_overridable :: rewind
37 procedure, non_overridable :: forward
38 procedure, non_overridable :: seek
39 procedure, non_overridable :: next
40 procedure, non_overridable :: prev
41 procedure, non_overridable :: currentpoli
42 procedure, non_overridable :: currentindex
43 procedure, non_overridable :: element
44 procedure, non_overridable :: delete
45 procedure, non_overridable :: countelements
55 subroutine displayvalues(this)
80 subroutine display(this)
81 class(
list),
intent(inout) :: this
84 do while(this%element())
86 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)"
89 end subroutine display
93 integer function countelements(this)
94 class(
list),
intent(inout) :: this
96 if (.not.
c_e(this%currentindex()))
call this%rewind()
97 countelements=this%currentindex()
99 do while(this%element())
100 countelements=this%currentindex()
104 if (.not.
c_e(countelements)) countelements =0
106 end function countelements
110 subroutine append(this, value)
111 class(list),
intent(inout) :: this
112 class(*),
intent(in) :: value
113 class(link),
pointer :: newLink
115 newlink =>
link(
value)
116 this%currLink => newlink
118 if (.not.
associated(this%firstLink))
then
119 this%firstLink => newlink
120 this%lastLink => newlink
123 call newlink%setPrevLink(this%lastLink)
124 call this%lastLink%setNextLink(newlink)
126 this%lastLink => newlink
127 this%index=this%index+1
130 end subroutine append
134 subroutine prepend(this, value)
135 class(list),
intent(inout) :: this
137 class(link),
pointer :: newLink
139 newlink =>
link(
value)
140 this%currLink => newlink
142 if (.not.
associated(this%firstLink))
then
143 this%firstLink => newlink
144 this%lastLink => newlink
147 call newlink%setnextLink(this%firstLink)
148 call this%firstLink%setPrevLink(newlink)
150 this%firstLink => newlink
153 end subroutine prepend
156 logical function insert(this, value, index)
157 class(
list),
intent(inout) :: this
160 class(
link),
pointer :: newlink,nextlink
162 newlink =>
link(
value)
165 insert = this%seek(
index)
166 if (.not. insert)
return
171 if (.not. this%element())
then
173 this%firstLink => newlink
174 this%lastLink => newlink
178 call newlink%setPrevLink(this%currlink)
179 call newlink%setNextLink(this%currlink%nextlink())
182 nextlink=>this%currlink%nextlink()
183 call this%currLink%setNextLink(newlink)
185 if (
associated(nextlink))
then
186 call nextlink%setprevLink(newlink)
188 this%lastLink => newlink
190 this%index=this%index+1
193 this%currLink => newlink
198 integer function currentindex(this)
199 class(
list),
intent(in) :: this
200 currentindex=this%index
201 end function currentindex
204 subroutine rewind(this)
205 class(
list),
intent(inout) :: this
206 this%currLink => this%firstLink
207 if (.not.
associated(this%firstLink))
then
212 end subroutine rewind
215 subroutine forward(this)
216 class(
list),
intent(inout) :: this
217 this%currLink => this%lastLink
218 if (.not.
associated(this%lastLink))
then
223 end subroutine forward
226 subroutine next(this)
227 class(
list),
intent(inout) :: this
229 if (this%element())
then
230 this%currLink => this%currLink%nextLink()
231 if (this%element())
then
232 if(
c_e(this%index))this%index=this%index+1
241 subroutine prev(this)
242 class(
list),
intent(inout) :: this
244 if (this%element())
then
245 this%currLink => this%currLink%prevLink()
246 if (this%element())
then
247 if(
c_e(this%index))this%index=this%index-1
258 function currentpoli(this)
259 class(
list),
intent(in) :: this
260 class(*),
pointer :: currentpoli
261 class(*),
pointer :: l_p
262 l_p => this%currLink%getValue()
264 end function currentpoli
268 logical function element(this)
269 class(
list),
intent(in) :: this
271 element =
associated(this%currLink)
276 logical function seek(this, index)
277 class(
list),
intent(inout) :: this
280 if (
index == this%index)
then
285 if (
index < (this%index) .or. .not.
c_e(this%index))
then
289 do while (this%element())
290 if (
index == this%index)
then
304 logical function delete(this, index)
305 class(
list),
intent(inout) :: this
306 integer,
optional :: index
307 class(
link),
pointer :: itemtodelete
309 if (.not.
associated(this%firstLink))
then
313 if (
present(
index))
then
314 delete=this%seek(
index)
315 if(.not. delete)
return
320 do while (this%element())
322 itemtodelete=>this%currlink
324 deallocate(itemtodelete)
326 this%firstLink => null()
327 this%lastLink => null()
328 this%currLink => null()
335 subroutine deleteitem()
337 class(
link),
pointer :: prevlink,nextlink
340 prevlink=>this%currlink%prevlink()
341 nextlink=>this%currlink%nextlink()
343 if (
associated(prevlink))
then
344 call prevlink%setNextLink(nextlink)
346 this%firstLink => nextlink
349 if (
associated(nextlink))
then
350 call nextlink%setPrevLink(prevlink)
352 this%lastLink => prevlink
355 deallocate(this%currlink)
358 this%currLink => prevlink
360 if (
associated(this%firstLink))
then
361 this%index=max(this%index-1,1)
366 end subroutine deleteitem
Function to check whether a value is missing or not.
abstract class to use lists in fortran 2003.
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.