Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : MODULE submatrix_types
9 :
10 : USE kinds, ONLY: dp
11 : USE message_passing, ONLY: mp_request_null,&
12 : mp_request_type
13 : USE util, ONLY: sort
14 :
15 : IMPLICIT NONE
16 : PRIVATE
17 :
18 : INTEGER, PARAMETER :: extvec_alloc_factor = 2, extvec_initial_alloc = 32
19 : INTEGER, PARAMETER :: set_modulus = 257 ! determines the number of buckets, should be a prime
20 :
21 : TYPE :: extvec_type
22 : INTEGER, DIMENSION(:), ALLOCATABLE :: darr
23 : INTEGER :: elements = 0, allocated = 0
24 : CONTAINS
25 : PROCEDURE :: insert => extvec_insert
26 : PROCEDURE :: reset => extvec_reset
27 : END TYPE extvec_type
28 :
29 : TYPE, PUBLIC :: set_type
30 : TYPE(extvec_type), DIMENSION(0:set_modulus - 1) :: data = extvec_type()
31 : INTEGER, DIMENSION(:), ALLOCATABLE :: sorted
32 : INTEGER :: elements = 0
33 : LOGICAL :: sorted_up_to_date = .FALSE.
34 : CONTAINS
35 : PROCEDURE :: insert => set_insert
36 : PROCEDURE :: reset => set_reset
37 : PROCEDURE :: find => set_find
38 : PROCEDURE :: get => set_get
39 : PROCEDURE :: getall => set_getall
40 : PROCEDURE :: update_sorted => set_update_sorted
41 : END TYPE set_type
42 :
43 : TYPE, PUBLIC :: intBuffer_type
44 : INTEGER, DIMENSION(:), POINTER :: data => NULL()
45 : INTEGER :: size = 0
46 : LOGICAL :: allocated = .FALSE.
47 : TYPE(mp_request_type) :: mpi_request = mp_request_null
48 : CONTAINS
49 : PROCEDURE :: alloc => intbuffer_alloc
50 : PROCEDURE :: dealloc => intbuffer_dealloc
51 : END TYPE intBuffer_type
52 :
53 : ! TODO: Make data type generic
54 : TYPE, PUBLIC :: buffer_type
55 : REAL(KIND=dp), DIMENSION(:), POINTER :: data => NULL()
56 : INTEGER :: size = 0
57 : LOGICAL :: allocated = .FALSE.
58 : TYPE(mp_request_type) :: mpi_request = mp_request_null
59 : CONTAINS
60 : PROCEDURE :: alloc => buffer_alloc
61 : PROCEDURE :: dealloc => buffer_dealloc
62 : END TYPE buffer_type
63 :
64 : TYPE, PUBLIC :: bufptr_type
65 : REAL(KIND=dp), DIMENSION(:), POINTER :: target => NULL()
66 : END TYPE bufptr_type
67 :
68 : TYPE, PUBLIC :: setarray_type
69 : TYPE(set_type), DIMENSION(:), ALLOCATABLE :: sets
70 : END TYPE setarray_type
71 :
72 : CONTAINS
73 :
74 : ! **************************************************************************************************
75 : !> \brief insert element into extendable vector
76 : !> \param this - instance of extvec_type
77 : !> \param elem - element to insert
78 : ! **************************************************************************************************
79 93 : PURE SUBROUTINE extvec_insert(this, elem)
80 : CLASS(extvec_type), INTENT(INOUT) :: this
81 : INTEGER, INTENT(IN) :: elem
82 93 : INTEGER, DIMENSION(:), ALLOCATABLE :: tmp
83 :
84 93 : IF (this%allocated .EQ. 0) THEN
85 93 : this%allocated = extvec_initial_alloc
86 93 : ALLOCATE (this%darr(this%allocated))
87 : ELSE
88 0 : IF (this%elements .EQ. this%allocated) THEN
89 0 : ALLOCATE (tmp(this%allocated))
90 0 : tmp(:) = this%darr
91 0 : DEALLOCATE (this%darr)
92 0 : ALLOCATE (this%darr(this%allocated*extvec_alloc_factor))
93 0 : this%darr(1:this%allocated) = tmp
94 0 : DEALLOCATE (tmp)
95 0 : this%allocated = this%allocated*extvec_alloc_factor
96 : END IF
97 : END IF
98 :
99 93 : this%elements = this%elements + 1
100 93 : this%darr(this%elements) = elem
101 93 : END SUBROUTINE extvec_insert
102 :
103 : ! **************************************************************************************************
104 : !> \brief purge extendable vector and free allocated memory
105 : !> \param this - instance of extvec_type
106 : ! **************************************************************************************************
107 54998 : PURE SUBROUTINE extvec_reset(this)
108 : CLASS(extvec_type), INTENT(INOUT) :: this
109 :
110 54998 : IF (ALLOCATED(this%darr)) DEALLOCATE (this%darr)
111 54998 : this%allocated = 0
112 54998 : this%elements = 0
113 54998 : END SUBROUTINE extvec_reset
114 :
115 : ! **************************************************************************************************
116 : !> \brief insert element into set
117 : !> \param this - instance of set_type
118 : !> \param elem - element to insert
119 : ! **************************************************************************************************
120 93 : PURE SUBROUTINE set_insert(this, elem)
121 : CLASS(set_type), INTENT(INOUT) :: this
122 : INTEGER, INTENT(IN) :: elem
123 :
124 93 : IF (.NOT. this%find(elem)) THEN
125 93 : CALL this%data(MODULO(elem, set_modulus))%insert(elem)
126 93 : this%sorted_up_to_date = .FALSE.
127 93 : this%elements = this%elements + 1
128 : END IF
129 :
130 93 : END SUBROUTINE set_insert
131 :
132 : ! **************************************************************************************************
133 : !> \brief purse set and free allocated memory
134 : !> \param this - instance of set_type
135 : ! **************************************************************************************************
136 214 : PURE SUBROUTINE set_reset(this)
137 : CLASS(set_type), INTENT(INOUT) :: this
138 : INTEGER :: i
139 :
140 55212 : DO i = 0, set_modulus - 1
141 55212 : CALL this%data(i)%reset
142 : END DO
143 214 : IF (ALLOCATED(this%sorted)) DEALLOCATE (this%sorted)
144 214 : this%elements = 0
145 214 : this%sorted_up_to_date = .FALSE.
146 214 : END SUBROUTINE set_reset
147 :
148 : ! **************************************************************************************************
149 : !> \brief find element in set
150 : !> \param this - instance of set_type
151 : !> \param elem - element to look for
152 : !> \return .TRUE. if element is contained in set, .FALSE. otherwise
153 : ! **************************************************************************************************
154 93 : PURE FUNCTION set_find(this, elem) RESULT(found)
155 : CLASS(set_type), INTENT(IN) :: this
156 : INTEGER, INTENT(IN) :: elem
157 : LOGICAL :: found
158 : INTEGER :: i, idx
159 :
160 93 : found = .FALSE.
161 93 : idx = MODULO(elem, set_modulus)
162 :
163 93 : DO i = 1, this%data(idx)%elements
164 93 : IF (this%data(idx)%darr(i) .EQ. elem) THEN
165 : found = .TRUE.
166 : EXIT
167 : END IF
168 : END DO
169 :
170 93 : END FUNCTION set_find
171 :
172 : ! **************************************************************************************************
173 : !> \brief get element from specific position in set
174 : !> \param this - instance of set_type
175 : !> \param idx - position in set
176 : !> \return element at position idx
177 : ! **************************************************************************************************
178 223 : FUNCTION set_get(this, idx) RESULT(elem)
179 : CLASS(set_type), INTENT(INOUT) :: this
180 : INTEGER, INTENT(IN) :: idx
181 : INTEGER :: elem
182 :
183 223 : IF (.NOT. this%sorted_up_to_date) CALL this%update_sorted
184 :
185 223 : elem = this%sorted(idx)
186 223 : END FUNCTION set_get
187 :
188 : ! **************************************************************************************************
189 : !> \brief get all elements in set as sorted list
190 : !> \param this - instance of set_type
191 : !> \return sorted array containing set elements
192 : ! **************************************************************************************************
193 20 : FUNCTION set_getall(this) RESULT(darr)
194 : CLASS(set_type), INTENT(INOUT) :: this
195 : INTEGER, DIMENSION(this%elements) :: darr
196 :
197 20 : IF (.NOT. this%sorted_up_to_date) CALL this%update_sorted
198 :
199 25 : darr = this%sorted
200 20 : END FUNCTION set_getall
201 :
202 : ! **************************************************************************************************
203 : !> \brief update internal list of set elements
204 : !> \param this - instance of extendable vector
205 : ! **************************************************************************************************
206 108 : SUBROUTINE set_update_sorted(this)
207 : CLASS(set_type), INTENT(INOUT) :: this
208 : INTEGER :: i, idx
209 108 : INTEGER, DIMENSION(:), ALLOCATABLE :: tmp
210 :
211 108 : IF (ALLOCATED(this%sorted)) DEALLOCATE (this%sorted)
212 309 : ALLOCATE (this%sorted(this%elements))
213 :
214 108 : idx = 1
215 27864 : DO i = 0, set_modulus - 1
216 27864 : IF (this%data(i)%elements .GT. 0) THEN
217 186 : this%sorted(idx:idx + this%data(i)%elements - 1) = this%data(i)%darr(1:this%data(i)%elements)
218 93 : idx = idx + this%data(i)%elements
219 : END IF
220 : END DO
221 :
222 309 : ALLOCATE (tmp(this%elements))
223 108 : CALL sort(this%sorted, this%elements, tmp)
224 108 : DEALLOCATE (tmp)
225 :
226 108 : this%sorted_up_to_date = .TRUE.
227 108 : END SUBROUTINE set_update_sorted
228 :
229 : ! **************************************************************************************************
230 : !> \brief allocate buffer
231 : !> \param this - instance of buffer_type
232 : !> \param elements - number of elements contained in buffer
233 : ! **************************************************************************************************
234 80 : PURE SUBROUTINE buffer_alloc(this, elements)
235 : CLASS(buffer_type), INTENT(INOUT) :: this
236 : INTEGER, INTENT(IN) :: elements
237 :
238 180 : ALLOCATE (this%data(elements))
239 80 : this%allocated = .TRUE.
240 80 : this%size = elements
241 80 : END SUBROUTINE buffer_alloc
242 :
243 : ! **************************************************************************************************
244 : !> \brief deallocate buffer
245 : !> \param this - instance of buffer_type
246 : ! **************************************************************************************************
247 80 : PURE SUBROUTINE buffer_dealloc(this)
248 : CLASS(buffer_type), INTENT(INOUT) :: this
249 :
250 80 : IF (this%allocated) DEALLOCATE (this%data)
251 80 : this%allocated = .FALSE.
252 80 : this%size = 0
253 80 : END SUBROUTINE buffer_dealloc
254 :
255 : ! **************************************************************************************************
256 : !> \brief allocate integer buffer
257 : !> \param this - instance of intBuffer_type
258 : !> \param elements - number of elements contained in buffer
259 : ! **************************************************************************************************
260 40 : PURE SUBROUTINE intbuffer_alloc(this, elements)
261 : CLASS(intBuffer_type), INTENT(INOUT) :: this
262 : INTEGER, INTENT(IN) :: elements
263 :
264 90 : ALLOCATE (this%data(elements))
265 40 : this%allocated = .TRUE.
266 40 : this%size = elements
267 40 : END SUBROUTINE intbuffer_alloc
268 :
269 : ! **************************************************************************************************
270 : !> \brief deallocate integer buffer
271 : !> \param this - instance of intBuffer_type
272 : ! **************************************************************************************************
273 40 : PURE SUBROUTINE intbuffer_dealloc(this)
274 : CLASS(intBuffer_type), INTENT(INOUT) :: this
275 :
276 40 : IF (this%allocated) DEALLOCATE (this%data)
277 40 : this%allocated = .FALSE.
278 40 : this%size = 0
279 40 : END SUBROUTINE intbuffer_dealloc
280 :
281 0 : END MODULE submatrix_types
|
