libsim Versione 7.2.6
list_abstractforchar.F03
1!> \brief like abstract class to use character lists in fortran 2003 (gnu gcc 4.8 do not work with character(len=:).
2!!
3!! The program example is the better starting point:
4!!\include example_list.F03
5!!\ingroup base
6!!
8
11 implicit none
12 private
13 public :: list
14
15!> Abstract implementation of doubly-linked list
16 type, abstract :: list
17 private
18 class(link),pointer :: firstLink => null() !< first link in list
19 class(link),pointer :: lastLink => null() !< last link in list
20 class(link),pointer :: currLink => null() !< list iterator
21 integer :: index=imiss !< index to current
22 contains
23 procedure, non_overridable :: append !< add class(*) to end of list
24 procedure, non_overridable :: prepend !< add class(*) to beginning of list
25 procedure, non_overridable :: insert !< add class(*) to position in list
26 procedure, non_overridable :: rewind !< reset list iterator to start
27 procedure, non_overridable :: forward !< reset list iterator to end
28 procedure, non_overridable :: seek !< set list iterator to index
29 procedure, non_overridable :: next !< increment list iterator
30 procedure, non_overridable :: prev !< increment list iterator
31 procedure, non_overridable :: currentpoli !< get value from currLink
32 procedure, non_overridable :: currentindex !< get index of currLink
33 procedure, non_overridable :: element !< associated current element
34 procedure, non_overridable :: delete !< delete values from list
35 procedure, non_overridable :: countelements!< count values in list
36! procedure :: current => currentpoli !< get index of currLink
37 procedure :: display !< print values in list
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!> Print the list
45 subroutine displayvalues(this)
46 import list
47 class(list) :: this
48 end subroutine
49 end interface
50
51contains
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!!$
69!> Print the list
70subroutine display(this)
71class(list) :: this
73call this%rewind()
74do 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()
78end do
79end subroutine display
80
81
82!> count values in list
83integer function countelements(this)
84class(list) :: this
85
86if (.not.c_e(this%currentindex())) call this%rewind()
87countelements=this%currentindex()
88
89do while(this%element())
90 countelements=this%currentindex()
91 call this%next()
92end do
93
94if (.not. c_e(countelements)) countelements =0
95
96end function countelements
97
98
99!> add class(*) to end of list
100subroutine append(this, value)
101class(list) :: this
102character(len=*) :: value
103class(link), pointer :: newLink
104
105newlink => link(value)
106this%currLink => newlink
107
108if (.not. associated(this%firstLink)) then
109 this%firstLink => newlink
110 this%lastLink => newlink
111 this%index=1
112else
113 call newlink%setPrevLink(this%lastLink)
114 call this%lastLink%setNextLink(newlink)
115
116 this%lastLink => newlink
117 this%index=this%index+1
118end if
119
120end subroutine append
121
122
123!> add class(*) to beginning of list
124subroutine prepend(this, value)
125class(list) :: this
126character(len=*) :: value
127class(link), pointer :: newlink
128
129newlink => link(value)
130this%currLink => newlink
131
132if (.not. associated(this%firstLink)) then
133 this%firstLink => newlink
134 this%lastLink => newlink
135 this%index=1
136else
137 call newlink%setnextLink(this%firstLink)
138 call this%firstLink%setNextLink(newlink)
139
140 this%firstLink => newlink
141 this%index=this%index+1
142end if
143end subroutine prepend
144
145!> add class(*) to position in list
146logical function insert(this, value, index)
147class(list) :: this
148character(len=*) :: value
149integer,optional :: index
150class(link), pointer :: newLink,nextlink
151
152newlink => link(value)
153
154if (present(index)) then
155 insert = this%seek(index)
156 if (.not. insert) return
157else
158 insert=.true.
159end if
160
161if (.not. associated(this%currLink)) then
162 !insert the first one
163 this%firstLink => newlink
164 this%lastLink => newlink
165 this%index=1
166else
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
181end if
182
183this%currLink => newlink
184
185end function insert
186
187!> get index of currLink
188integer function currentindex(this)
189class(list) :: this
190currentindex=this%index
191end function currentindex
192
193!> reset list iterator to start
194subroutine rewind(this)
195class(list) :: this
196this%currLink => this%firstLink
197if (.not. associated(this%firstLink)) then
198 this%index=imiss
199else
200 this%index=1
201end if
202end subroutine rewind
203
204!> reset list iterator to end
205subroutine forward(this)
206class(list) :: this
207this%currLink => this%lastLink
208if (.not. associated(this%lastLink)) then
209 ! index is unknow here
210 this%index=imiss
211end if
212
213end subroutine forward
214
215!> increment list iterator
216subroutine next(this)
217class(list) :: this
218
219if (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
226end if
227
228end subroutine next
230!> increment list iterator
231subroutine prev(this)
232class(list) :: this
233
234if (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
242end if
243
244end subroutine prev
245
247!> get value from currLink
248function currentpoli(this)
249class(list) :: this
250character(len=listcharmaxlen) :: Currentpoli
251currentpoli = this%currLink%getValue()
252end function currentpoli
253
254
255!>return .true. if current element is associated
256logical function element(this)
257class(list) :: this
258
259element = associated(this%currLink)
260end function element
261
262!> set list iterator to index
263!! return .false. if failed
264logical function seek(this, index)
265class(list) :: this
266integer :: index
267
268if (index == this%index) then
269 seek =.true.
270 return
271end if
273if (index < (this%index) .or. .not. c_e(this%index)) then
274 call this%rewind()
275end if
276
277do while (this%element())
278 if (index == this%index) then
279 seek =.true.
280 return
281 end if
282 call this%next()
283end do
284
285seek = .false.
286return
287
288end function seek
290!> delete values from list
291!! return .true. if succes
292logical function delete(this, index)
293class(list) :: this
294integer,optional :: index
295class(link),pointer :: itemtodelete
296
297if (.not. associated(this%firstLink)) then
298 delete=.false.
299 return
300else
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
319end if
320
321contains
322
323subroutine deleteitem()
324
325class(link), pointer :: prevlink,nextlink
326
327! detach myitem"
328prevlink=>this%currlink%prevlink()
329nextlink=>this%currlink%nextlink()
330
331if (associated(prevlink)) then
332 call prevlink%setNextLink(nextlink)
333else
334 this%firstLink => nextlink
335end if
336
337if (associated(nextlink)) then
338 call nextlink%setPrevLink(prevlink)
339else
340 this%lastLink => prevlink
341end if
342
343deallocate(this%currlink)
344
345! set current to prev
346this%currLink => prevlink
347
348if (associated(this%firstLink))then
349 this%index=max(this%index-1,1)
350else
351 this%index=imiss ! index to current
352endif
353
354end subroutine deleteitem
355end function delete
356
357end module list_abstractforchar
Index method.
Function to check whether a value is missing or not.
like abstract class to use character lists in fortran 2003 (gnu gcc 4.8 do not work with character(le...
class to manage links for lists in fortran 2003.
Definitions of constants and functions for working with missing values.
Abstract implementation of doubly-linked list.

Generated with Doxygen.