Branch data Line data Source code
1 : : !!****m* ABINIT/m_linked_list
2 : : !! NAME
3 : : !! m_linked_list
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains the a linked list for real(dp).
7 : : !! It is used to build the LIL (list of linked list) format of sparse matrix.
8 : : !!
9 : : !! Datatypes:
10 : : !!
11 : : !! * lnode: a node in the linked list, in each node, there is an integer and a real(dp)
12 : : !! * llist: linked list of lnode
13 : : !!
14 : : !! Subroutines:
15 : : !! TODO: add this when F2003 doc style is determined.
16 : : !!
17 : : !!
18 : : !! COPYRIGHT
19 : : !! Copyright (C) 2001-2026 ABINIT group (hexu)
20 : : !! This file is distributed under the terms of the
21 : : !! GNU General Public License, see ~abinit/COPYING
22 : : !! or http://www.gnu.org/copyleft/gpl.txt .
23 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
24 : : !!
25 : : !! SOURCE
26 : :
27 : :
28 : : #if defined HAVE_CONFIG_H
29 : : #include "config.h"
30 : : #endif
31 : : #include "abi_common.h"
32 : :
33 : : module m_linked_list
34 : : use defs_basis
35 : : use m_errors
36 : : use m_xmpi
37 : : use m_profiling_abi
38 : : implicit none
39 : : !!***
40 : :
41 : : ! node of linked list, which will be used as one non-zero entry in LIL matrix
42 : : ! each node has an integer (i) and a real(dp) (val).
43 : : ! That is because in a LIL sparse matrix, it saves the information of a
44 : : ! column/row indices (int) and values (real)
45 : : ! and the pointer points to the next node
46 : : type, public:: lnode
47 : : integer :: i
48 : : real(dp):: val
49 : : type(lnode), pointer :: next=>null()
50 : : end type lnode
51 : :
52 : : ! linked list of (i, val), it can be a column or a row of LIL sparse matrix
53 : : type, public:: llist
54 : : type(lnode), pointer :: first=>null() ! pointer to first node
55 : : type(lnode), pointer :: last=>null() ! pointer to last node
56 : : type(lnode), pointer :: iter=>null() ! pointer to the current node (e.g. in a loop)
57 : : integer :: length =0 ! number of nodes
58 : : contains
59 : : procedure :: finalize=>llist_finalize ! free memory
60 : : procedure :: append => llist_append ! add a new entry
61 : : procedure :: iter_restart => llist_iter_restart
62 : : procedure :: insert_after => llist_insert_after
63 : : procedure :: insert_head => llist_insert_head
64 : : procedure :: sorted_insert => llist_sorted_insert
65 : : procedure :: get_data => llist_get_data
66 : : end type llist
67 : :
68 : : contains
69 : :
70 : : !----------------------------------------------------------------------
71 : : !> @brief finalize: free memory
72 : : !----------------------------------------------------------------------
73 : 1296 : recursive subroutine llist_finalize(self)
74 : : class(llist), intent(inout) ::self
75 : : type(lnode), pointer :: iter, tmp
76 : 1296 : iter=>self%first
77 [ + + ]: 34992 : do while(associated(iter))
78 : 33696 : tmp=>iter
79 : 33696 : iter=>iter%next
80 : 1296 : if( associated(tmp)) then
81 : 33696 : ABI_FREE_SCALAR(tmp)
82 : : endif
83 : : enddo
84 : 1296 : nullify(self%first)
85 : 1296 : nullify(self%last)
86 : 1296 : self%length=0
87 : 1296 : end subroutine llist_finalize
88 : :
89 : : !----------------------------------------------------------------------
90 : : !> @brief append to the end of the list
91 : : !> @param[in] i: int
92 : : !> @param[in] val: real value
93 : : !----------------------------------------------------------------------
94 : 19500 : subroutine llist_append(self, i, val)
95 : : ! append a element at the end of list
96 : : class(llist), intent(inout) ::self
97 : : integer, intent(in)::i
98 : : real(dp), intent(in)::val
99 [ + + ]: 19500 : if(.not. associated(self%last)) then
100 [ - + ]: 1296 : ABI_MALLOC_SCALAR(self%first)
101 : 1296 : self%last=>self%first
102 : : else
103 [ - + ]: 18204 : ABI_MALLOC_SCALAR(self%last%next)
104 : 18204 : self%last=>self%last%next
105 : : endif
106 : 19500 : self%last%i=i
107 : 19500 : self%last%val=val
108 : 19500 : self%last%next=>null()
109 : 19500 : self%length = self%length+1
110 : 19500 : end subroutine llist_append
111 : :
112 : : !----------------------------------------------------------------------
113 : : !> @brief restart the iteration. set iter to first node
114 : : !----------------------------------------------------------------------
115 : 34992 : subroutine llist_iter_restart(self)
116 : : class(llist):: self
117 : 34992 : self%iter=>self%first
118 : 1296 : end subroutine llist_iter_restart
119 : :
120 : : !----------------------------------------------------------------------
121 : : !> @brief insert to the node after one node ptr
122 : : !>
123 : : !> @param[in] ptr: a pointer to a node in the list
124 : : !> @param[in] i: the integer
125 : : !> @param[in] val: the real value
126 : : !----------------------------------------------------------------------
127 : 12420 : subroutine llist_insert_after(self, ptr, i, val)
128 : : !insert a element so i is sorted.
129 : : ! if mode=0: if i already exist, substitute i, val
130 : : ! if mode=1: val+=val
131 : : class(llist):: self
132 : : integer, intent(in) :: i
133 : : real(dp), intent(in):: val
134 : : type(lnode), pointer, intent(in):: ptr
135 : : type(lnode), pointer:: tmp=>null()
136 [ - + ]: 12420 : if(.not.associated(ptr%next)) then
137 : 0 : call llist_append(self,i,val)
138 : : else
139 [ - + ]: 12420 : ABI_MALLOC_SCALAR(tmp)
140 : 12420 : tmp%i=i
141 : 12420 : tmp%val=val
142 : 12420 : tmp%next=>ptr%next
143 : 12420 : ptr%next=>tmp
144 : 12420 : self%length=self%length+1
145 : : endif
146 : 12420 : end subroutine llist_insert_after
147 : :
148 : : !----------------------------------------------------------------------
149 : : !> @brief inset to the head of the list
150 : : !>
151 : : !> @param[in] i
152 : : !> @param[in] val
153 : : !----------------------------------------------------------------------
154 : 1776 : subroutine llist_insert_head(self, i, val)
155 : : class(llist):: self
156 : : integer, intent(in) :: i
157 : : real(dp), intent(in):: val
158 : : type(lnode), pointer:: tmp=>null()
159 [ - + ]: 1776 : ABI_MALLOC_SCALAR(tmp)
160 : 1776 : tmp%i=i
161 : 1776 : tmp%val=val
162 : 1776 : tmp%next=>self%first
163 : 1776 : self%first=>tmp
164 [ - + ]: 1776 : if (self%length==0) then
165 : 0 : self%last=>tmp
166 : : endif
167 : 1776 : self%length=self%length+1
168 : 1776 : end subroutine llist_insert_head
169 : :
170 : : !----------------------------------------------------------------------
171 : : !> @brief insert to a node so that the list is sorted by i
172 : : !>
173 : : !> @param[in] i : integer value
174 : : !> @param[in] val : real value
175 : : !> @param[in] mode :
176 : : !> if mode=0: if i already exist, substitute i, val
177 : : !> if mode=1: val+=val
178 : : !----------------------------------------------------------------------
179 : 33696 : subroutine llist_sorted_insert(self, i, val, mode)
180 : : !insert a element so i is sorted.
181 : : class(llist):: self
182 : : integer, intent(in) :: i, mode
183 : : real(dp), intent(in):: val
184 : 33696 : call llist_iter_restart(self)
185 [ + + ]: 33696 : if(.not.associated(self%last)) then
186 : 1296 : call llist_append(self,i,val)
187 [ + + ]: 32400 : else if (i<self%first%i) then
188 : 1776 : call llist_insert_head(self, i, val)
189 : : else
190 [ + + ]: 343932 : do while(associated(self%iter))
191 : : ! at the begining i<i0
192 : : ! before the end,
193 [ + - ]: 325728 : if (i>self%iter%i) then
194 [ + + ]: 325728 : if (associated(self%iter%next)) then
195 [ + + ]: 307524 : if (i<self%iter%next%i) then
196 : 12420 : call llist_insert_after(self,self%iter,i,val)
197 : 12420 : return
198 : : end if
199 : : end if
200 [ # # ]: 0 : else if(i==self%iter%i) then
201 : : ! i<i0 or i>i
202 [ # # ]: 0 : if(mode==0) then
203 : 0 : self%iter%val=val
204 [ # # ]: 0 : else if(mode==1) then
205 : 0 : self%iter%val=self%iter%val+val
206 : : endif
207 : 0 : return
208 : : endif
209 : 313308 : self%iter=>self%iter%next
210 : : enddo
211 : : ! i>last i
212 [ + - ]: 18204 : if(i>self%last%i) then
213 : 18204 : call llist_append(self,i,val)
214 : 18204 : return
215 : : else
216 : 0 : ABI_BUG("m_linked_list cannot find proper place to insert")
217 : : endif
218 : : endif
219 : :
220 : :
221 : : end subroutine llist_sorted_insert
222 : :
223 : :
224 : : !----------------------------------------------------------------------
225 : : !> @brief get all the data to arrays of i and val
226 : : !> @param[out] ilist: the array of i
227 : : !> @param[out] vallist: the array of val
228 : : !----------------------------------------------------------------------
229 : 0 : subroutine llist_get_data(self, ilist, vallist)
230 : :
231 : : class(llist), intent(inout)::self
232 : : integer, allocatable, intent(inout)::ilist(:)
233 : : real(dp),allocatable, intent(inout)::vallist(:)
234 : : integer::ind=1
235 [ # # # # : 0 : ABI_MALLOC(ilist,(self%length))
# # # # #
# # # #
# ]
236 [ # # # # : 0 : ABI_MALLOC(vallist, (self%length))
# # # # #
# # # #
# ]
237 : 0 : call llist_iter_restart(self)
238 [ # # ]: 0 : do while(associated(self%iter))
239 : 0 : ilist(ind)=self%iter%i
240 : 0 : vallist(ind)=self%iter%val
241 : 0 : self%iter=>self%iter%next
242 : 0 : ind=ind+1
243 : : enddo
244 : 0 : end subroutine llist_get_data
245 : :
246 [ # # ]: 0 : end module m_linked_list
|