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