libsim  Versione6.3.0
list_abstractforchar.F03
1 
8 
9  use list_linkchar
10  use missing_values
11  implicit none
12  private
13  public :: list
14 
16  type, abstract :: list
17  private
18  class(link),pointer :: firstlink => null()
19  class(link),pointer :: lastlink => null()
20  class(link),pointer :: currlink => null()
21  integer :: index=imiss
22  contains
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
36 ! procedure :: current => currentpoli !< get index of currLink
37  procedure :: display
38 ! procedure :: write_formatted
39 ! generic :: write(formatted) => write_formatted
40 ! procedure(displayValues), deferred :: display !> prints values in list
41  end type list
42 
43  abstract interface
44 
45  subroutine displayvalues(this)
46  import list
47  class(list) :: this
48  end subroutine
49  end interface
50 
51 contains
52 
53 
54 !!$SUBROUTINE write_formatted &
55 !!$(dtv, unit, iotype, v_list, iostat, iomsg)
56 !!$ INTEGER, INTENT(IN) :: unit
57 !!$ ! the derived-type value/variable
58 !!$ class(List), INTENT(IN) :: dtv
59 !!$ ! the edit descriptor string
60 !!$ CHARACTER (LEN=*), INTENT(IN) :: iotype
61 !!$ INTEGER, INTENT(IN) :: v_list(:)
62 !!$ INTEGER, INTENT(OUT) :: iostat
63 !!$ CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
64 !!$ write (unit, *, IOSTAT=iostat, IOMSG=iomsg) &
65 !!$ "class(List)"
66 !!$ END SUBROUTINE
67 !!$
68 
70 subroutine display(this)
71 class(list) :: this
72 
73 call this%rewind()
74 do while(this%element())
75 ! print *,"index:",this%currentindex()," value:", this%currentpoli()
76  print *,"index:",this%currentindex()," value: polimorphic value (not printable)"
77  call this%next()
78 end do
79 end subroutine display
80 
81 
83 integer function countelements(this)
84 class(list) :: this
85 
86 if (.not.c_e(this%currentindex())) call this%rewind()
87 countelements=this%currentindex()
88 
89 do while(this%element())
90  countelements=this%currentindex()
91  call this%next()
92 end do
93 
94 if (.not. c_e(countelements)) countelements =0
95 
96 end function countelements
97 
98 
100 subroutine append(this, value)
101 class(list) :: this
102 character(len=*) :: value
103 class(link), pointer :: newlink
104 
105 newlink => link(value)
106 this%currLink => newlink
107 
108 if (.not. associated(this%firstLink)) then
109  this%firstLink => newlink
110  this%lastLink => newlink
111  this%index=1
112 else
113  call newlink%setPrevLink(this%lastLink)
114  call this%lastLink%setNextLink(newlink)
115 
116  this%lastLink => newlink
117  this%index=this%index+1
118 end if
119 
120 end subroutine append
121 
122 
124 subroutine prepend(this, value)
125 class(list) :: this
126 character(len=*) :: value
127 class(link), pointer :: newlink
128 
129 newlink => link(value)
130 this%currLink => newlink
131 
132 if (.not. associated(this%firstLink)) then
133  this%firstLink => newlink
134  this%lastLink => newlink
135  this%index=1
136 else
137  call newlink%setnextLink(this%firstLink)
138  call this%firstLink%setNextLink(newlink)
139 
140  this%firstLink => newlink
141  this%index=this%index+1
142 end if
143 end subroutine prepend
144 
146 logical function insert(this, value, index)
147 class(list) :: this
148 character(len=*) :: value
149 integer,optional :: index
150 class(link), pointer :: newlink,nextlink
151 
152 newlink => link(value)
153 
154 if (present(index)) then
155  insert = this%seek(index)
156  if (.not. insert) return
157 else
158  insert=.true.
159 end if
160 
161 if (.not. associated(this%currLink)) then
162  !insert the first one
163  this%firstLink => newlink
164  this%lastLink => newlink
165  this%index=1
166 else
167  !set prev and next in new link
168  call newlink%setPrevLink(this%currlink)
169  call newlink%setNextLink(this%currlink%nextlink())
170 
171  !break the chain and insert
172  nextlink=>this%currlink%nextlink()
173  call this%currLink%setNextLink(newlink)
174  call nextlink%setprevLink(newlink)
175  !verify if it's first or last
176  if (.not. this%element())then
177  this%firstLink => newlink
178  this%lastLink => newlink
179  end if
180  this%index=this%index+1
181 end if
182 
183 this%currLink => newlink
184 
185 end function insert
186 
188 integer function currentindex(this)
189 class(list) :: this
190 currentindex=this%index
191 end function currentindex
192 
194 subroutine rewind(this)
195 class(list) :: this
196 this%currLink => this%firstLink
197 if (.not. associated(this%firstLink)) then
198  this%index=imiss
199 else
200  this%index=1
201 end if
202 end subroutine rewind
203 
205 subroutine forward(this)
206 class(list) :: this
207 this%currLink => this%lastLink
208 if (.not. associated(this%lastLink)) then
209  ! index is unknow here
210  this%index=imiss
211 end if
212 
213 end subroutine forward
214 
216 subroutine next(this)
217 class(list) :: this
218 
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
223  else
224  this%index=imiss
225  end if
226 end if
228 end subroutine next
229 
231 subroutine prev(this)
232 class(list) :: this
233 
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
238  else
239  this%index=imiss
240  end if
241 
242 end if
243 
244 end subroutine prev
245 
246 
248 function currentpoli(this)
249 class(list) :: this
250 character(len=listcharmaxlen) :: currentpoli
251 currentpoli = this%currLink%getValue()
252 end function currentpoli
253 
254 
256 logical function element(this)
257 class(list) :: this
258 
259 element = associated(this%currLink)
260 end function element
261 
264 logical function seek(this, index)
265 class(list) :: this
266 integer :: index
267 
268 if (index == this%index) then
269  seek =.true.
270  return
271 end if
272 
273 if (index < (this%index) .or. .not. c_e(this%index)) then
274  call this%rewind()
275 end if
276 
277 do while (this%element())
278  if (index == this%index) then
279  seek =.true.
280  return
281  end if
282  call this%next()
283 end do
284 
285 seek = .false.
286 return
287 
288 end function seek
292 logical function delete(this, index)
293 class(list) :: this
294 integer,optional :: index
295 class(link),pointer :: itemtodelete
296 
297 if (.not. associated(this%firstLink)) then
298  delete=.false.
299  return
300 else
301  if (present(index)) then
302  delete=this%seek(index)
303  if(.not. delete) return
304  call deleteitem()
305  else
306  delete=.true.
307  call this%rewind()
308  do while (this%element())
309  !save pointer to delete
310  itemtodelete=>this%currlink
311  call this%next()
312  deallocate(itemtodelete)
313  end do
314  this%firstLink => null() ! first link in list
315  this%lastLink => null() ! last link in list
316  this%currLink => null() ! list iterator
317  this%index=imiss ! index to current
318  end if
319 end if
320 
321 contains
322 
323 subroutine deleteitem()
324 
325 class(link), pointer :: prevlink,nextlink
326 
327 ! detach myitem"
328 prevlink=>this%currlink%prevlink()
329 nextlink=>this%currlink%nextlink()
330 
331 if (associated(prevlink)) then
332  call prevlink%setNextLink(nextlink)
333 else
334  this%firstLink => nextlink
335 end if
336 
337 if (associated(nextlink)) then
338  call nextlink%setPrevLink(prevlink)
339 else
340  this%lastLink => prevlink
341 end if
342 
343 deallocate(this%currlink)
344 
345 ! set current to prev
346 this%currLink => prevlink
347 
348 if (associated(this%firstLink))then
349  this%index=max(this%index-1,1)
350 else
351  this%index=imiss ! index to current
352 endif
353 
354 end subroutine deleteitem
355 end function delete
356 
357 end module list_abstractforchar
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.
Index method.
class to manage links for lists in fortran 2003.
Quick method to append an element to the array.

Generated with Doxygen.