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)
84 do while(this%element())
86 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)" 89 end subroutine display
93 integer function countelements(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)
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)
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%setNextLink(newlink)
150 this%firstLink => newlink
151 this%index=this%index+1
153 end subroutine prepend
156 logical function insert(this, value, index)
159 integer,
optional ::
index 160 class(
link),
pointer :: newlink,nextlink
162 newlink =>
link(
value)
165 insert = this%seek(
index)
166 if (.not. insert)
return 171 if (.not.
associated(this%currLink))
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)
184 call nextlink%setprevLink(newlink)
186 if (.not. this%element())
then 187 this%firstLink => newlink
188 this%lastLink => newlink
190 this%index=this%index+1
193 this%currLink => newlink
198 integer function currentindex(this)
200 currentindex=this%index
201 end function currentindex
204 subroutine rewind(this)
206 this%currLink => this%firstLink
207 if (.not.
associated(this%firstLink))
then 212 end subroutine rewind
215 subroutine forward(this)
217 this%currLink => this%lastLink
218 if (.not.
associated(this%lastLink))
then 223 end subroutine forward
226 subroutine next(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)
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)
260 class(*),
pointer :: Currentpoli
261 currentpoli => this%currLink%getValue()
262 end function currentpoli
266 logical function element(this)
269 element =
associated(this%currLink)
274 logical function seek(this, index)
278 if (
index == this%index)
then 283 if (
index < (this%index) .or. .not.
c_e(this%index))
then 287 do while (this%element())
288 if (
index == this%index)
then 302 logical function delete(this, index)
304 integer,
optional :: index
305 class(link),
pointer :: itemtodelete
307 if (.not.
associated(this%firstLink))
then 311 if (
present(
index))
then 313 if(.not. delete)
return 318 do while (this%element())
320 itemtodelete=>this%currlink
322 deallocate(itemtodelete)
324 this%firstLink => null()
325 this%lastLink => null()
326 this%currLink => null()
333 subroutine deleteitem()
335 class(
link),
pointer :: prevlink,nextlink
338 prevlink=>this%currlink%prevlink()
339 nextlink=>this%currlink%nextlink()
341 if (
associated(prevlink))
then 342 call prevlink%setNextLink(nextlink)
344 this%firstLink => nextlink
347 if (
associated(nextlink))
then 348 call nextlink%setPrevLink(prevlink)
350 this%lastLink => prevlink
353 deallocate(this%currlink)
356 this%currLink => prevlink
358 if (
associated(this%firstLink))
then 359 this%index=max(this%index-1,1)
364 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.