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
80subroutine display(this)
81class(
list),
intent(inout) :: this
84do while(this%element())
86 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)"
93integer function countelements(this)
94class(
list),
intent(inout) :: this
96if (.not.
c_e(this%currentindex()))
call this%rewind()
97countelements=this%currentindex()
99do while(this%element())
100 countelements=this%currentindex()
104if (.not.
c_e(countelements)) countelements =0
106end function countelements
110subroutine append(this, value)
111class(list),
intent(inout) :: this
112class(*),
intent(in) :: value
113class(link),
pointer :: newLink
115newlink =>
link(
value)
116this%currLink => newlink
118if (.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
134subroutine prepend(this, value)
135class(
list),
intent(inout) :: this
137class(
link),
pointer :: newlink
139newlink =>
link(
value)
140this%currLink => newlink
142if (.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
153end subroutine prepend
156logical function insert(this, value, index)
157class(
list),
intent(inout) :: this
160class(
link),
pointer :: newLink,nextlink
162newlink =>
link(
value)
165 insert = this%seek(
index)
166 if (.not. insert)
return
171if (.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
193this%currLink => newlink
198integer function currentindex(this)
199class(
list),
intent(in) :: this
200currentindex=this%index
201end function currentindex
204subroutine rewind(this)
205class(
list),
intent(inout) :: this
206this%currLink => this%firstLink
207if (.not.
associated(this%firstLink))
then
215subroutine forward(this)
216class(
list),
intent(inout) :: this
217this%currLink => this%lastLink
218if (.not.
associated(this%lastLink))
then
223end subroutine forward
227class(
list),
intent(inout) :: this
229if (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
242class(
list),
intent(inout) :: this
244if (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
258function currentpoli(this)
259class(
list),
intent(in) :: this
260class(*),
pointer :: Currentpoli
261class(*),
pointer :: l_p
262l_p => this%currLink%getValue()
264end function currentpoli
268logical function element(this)
269class(
list),
intent(in) :: this
271element =
associated(this%currLink)
276logical function seek(this, index)
277class(
list),
intent(inout) :: this
280if (
index == this%index)
then
285if (
index < (this%index) .or. .not.
c_e(this%index))
then
289do while (this%element())
290 if (
index == this%index)
then
304logical function delete(this, index)
305class(
list),
intent(inout) :: this
306integer,
optional ::
index
307class(
link),
pointer :: itemtodelete
309if (.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()
335subroutine deleteitem()
337class(
link),
pointer :: prevlink,nextlink
340prevlink=>this%currlink%prevlink()
341nextlink=>this%currlink%nextlink()
343if (
associated(prevlink))
then
344 call prevlink%setNextLink(nextlink)
346 this%firstLink => nextlink
349if (
associated(nextlink))
then
350 call nextlink%setPrevLink(prevlink)
352 this%lastLink => prevlink
355deallocate(this%currlink)
358this%currLink => prevlink
360if (
associated(this%firstLink))
then
361 this%index=max(this%index-1,1)
366end 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.