libsim  Versione6.3.0
list_abstract.F03
1 
17 module list_abstract
18 
19  use list_link
20  use missing_values
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 
61 contains
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 !!$
78 
80 subroutine display(this)
81 class(list) :: this
82 
83 call this%rewind()
84 do 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()
88 end do
89 end subroutine display
90 
91 
93 integer function countelements(this)
94 class(list) :: this
95 
96 if (.not.c_e(this%currentindex())) call this%rewind()
97 countelements=this%currentindex()
98 
99 do while(this%element())
100  countelements=this%currentindex()
101  call this%next()
102 end do
103 
104 if (.not. c_e(countelements)) countelements =0
105 
106 end function countelements
107 
108 
110 subroutine append(this, value)
111 class(list) :: this
112 class(*) :: value
113 class(link), pointer :: newlink
114 
115 newlink => link(value)
116 this%currLink => newlink
117 
118 if (.not. associated(this%firstLink)) then
119  this%firstLink => newlink
120  this%lastLink => newlink
121  this%index=1
122 else
123  call newlink%setPrevLink(this%lastLink)
124  call this%lastLink%setNextLink(newlink)
125 
126  this%lastLink => newlink
127  this%index=this%index+1
128 end if
129 
130 end subroutine append
131 
132 
134 subroutine prepend(this, value)
135 class(list) :: this
136 class(*) :: value
137 class(link), pointer :: newlink
138 
139 newlink => link(value)
140 this%currLink => newlink
141 
142 if (.not. associated(this%firstLink)) then
143  this%firstLink => newlink
144  this%lastLink => newlink
145  this%index=1
146 else
147  call newlink%setnextLink(this%firstLink)
148  call this%firstLink%setNextLink(newlink)
149 
150  this%firstLink => newlink
151  this%index=this%index+1
152 end if
153 end subroutine prepend
154 
156 logical function insert(this, value, index)
157 class(list) :: this
158 class(*) :: value
159 integer,optional :: index
160 class(link), pointer :: newlink,nextlink
161 
162 newlink => 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 
171 if (.not. associated(this%currLink)) then
172  !insert the first one
173  this%firstLink => newlink
174  this%lastLink => newlink
175  this%index=1
176 else
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  call nextlink%setprevLink(newlink)
185  !verify if it's first or last
186  if (.not. this%element())then
187  this%firstLink => newlink
188  this%lastLink => newlink
189  end if
190  this%index=this%index+1
191 end if
192 
193 this%currLink => newlink
194 
195 end function insert
196 
198 integer function currentindex(this)
199 class(list) :: this
200 currentindex=this%index
201 end function currentindex
202 
204 subroutine rewind(this)
205 class(list) :: this
206 this%currLink => this%firstLink
207 if (.not. associated(this%firstLink)) then
208  this%index=imiss
209 else
210  this%index=1
211 end if
212 end subroutine rewind
213 
215 subroutine forward(this)
216 class(list) :: this
217 this%currLink => this%lastLink
218 if (.not. associated(this%lastLink)) then
219  ! index is unknow here
220  this%index=imiss
221 end if
222 
223 end subroutine forward
224 
226 subroutine next(this)
227 class(list) :: this
228 
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
233  else
234  this%index=imiss
235  end if
236 end if
238 end subroutine next
239 
241 subroutine prev(this)
242 class(list) :: this
243 
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
248  else
249  this%index=imiss
250  end if
251 
252 end if
253 
254 end subroutine prev
255 
256 
258 function currentpoli(this)
259 class(list) :: this
260 class(*), pointer :: currentpoli
261 currentpoli => this%currLink%getValue()
262 end function currentpoli
263 
264 
266 logical function element(this)
267 class(list) :: this
268 
269 element = associated(this%currLink)
270 end function element
271 
274 logical function seek(this, index)
275 class(list) :: this
276 integer :: index
277 
278 if (index == this%index) then
279  seek =.true.
280  return
281 end if
282 
283 if (index < (this%index) .or. .not. c_e(this%index)) then
284  call this%rewind()
285 end if
286 
287 do while (this%element())
288  if (index == this%index) then
289  seek =.true.
290  return
291  end if
292  call this%next()
293 end do
294 
295 seek = .false.
296 return
297 
298 end function seek
302 logical function delete(this, index)
303 class(list) :: this
304 integer,optional :: index
305 class(link),pointer :: itemtodelete
306 
307 if (.not. associated(this%firstLink)) then
308  delete=.false.
309  return
310 else
311  if (present(index)) then
312  delete=this%seek(index)
313  if(.not. delete) return
314  call deleteitem()
315  else
316  delete=.true.
317  call this%rewind()
318  do while (this%element())
319  !save pointer to delete
320  itemtodelete=>this%currlink
321  call this%next()
322  deallocate(itemtodelete)
323  end do
324  this%firstLink => null() ! first link in list
325  this%lastLink => null() ! last link in list
326  this%currLink => null() ! list iterator
327  this%index=imiss ! index to current
328  end if
329 end if
330 
331 contains
332 
333 subroutine deleteitem()
334 
335 class(link), pointer :: prevlink,nextlink
336 
337 ! detach myitem"
338 prevlink=>this%currlink%prevlink()
339 nextlink=>this%currlink%nextlink()
340 
341 if (associated(prevlink)) then
342  call prevlink%setNextLink(nextlink)
343 else
344  this%firstLink => nextlink
345 end if
346 
347 if (associated(nextlink)) then
348  call nextlink%setPrevLink(prevlink)
349 else
350  this%lastLink => prevlink
351 end if
352 
353 deallocate(this%currlink)
354 
355 ! set current to prev
356 this%currLink => prevlink
357 
358 if (associated(this%firstLink))then
359  this%index=max(this%index-1,1)
360 else
361  this%index=imiss ! index to current
362 endif
363 
364 end subroutine deleteitem
365 end function delete
366 
367 end module list_abstract
Definitions of constants and functions for working with missing values.
Method for inserting elements of the array at a desired position.
Distruttori per le 2 classi.
Index method.
abstract class to use lists in fortran 2003.
Quick method to append an element to the array.
Import griddim object from grid_id.
Definition: grid_class.F90:345

Generated with Doxygen.