1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
|
! linkedlist.f90 --
! Include file for defining linked lists where each element holds
! the same kind of data
!
! See the example/test program for the way to use this
!
! Note:
! You should only use pointer variables of this type, no
! ordinary variables, as sometimes the memory pointed to
! will be deallocated. The subroutines and functions
! are designed to minimize mistakes (for instance: using
! = instead of =>)
!
! $Id: linkedlist.f90,v 1.4 2009-08-17 04:26:12 arjenmarkus Exp $
!
! Define the linked-list data type
!
type LINKED_LIST
type(LINKED_LIST), pointer :: next
type(LIST_DATA) :: data
end type LINKED_LIST
!
! define a private (!) interface to prevent
! mistakes with ordinary assignment
!
!interface assignment(=)
! module procedure list_assign
!end interface
!private :: list_assign
!
! Define the subroutines and functions
!
contains
! list_assign
! Subroutine to prevent errors with assignment
! Arguments:
! list_left List on the left-hand side
! list_right List on the right-hand side
!
! NOTE:
! This does not work because of a private/public
! conflict
!
!subroutine list_assign( list_left, list_right )
! type(LINKED_LIST), INTENT(OUT) :: list_left
! type(LINKED_LIST), INTENT(IN) :: list_right
! !type(LINKED_LIST), pointer :: list_left
! !type(LINKED_LIST), pointer :: list_right
!
! !
! ! Note the order!
! !
! stop 'Error: ordinary assignment for lists'
! list_left%next => null()
!end subroutine list_assign
! list_create --
! Create and initialise a list
! Arguments:
! list Pointer to new linked list
! data The data for the first element
! Note:
! This version assumes a shallow copy is enough
! (that is, there are no pointers within the data
! to be stored)
! It also assumes the argument list does not already
! refer to a list. Use list_destroy first to
! destroy up an old list.
!
subroutine list_create( list, data )
type(LINKED_LIST), pointer :: list
type(LIST_DATA), intent(in) :: data
allocate( list )
list%next => null()
list%data = data
end subroutine list_create
! list_destroy --
! Destroy an entire list
! Arguments:
! list Pointer to the list to be destroyed
! Note:
! This version assumes that there are no
! pointers within the data that need deallocation
!
subroutine list_destroy( list )
type(LINKED_LIST), pointer :: list
type(LINKED_LIST), pointer :: current
type(LINKED_LIST), pointer :: elem
elem => list
do while ( associated(elem) )
current => elem
elem => current%next
deallocate( current )
enddo
end subroutine list_destroy
! list_count --
! Count the number of items in the list
! Arguments:
! list Pointer to the list
!
integer function list_count( list )
type(LINKED_LIST), pointer :: list
type(LINKED_LIST), pointer :: current
type(LINKED_LIST), pointer :: next
if ( associated(list) ) then
list_count = 1
current => list
do while ( associated(current%next) )
current => current%next
list_count = list_count + 1
enddo
else
list_count = 0
endif
end function list_count
! list_next
! Return the next element (if any)
! Arguments:
! elem Element in the linked list
! Result:
!
function list_next( elem ) result(next)
type(LINKED_LIST), pointer :: elem
type(LINKED_LIST), pointer :: next
next => elem%next
end function list_next
! list_insert
! Insert a new element
! Arguments:
! elem Element in the linked list after
! which to insert the new element
! data The data for the new element
!
subroutine list_insert( elem, data )
type(LINKED_LIST), pointer :: elem
type(LIST_DATA), intent(in) :: data
type(LINKED_LIST), pointer :: next
allocate(next)
next%next => elem%next
elem%next => next
next%data = data
end subroutine list_insert
! list_insert_head
! Insert a new element before the first element
! Arguments:
! list Start of the list
! data The data for the new element
!
subroutine list_insert_head( list, data )
type(LINKED_LIST), pointer :: list
type(LIST_DATA), intent(in) :: data
type(LINKED_LIST), pointer :: elem
allocate(elem)
elem%data = data
elem%next => list
list => elem
end subroutine list_insert_head
! list_delete_element
! Delete an element from the list
! Arguments:
! list Header of the list
! elem Element in the linked list to be
! removed
!
subroutine list_delete_element( list, elem )
type(LINKED_LIST), pointer :: list
type(LINKED_LIST), pointer :: elem
type(LINKED_LIST), pointer :: current
type(LINKED_LIST), pointer :: prev
if ( associated(list,elem) ) then
list => elem%next
deallocate( elem )
else
current => list
prev => list
do while ( associated(current) )
if ( associated(current,elem) ) then
prev%next => current%next
deallocate( current ) ! Is also "elem"
exit
endif
prev => current
current => current%next
enddo
endif
! allocate(next)
!
! next%next => elem%next
! elem%next => next
! next%data = data
end subroutine list_delete_element
! list_get_data
! Get the data stored with a list element
! Arguments:
! elem Element in the linked list
!
function list_get_data( elem ) result(data)
type(LINKED_LIST), pointer :: elem
type(LIST_DATA) :: data
data = elem%data
end function list_get_data
! list_put_data
! Store new data with a list element
! Arguments:
! elem Element in the linked list
! data The data to be stored
!
subroutine list_put_data( elem, data )
type(LINKED_LIST), pointer :: elem
type(LIST_DATA), intent(in) :: data
elem%data = data
end subroutine list_put_data
|
