Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Representation of arbitrary number of 1d integer arrays with arbitrary sizes.
10 : !> This is needed for generic handling of dimension-specific tensor quantities
11 : !> (such as block index).
12 : !> \author Patrick Seewald
13 : ! **************************************************************************************************
14 : MODULE dbt_array_list_methods
15 :
16 : #:include "dbt_macros.fypp"
17 : #:set maxdim = maxrank
18 : #:set ndims = range(2,maxdim+1)
19 :
20 : USE dbt_index, ONLY: dbt_inverse_order
21 : USE dbt_allocate_wrap, ONLY: allocate_any
22 :
23 : #include "../base/base_uses.f90"
24 : #if defined(__LIBXS)
25 : USE libxs, ONLY: libxs_diff
26 : # define PURE_ARRAY_EQ
27 : #else
28 : # define PURE_ARRAY_EQ PURE
29 : #endif
30 :
31 : IMPLICIT NONE
32 : PRIVATE
33 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_array_list_methods'
34 :
35 : PUBLIC :: &
36 : array_eq_i, &
37 : array_list, &
38 : array_offsets, &
39 : array_sublist, &
40 : create_array_list, &
41 : destroy_array_list, &
42 : get_array_elements, &
43 : get_arrays, &
44 : get_ith_array, &
45 : number_of_arrays, &
46 : reorder_arrays, &
47 : sizes_of_arrays, &
48 : sum_of_arrays, &
49 : check_equal
50 :
51 : TYPE array_list
52 : INTEGER, DIMENSION(:), ALLOCATABLE :: col_data
53 : INTEGER, DIMENSION(:), ALLOCATABLE :: ptr
54 : END TYPE
55 :
56 : INTERFACE get_ith_array
57 : MODULE PROCEDURE allocate_and_get_ith_array
58 : MODULE PROCEDURE get_ith_array
59 : END INTERFACE
60 :
61 : CONTAINS
62 :
63 : ! **************************************************************************************************
64 : !> \brief number of arrays stored in list
65 : !> \author Patrick Seewald
66 : ! **************************************************************************************************
67 192391777 : PURE FUNCTION number_of_arrays(list)
68 : TYPE(array_list), INTENT(IN) :: list
69 : INTEGER :: number_of_arrays
70 :
71 192391777 : number_of_arrays = SIZE(list%ptr) - 1
72 :
73 192391777 : END FUNCTION number_of_arrays
74 :
75 : ! **************************************************************************************************
76 : !> \brief Get an element for each array.
77 : !> \param indices element index for each array
78 : !> \author Patrick Seewald
79 : ! **************************************************************************************************
80 162823092 : PURE FUNCTION get_array_elements(list, indices)
81 : TYPE(array_list), INTENT(IN) :: list
82 : INTEGER, DIMENSION(number_of_arrays(list)), INTENT(IN) :: indices
83 : INTEGER, DIMENSION(number_of_arrays(list)) :: get_array_elements
84 :
85 : INTEGER :: i, ind
86 :
87 513518885 : DO i = 1, SIZE(indices)
88 350695793 : ind = indices(i) + list%ptr(i) - 1
89 513518885 : get_array_elements(i) = list%col_data(ind)
90 : END DO
91 :
92 : END FUNCTION get_array_elements
93 :
94 : ! **************************************************************************************************
95 : !> \brief collects any number of arrays of different sizes into a single array (list%col_data),
96 : !> storing the indices that start a new array (list%ptr).
97 : !> \param list list of arrays
98 : !> \param ndata number of arrays
99 : !> \param data arrays 1 and 2
100 : !> \author Patrick Seewald
101 : ! **************************************************************************************************
102 7445514 : SUBROUTINE create_array_list(list, ndata, ${varlist("data")}$)
103 : TYPE(array_list), INTENT(OUT) :: list
104 : INTEGER, INTENT(IN) :: ndata
105 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: ${varlist("data")}$
106 : INTEGER :: ptr, size_all
107 :
108 7445514 : size_all = 0
109 :
110 : #:for dim in range(1, maxdim+1)
111 23718049 : IF (ndata >= ${dim}$) THEN
112 16274391 : CPASSERT(PRESENT(data_${dim}$))
113 16274391 : size_all = size_all + SIZE(data_${dim}$)
114 : END IF
115 : #:endfor
116 :
117 22336542 : ALLOCATE (list%ptr(ndata + 1))
118 22200001 : ALLOCATE (list%col_data(size_all))
119 :
120 7445514 : ptr = 1
121 7445514 : list%ptr(1) = ptr
122 :
123 : #:for dim in range(1, maxdim+1)
124 23718049 : IF (ndata >= ${dim}$) THEN
125 163522108 : list%col_data(ptr:ptr + SIZE(data_${dim}$) - 1) = data_${dim}$ (:)
126 16274391 : ptr = ptr + SIZE(data_${dim}$)
127 16274391 : list%ptr(${dim+1}$) = ptr
128 : END IF
129 : #:endfor
130 :
131 7445514 : END SUBROUTINE
132 :
133 : ! **************************************************************************************************
134 : !> \brief extract a subset of arrays
135 : !> \param list list of arrays
136 : !> \param i_selected array numbers to retrieve
137 : !> \author Patrick Seewald
138 : ! **************************************************************************************************
139 2969556 : FUNCTION array_sublist(list, i_selected)
140 : TYPE(array_list), INTENT(IN) :: list
141 : INTEGER, DIMENSION(:), INTENT(IN) :: i_selected
142 : TYPE(array_list) :: array_sublist
143 : INTEGER :: ndata
144 1484778 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
145 :
146 1484778 : ndata = SIZE(i_selected)
147 :
148 : #:for dim in range(1, maxdim+1)
149 2969556 : IF (ndata == ${dim}$) THEN
150 1484778 : CALL get_arrays(list, ${varlist("data", nmax=dim)}$, i_selected=i_selected)
151 1484778 : CALL create_array_list(array_sublist, ndata, ${varlist("data", nmax=dim)}$)
152 : END IF
153 : #:endfor
154 2969556 : END FUNCTION
155 :
156 : ! **************************************************************************************************
157 : !> \brief destroy array list.
158 : !> \author Patrick Seewald
159 : ! **************************************************************************************************
160 5830228 : SUBROUTINE destroy_array_list(list)
161 : TYPE(array_list), INTENT(INOUT) :: list
162 :
163 5830228 : DEALLOCATE (list%ptr, list%col_data)
164 5830228 : END SUBROUTINE
165 :
166 : ! **************************************************************************************************
167 : !> \brief Get all arrays contained in list
168 : !> \param data arrays 1 and 2
169 : !> \param i_selected array numbers to retrieve (if not present, all arrays are returned)
170 : !> \author Patrick Seewald
171 : ! **************************************************************************************************
172 6123337 : SUBROUTINE get_arrays(list, ${varlist("data")}$, i_selected)
173 : !! Get all arrays contained in list
174 : TYPE(array_list), INTENT(IN) :: list
175 : INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(OUT), &
176 : OPTIONAL :: ${varlist("data")}$
177 : INTEGER, DIMENSION(:), INTENT(IN), &
178 : OPTIONAL :: i_selected
179 : INTEGER :: i, ndata
180 6123337 : INTEGER, DIMENSION(number_of_arrays(list)) :: o
181 :
182 20917364 : o(:) = 0
183 6123337 : IF (PRESENT(i_selected)) THEN
184 4568004 : ndata = SIZE(i_selected)
185 14717795 : o(1:ndata) = i_selected(:)
186 : ELSE
187 1555333 : ndata = number_of_arrays(list)
188 7092659 : o(1:ndata) = (/(i, i=1, ndata)/)
189 : END IF
190 :
191 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
192 : #:for dim in range(1, maxdim+1)
193 19041131 : IF (ndata > ${dim-1}$) THEN
194 136750752 : ALLOCATE (data_${dim}$, source=col_data(ptr(o(${dim}$)):ptr(o(${dim}$) + 1) - 1))
195 : END IF
196 : #:endfor
197 : END ASSOCIATE
198 :
199 6123337 : END SUBROUTINE get_arrays
200 :
201 : ! **************************************************************************************************
202 : !> \brief get ith array
203 : !> \author Patrick Seewald
204 : ! **************************************************************************************************
205 1301966 : SUBROUTINE get_ith_array(list, i, array_size, array)
206 : TYPE(array_list), INTENT(IN) :: list
207 : INTEGER, INTENT(IN) :: i
208 : INTEGER, INTENT(IN) :: array_size
209 : INTEGER, DIMENSION(array_size), INTENT(OUT) :: array
210 :
211 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
212 0 : CPASSERT(i <= number_of_arrays(list))
213 :
214 7118645 : array(:) = col_data(ptr(i):ptr(i + 1) - 1)
215 :
216 : END ASSOCIATE
217 :
218 1301966 : END SUBROUTINE
219 :
220 : ! **************************************************************************************************
221 : !> \brief get ith array
222 : !> \author Patrick Seewald
223 : ! **************************************************************************************************
224 1679970 : SUBROUTINE allocate_and_get_ith_array(list, i, array)
225 : TYPE(array_list), INTENT(IN) :: list
226 : INTEGER, INTENT(IN) :: i
227 : INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: array
228 :
229 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
230 0 : CPASSERT(i <= number_of_arrays(list))
231 :
232 18521470 : ALLOCATE (array, source=col_data(ptr(i):ptr(i + 1) - 1))
233 : END ASSOCIATE
234 1679970 : END SUBROUTINE
235 :
236 : ! **************************************************************************************************
237 : !> \brief sizes of arrays stored in list
238 : !> \author Patrick Seewald
239 : ! **************************************************************************************************
240 5022714 : FUNCTION sizes_of_arrays(list)
241 : TYPE(array_list), INTENT(IN) :: list
242 : INTEGER, ALLOCATABLE, DIMENSION(:) :: sizes_of_arrays
243 :
244 : INTEGER :: i_data, num_data
245 :
246 2511357 : num_data = number_of_arrays(list)
247 7534071 : ALLOCATE (sizes_of_arrays(num_data))
248 7730874 : DO i_data = 1, num_data
249 7730874 : sizes_of_arrays(i_data) = list%ptr(i_data + 1) - list%ptr(i_data)
250 : END DO
251 : END FUNCTION sizes_of_arrays
252 :
253 : ! **************************************************************************************************
254 : !> \brief sum of all elements for each array stored in list
255 : !> \author Patrick Seewald
256 : ! **************************************************************************************************
257 1470888 : FUNCTION sum_of_arrays(list)
258 : TYPE(array_list), INTENT(IN) :: list
259 : INTEGER, ALLOCATABLE, DIMENSION(:) :: sum_of_arrays
260 :
261 : INTEGER :: i_data, num_data
262 :
263 735444 : num_data = number_of_arrays(list)
264 2206332 : ALLOCATE (sum_of_arrays(num_data))
265 1976906 : DO i_data = 1, num_data
266 12486298 : sum_of_arrays(i_data) = SUM(list%col_data(list%ptr(i_data):list%ptr(i_data + 1) - 1))
267 : END DO
268 :
269 : END FUNCTION sum_of_arrays
270 :
271 : ! **************************************************************************************************
272 : !> \brief partial sums of array elements.
273 : !> \author Patrick Seewald
274 : ! **************************************************************************************************
275 245148 : SUBROUTINE array_offsets(list_in, list_out)
276 : TYPE(array_list), INTENT(IN) :: list_in
277 : TYPE(array_list), INTENT(OUT) :: list_out
278 :
279 : INTEGER :: i_data, i_ptr, num_data, partial_sum
280 :
281 245148 : num_data = number_of_arrays(list_in)
282 1601323 : ALLOCATE (list_out%ptr, source=list_in%ptr)
283 735444 : ALLOCATE (list_out%col_data(SIZE(list_in%col_data)))
284 865879 : DO i_data = 1, num_data
285 620731 : partial_sum = 1
286 6120575 : DO i_ptr = list_out%ptr(i_data), list_out%ptr(i_data + 1) - 1
287 5254696 : list_out%col_data(i_ptr) = partial_sum
288 5875427 : partial_sum = partial_sum + list_in%col_data(i_ptr)
289 : END DO
290 : END DO
291 245148 : END SUBROUTINE
292 :
293 : ! **************************************************************************************************
294 : !> \brief reorder array list.
295 : !> \author Patrick Seewald
296 : ! **************************************************************************************************
297 3083226 : SUBROUTINE reorder_arrays(list_in, list_out, order)
298 : TYPE(array_list), INTENT(IN) :: list_in
299 : TYPE(array_list), INTENT(OUT) :: list_out
300 3083226 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
301 : INTEGER, DIMENSION(number_of_arrays(list_in)), &
302 : INTENT(IN) :: order
303 :
304 : #:for ndim in ndims
305 6166404 : IF (number_of_arrays(list_in) == ${ndim}$) THEN
306 3083226 : CALL get_arrays(list_in, ${varlist("data", nmax=ndim)}$, i_selected=dbt_inverse_order(order))
307 : CALL create_array_list(list_out, number_of_arrays(list_in), &
308 3083226 : ${varlist("data", nmax=ndim)}$)
309 : END IF
310 : #:endfor
311 :
312 3083226 : END SUBROUTINE
313 :
314 : ! **************************************************************************************************
315 : !> \brief check whether two array lists are equal
316 : !> \author Patrick Seewald
317 : ! **************************************************************************************************
318 916306 : FUNCTION check_equal(list1, list2)
319 : TYPE(array_list), INTENT(IN) :: list1, list2
320 : LOGICAL :: check_equal
321 :
322 916306 : check_equal = array_eq_i(list1%col_data, list2%col_data) .AND. array_eq_i(list1%ptr, list2%ptr)
323 916306 : END FUNCTION
324 :
325 : ! **************************************************************************************************
326 : !> \brief check whether two arrays are equal
327 : !> \author Patrick Seewald
328 : ! **************************************************************************************************
329 4463677 : PURE_ARRAY_EQ FUNCTION array_eq_i(arr1, arr2)
330 : INTEGER, INTENT(IN), DIMENSION(:) :: arr1
331 : INTEGER, INTENT(IN), DIMENSION(:) :: arr2
332 : LOGICAL :: array_eq_i
333 :
334 : #if defined(__LIBXS)
335 4463677 : array_eq_i = .NOT. libxs_diff(arr1, arr2)
336 : #else
337 : array_eq_i = .FALSE.
338 : IF (SIZE(arr1) == SIZE(arr2)) array_eq_i = ALL(arr1 == arr2)
339 : #endif
340 4463677 : END FUNCTION
341 :
342 0 : END MODULE dbt_array_list_methods
|
