libsim Versione 7.2.6
list_abstract.F03
1!> \brief abstract class to use lists in fortran 2003.
2!!
3!! Linked data structure is a data structure which
4!! consists of a set of data records (nodes) linked together and organized by references .
5!!
6!! A doubly-linked list is a linked data structure that consists of a set
7!! of sequentially linked records called nodes. Each node contains two
8!! fields, called links, that are references to the previous and to the
9!! next node in the sequence of nodes. The beginning and ending nodes'
10!! previous and next links, respectively, point to some kind of
11!! terminator.
12!!
13!! The program example is the better starting point:
14!!\include example_list.F03
15!!\ingroup base
16!!
17module list_abstract
18
19 use list_link
21 implicit none
22 private
23 public :: list
24
25!> Abstract implementation of doubly-linked list
26 type, abstract :: list
27 private
28 class(link),pointer :: firstLink => null() !< first link in list
29 class(link),pointer :: lastLink => null() !< last link in list
30 class(link),pointer :: currLink => null() !< list iterator
31 integer :: index=imiss !< index to current
32 contains
33 procedure, non_overridable :: append !< add class(*) to end of list
34 procedure, non_overridable :: prepend !< add class(*) to beginning of list
35 procedure, non_overridable :: insert !< add class(*) to position in list
36 procedure, non_overridable :: rewind !< reset list iterator to start
37 procedure, non_overridable :: forward !< reset list iterator to end
38 procedure, non_overridable :: seek !< set list iterator to index
39 procedure, non_overridable :: next !< increment list iterator
40 procedure, non_overridable :: prev !< increment list iterator
41 procedure, non_overridable :: currentpoli !< get value from currLink
42 procedure, non_overridable :: currentindex !< get index of currLink
43 procedure, non_overridable :: element !< associated current element
44 procedure, non_overridable :: delete !< delete values from list
45 procedure, non_overridable :: countelements!< count values in list
46! procedure :: current => currentpoli !< get index of currLink
47 procedure :: display !< print values in list
48! procedure :: write_formatted
49! generic :: write(formatted) => write_formatted
50! procedure(displayValues), deferred :: display !> prints values in list
51 end type list
52
53 abstract interface
54!> Print the list
55 subroutine displayvalues(this)
56 import list
57 class(list) :: this
58 end subroutine
59 end interface
60
61contains
62
63
64!!$SUBROUTINE write_formatted &
65!!$(dtv, unit, iotype, v_list, iostat, iomsg)
66!!$ INTEGER, INTENT(IN) :: unit
67!!$ ! the derived-type value/variable
68!!$ class(List), INTENT(IN) :: dtv
69!!$ ! the edit descriptor string
70!!$ CHARACTER (LEN=*), INTENT(IN) :: iotype
71!!$ INTEGER, INTENT(IN) :: v_list(:)
72!!$ INTEGER, INTENT(OUT) :: iostat
73!!$ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
74!!$ write (unit, *, IOSTAT=iostat, IOMSG=iomsg) &
75!!$ "class(List)"
76!!$ END SUBROUTINE
77!!$
79!> Print the list
80subroutine display(this)
81class(list),intent(inout) :: this
83call this%rewind()
84do while(this%element())
85! print *,"index:",this%currentindex()," value:", this%currentpoli()
86 print *,"index:",this%currentindex()," value: polimorphic value (not printable)"
87 call this%next()
88end do
89end subroutine display
90
91
92!> count values in list
93integer function countelements(this)
94class(list),intent(inout) :: this
95
96if (.not.c_e(this%currentindex())) call this%rewind()
97countelements=this%currentindex()
98
99do while(this%element())
100 countelements=this%currentindex()
101 call this%next()
102end do
103
104if (.not. c_e(countelements)) countelements =0
105
106end function countelements
107
108
109!> add class(*) to end of list
110subroutine append(this, value)
111class(list),intent(inout) :: this
112class(*),intent(in) :: value
113class(link), pointer :: newLink
114
115newlink => link(value)
116this%currLink => newlink
117
118if (.not. associated(this%firstLink)) then
119 this%firstLink => newlink
120 this%lastLink => newlink
121 this%index=1
122else
123 call newlink%setPrevLink(this%lastLink)
124 call this%lastLink%setNextLink(newlink)
125
126 this%lastLink => newlink
127 this%index=this%index+1
128end if
129
130end subroutine append
131
132
133!> add class(*) to beginning of list
134subroutine prepend(this, value)
135class(list),intent(inout) :: this
136class(*) :: value
137class(link), pointer :: newlink
138
139newlink => link(value)
140this%currLink => newlink
141
142if (.not. associated(this%firstLink)) then
143 this%firstLink => newlink
144 this%lastLink => newlink
145 this%index=1
146else
147 call newlink%setnextLink(this%firstLink)
148 call this%firstLink%setPrevLink(newlink)
149
150 this%firstLink => newlink
151 this%index=1
152end if
153end subroutine prepend
154
155!> add class(*) to position in list
156logical function insert(this, value, index)
157class(list),intent(inout) :: this
158class(*) :: value
159integer :: index ! removed optional because of inconsistent behavior
160class(link), pointer :: newLink,nextlink
161
162newlink => link(value)
163
164!if (present(index)) then
165 insert = this%seek(index)
166 if (.not. insert) return
167!else
168! insert=.true.
169!end if
170
171if (.not. this%element()) then
172 !insert the first one
173 this%firstLink => newlink
174 this%lastLink => newlink
175 this%index=1
176else
177 !set prev and next in new link
178 call newlink%setPrevLink(this%currlink)
179 call newlink%setNextLink(this%currlink%nextlink())
180
181 !break the chain and insert
182 nextlink=>this%currlink%nextlink()
183 call this%currLink%setNextLink(newlink)
184 !verify if it's last
185 if (associated(nextlink))then
186 call nextlink%setprevLink(newlink)
187 else
188 this%lastLink => newlink
189 end if
190 this%index=this%index+1
191end if
192
193this%currLink => newlink
194
195end function insert
196
197!> get index of currLink
198integer function currentindex(this)
199class(list),intent(in) :: this
200currentindex=this%index
201end function currentindex
202
203!> reset list iterator to start
204subroutine rewind(this)
205class(list),intent(inout) :: this
206this%currLink => this%firstLink
207if (.not. associated(this%firstLink)) then
208 this%index=imiss
209else
210 this%index=1
211end if
212end subroutine rewind
213
214!> reset list iterator to end
215subroutine forward(this)
216class(list),intent(inout) :: this
217this%currLink => this%lastLink
218if (.not. associated(this%lastLink)) then
219 ! index is unknow here
220 this%index=imiss
221end if
222
223end subroutine forward
224
225!> increment list iterator
226subroutine next(this)
227class(list),intent(inout) :: this
228
229if (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
233 else
234 this%index=imiss
235 end if
236end if
237
238end subroutine next
240!> increment list iterator
241subroutine prev(this)
242class(list),intent(inout) :: this
243
244if (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
248 else
249 this%index=imiss
250 end if
251
252end if
253
254end subroutine prev
255
257!> get value from currLink
258function currentpoli(this)
259class(list),intent(in) :: this
260class(*), pointer :: Currentpoli
261class(*), pointer :: l_p
262l_p => this%currLink%getValue()
263currentpoli => l_p
264end function currentpoli
265
266
267!>return .true. if current element is associated
268logical function element(this)
269class(list),intent(in) :: this
270
271element = associated(this%currLink)
272end function element
273
274!> set list iterator to index
275!! return .false. if failed
276logical function seek(this, index)
277class(list),intent(inout) :: this
278integer :: index
279
280if (index == this%index) then
281 seek =.true.
282 return
283end if
284
285if (index < (this%index) .or. .not. c_e(this%index)) then
286 call this%rewind()
287end if
288
289do while (this%element())
290 if (index == this%index) then
291 seek =.true.
292 return
293 end if
294 call this%next()
295end do
296
297seek = .false.
298return
300end function seek
301
302!> delete values from list
303!! return .true. if succes
304logical function delete(this, index)
305class(list),intent(inout) :: this
306integer,optional :: index
307class(link),pointer :: itemtodelete
308
309if (.not. associated(this%firstLink)) then
310 delete=.false.
311 return
312else
313 if (present(index)) then
314 delete=this%seek(index)
315 if(.not. delete) return
316 call deleteitem()
317 else
318 delete=.true.
319 call this%rewind()
320 do while (this%element())
321 !save pointer to delete
322 itemtodelete=>this%currlink
323 call this%next()
324 deallocate(itemtodelete)
325 end do
326 this%firstLink => null() ! first link in list
327 this%lastLink => null() ! last link in list
328 this%currLink => null() ! list iterator
329 this%index=imiss ! index to current
330 end if
331end if
332
333contains
334
335subroutine deleteitem()
336
337class(link), pointer :: prevlink,nextlink
338
339! detach myitem"
340prevlink=>this%currlink%prevlink()
341nextlink=>this%currlink%nextlink()
342
343if (associated(prevlink)) then
344 call prevlink%setNextLink(nextlink)
345else
346 this%firstLink => nextlink
347end if
348
349if (associated(nextlink)) then
350 call nextlink%setPrevLink(prevlink)
351else
352 this%lastLink => prevlink
353end if
354
355deallocate(this%currlink)
356
357! set current to prev
358this%currLink => prevlink
359
360if (associated(this%firstLink))then
361 this%index=max(this%index-1,1)
362else
363 this%index=imiss ! index to current
364endif
365
366end subroutine deleteitem
367end function delete
368
369end module list_abstract
Index method.
Function to check whether a value is missing or not.
abstract class to use lists in fortran 2003.
Definitions of constants and functions for working with missing values.
Abstract implementation of doubly-linked list.

Generated with Doxygen.