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
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.
class to manage links for lists in fortran 2003.
abstract class to use lists in fortran 2003.
Base type to manage links for lists.
Abstract implementation of doubly-linked list.
Definitions of constants and functions for working with missing values.