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)
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 301 if (
present(
index))
then 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.
Abstract implementation of doubly-linked list.
class to manage links for lists in fortran 2003.
Base type to manage links for lists.
Definitions of constants and functions for working with missing values.
like abstract class to use character lists in fortran 2003 (gnu gcc 4.8 do not work with character(le...