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)
74 do while(this%element())
76 print *,
"index:",this%currentindex(),
" value: polimorphic value (not printable)"
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
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)
154 if (present(
index))
then
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
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
Definitions of constants and functions for working with missing values.
Method for inserting elements of the array at a desired position.
like abstract class to use character lists in fortran 2003 (gnu gcc 4.8 do not work with character(le...
Distruttori per le 2 classi.
Base type to manage links for lists.
class to manage links for lists in fortran 2003.
Quick method to append an element to the array.