libsim Versione 7.2.0
list_abstract.F03
1
17module list_abstract
18
19 use list_link
21 implicit none
22 private
23 public :: list
24
26 type, abstract :: list
27 private
28 class(link),pointer :: firstLink => null()
29 class(link),pointer :: lastLink => null()
30 class(link),pointer :: currLink => null()
31 integer :: index=imiss
32 contains
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
46! procedure :: current => currentpoli !< get index of currLink
47 procedure :: display
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
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!!$
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
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
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
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
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
198integer function currentindex(this)
199class(list),intent(in) :: this
200currentindex=this%index
201end function currentindex
202
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
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
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
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
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
268logical function element(this)
269class(list),intent(in) :: this
270
271element = associated(this%currLink)
272end function element
273
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
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.