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
70subroutine display(this)
74do while(this%element())
76 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)"
83integer function countelements(this)
86if (.not.
c_e(this%currentindex()))
call this%rewind()
87countelements=this%currentindex()
89do while(this%element())
90 countelements=this%currentindex()
94if (.not.
c_e(countelements)) countelements =0
96end function countelements
100subroutine append(this, value)
102character(len=*) :: value
103class(link),
pointer :: newLink
105newlink =>
link(
value)
106this%currLink => newlink
108if (.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
124subroutine prepend(this, value)
126character(len=*) :: value
127class(
link),
pointer :: newlink
129newlink =>
link(
value)
130this%currLink => newlink
132if (.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
143end subroutine prepend
146logical function insert(this, value, index)
148character(len=*) :: value
149integer,
optional :: index
150class(
link),
pointer :: newLink,nextlink
152newlink =>
link(
value)
154if (
present(
index))
then
155 insert = this%seek(
index)
156 if (.not. insert)
return
161if (.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
183this%currLink => newlink
188integer function currentindex(this)
190currentindex=this%index
191end function currentindex
194subroutine rewind(this)
196this%currLink => this%firstLink
197if (.not.
associated(this%firstLink))
then
205subroutine forward(this)
207this%currLink => this%lastLink
208if (.not.
associated(this%lastLink))
then
213end subroutine forward
219if (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
234if (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
248function currentpoli(this)
250character(len=listcharmaxlen) :: Currentpoli
251currentpoli = this%currLink%getValue()
252end function currentpoli
256logical function element(this)
259element =
associated(this%currLink)
264logical function seek(this, index)
268if (
index == this%index)
then
273if (
index < (this%index) .or. .not.
c_e(this%index))
then
277do while (this%element())
278 if (
index == this%index)
then
292logical function delete(this, index)
294integer,
optional ::
index
295class(
link),
pointer :: itemtodelete
297if (.not.
associated(this%firstLink))
then
301 if (
present(
index))
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()
323subroutine deleteitem()
325class(
link),
pointer :: prevlink,nextlink
328prevlink=>this%currlink%prevlink()
329nextlink=>this%currlink%nextlink()
331if (
associated(prevlink))
then
332 call prevlink%setNextLink(nextlink)
334 this%firstLink => nextlink
337if (
associated(nextlink))
then
338 call nextlink%setPrevLink(prevlink)
340 this%lastLink => prevlink
343deallocate(this%currlink)
346this%currLink => prevlink
348if (
associated(this%firstLink))
then
349 this%index=max(this%index-1,1)
354end 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.