Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 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(__LIBXSMM)
25 : # include "libxsmm_version.h"
26 : #endif
27 :
28 : #if CPVERSION_CHECK(1, 11, <=, LIBXSMM_CONFIG_VERSION_MAJOR, LIBXSMM_CONFIG_VERSION_MINOR)
29 : USE libxsmm, ONLY: libxsmm_diff
30 : # define PURE_ARRAY_EQ
31 : #else
32 : # define PURE_ARRAY_EQ PURE
33 : #endif
34 :
35 : IMPLICIT NONE
36 : PRIVATE
37 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_array_list_methods'
38 :
39 : PUBLIC :: &
40 : array_eq_i, &
41 : array_list, &
42 : array_offsets, &
43 : array_sublist, &
44 : create_array_list, &
45 : destroy_array_list, &
46 : get_array_elements, &
47 : get_arrays, &
48 : get_ith_array, &
49 : number_of_arrays, &
50 : reorder_arrays, &
51 : sizes_of_arrays, &
52 : sum_of_arrays, &
53 : check_equal
54 :
55 : TYPE array_list
56 : INTEGER, DIMENSION(:), ALLOCATABLE :: col_data
57 : INTEGER, DIMENSION(:), ALLOCATABLE :: ptr
58 : END TYPE
59 :
60 : INTERFACE get_ith_array
61 : MODULE PROCEDURE allocate_and_get_ith_array
62 : MODULE PROCEDURE get_ith_array
63 : END INTERFACE
64 :
65 : CONTAINS
66 :
67 : ! **************************************************************************************************
68 : !> \brief number of arrays stored in list
69 : !> \author Patrick Seewald
70 : ! **************************************************************************************************
71 159207617 : PURE FUNCTION number_of_arrays(list)
72 : TYPE(array_list), INTENT(IN) :: list
73 : INTEGER :: number_of_arrays
74 :
75 159207617 : number_of_arrays = SIZE(list%ptr) - 1
76 :
77 159207617 : END FUNCTION number_of_arrays
78 :
79 : ! **************************************************************************************************
80 : !> \brief Get an element for each array.
81 : !> \param indices element index for each array
82 : !> \author Patrick Seewald
83 : ! **************************************************************************************************
84 133169126 : PURE FUNCTION get_array_elements(list, indices)
85 : TYPE(array_list), INTENT(IN) :: list
86 : INTEGER, DIMENSION(number_of_arrays(list)), INTENT(IN) :: indices
87 : INTEGER, DIMENSION(number_of_arrays(list)) :: get_array_elements
88 :
89 : INTEGER :: i, ind
90 :
91 422982055 : DO i = 1, SIZE(indices)
92 289812929 : ind = indices(i) + list%ptr(i) - 1
93 422982055 : get_array_elements(i) = list%col_data(ind)
94 : END DO
95 :
96 : END FUNCTION get_array_elements
97 :
98 : ! **************************************************************************************************
99 : !> \brief collects any number of arrays of different sizes into a single array (list%col_data),
100 : !> storing the indices that start a new array (list%ptr).
101 : !> \param list list of arrays
102 : !> \param ndata number of arrays
103 : !> \param data arrays 1 and 2
104 : !> \author Patrick Seewald
105 : ! **************************************************************************************************
106 6524967 : SUBROUTINE create_array_list(list, ndata, ${varlist("data")}$)
107 : TYPE(array_list), INTENT(OUT) :: list
108 : INTEGER, INTENT(IN) :: ndata
109 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: ${varlist("data")}$
110 : INTEGER :: ptr, size_all
111 :
112 6524967 : size_all = 0
113 :
114 : #:for dim in range(1, maxdim+1)
115 20876880 : IF (ndata .GE. ${dim}$) THEN
116 14353769 : CPASSERT(PRESENT(data_${dim}$))
117 14353769 : size_all = size_all + SIZE(data_${dim}$)
118 : END IF
119 : #:endfor
120 :
121 19574901 : ALLOCATE (list%ptr(ndata + 1))
122 19443695 : ALLOCATE (list%col_data(size_all))
123 :
124 6524967 : ptr = 1
125 6524967 : list%ptr(1) = ptr
126 :
127 : #:for dim in range(1, maxdim+1)
128 20876880 : IF (ndata .GE. ${dim}$) THEN
129 135903302 : list%col_data(ptr:ptr + SIZE(data_${dim}$) - 1) = data_${dim}$ (:)
130 14353769 : ptr = ptr + SIZE(data_${dim}$)
131 14353769 : list%ptr(${dim+1}$) = ptr
132 : END IF
133 : #:endfor
134 :
135 6524967 : END SUBROUTINE
136 :
137 : ! **************************************************************************************************
138 : !> \brief extract a subset of arrays
139 : !> \param list list of arrays
140 : !> \param i_selected array numbers to retrieve
141 : !> \author Patrick Seewald
142 : ! **************************************************************************************************
143 2585580 : FUNCTION array_sublist(list, i_selected)
144 : TYPE(array_list), INTENT(IN) :: list
145 : INTEGER, DIMENSION(:), INTENT(IN) :: i_selected
146 : TYPE(array_list) :: array_sublist
147 : INTEGER :: ndata
148 1292790 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
149 :
150 1292790 : ndata = SIZE(i_selected)
151 :
152 : #:for dim in range(1, maxdim+1)
153 2585580 : IF (ndata == ${dim}$) THEN
154 1292790 : CALL get_arrays(list, ${varlist("data", nmax=dim)}$, i_selected=i_selected)
155 1292790 : CALL create_array_list(array_sublist, ndata, ${varlist("data", nmax=dim)}$)
156 : END IF
157 : #:endfor
158 2585580 : END FUNCTION
159 :
160 : ! **************************************************************************************************
161 : !> \brief destroy array list.
162 : !> \author Patrick Seewald
163 : ! **************************************************************************************************
164 5089405 : SUBROUTINE destroy_array_list(list)
165 : TYPE(array_list), INTENT(INOUT) :: list
166 :
167 5089405 : DEALLOCATE (list%ptr, list%col_data)
168 5089405 : END SUBROUTINE
169 :
170 : ! **************************************************************************************************
171 : !> \brief Get all arrays contained in list
172 : !> \param data arrays 1 and 2
173 : !> \param i_selected array numbers to retrieve (if not present, all arrays are returned)
174 : !> \author Patrick Seewald
175 : ! **************************************************************************************************
176 5377351 : SUBROUTINE get_arrays(list, ${varlist("data")}$, i_selected)
177 : !! Get all arrays contained in list
178 : TYPE(array_list), INTENT(IN) :: list
179 : INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(OUT), &
180 : OPTIONAL :: ${varlist("data")}$
181 : INTEGER, DIMENSION(:), INTENT(IN), &
182 : OPTIONAL :: i_selected
183 : INTEGER :: i, ndata
184 5377351 : INTEGER, DIMENSION(number_of_arrays(list)) :: o
185 :
186 18429163 : o(:) = 0
187 5377351 : IF (PRESENT(i_selected)) THEN
188 4023813 : ndata = SIZE(i_selected)
189 13019213 : o(1:ndata) = i_selected(:)
190 : ELSE
191 1353538 : ndata = number_of_arrays(list)
192 6201326 : o(1:ndata) = (/(i, i=1, ndata)/)
193 : END IF
194 :
195 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
196 : #:for dim in range(1, maxdim+1)
197 16795985 : IF (ndata > ${dim-1}$) THEN
198 116299824 : ALLOCATE (data_${dim}$, source=col_data(ptr(o(${dim}$)):ptr(o(${dim}$) + 1) - 1))
199 : END IF
200 : #:endfor
201 : END ASSOCIATE
202 :
203 5377351 : END SUBROUTINE get_arrays
204 :
205 : ! **************************************************************************************************
206 : !> \brief get ith array
207 : !> \author Patrick Seewald
208 : ! **************************************************************************************************
209 1130592 : SUBROUTINE get_ith_array(list, i, array_size, array)
210 : TYPE(array_list), INTENT(IN) :: list
211 : INTEGER, INTENT(IN) :: i
212 : INTEGER, INTENT(IN) :: array_size
213 : INTEGER, DIMENSION(array_size), INTENT(OUT) :: array
214 :
215 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
216 0 : CPASSERT(i <= number_of_arrays(list))
217 :
218 5905031 : array(:) = col_data(ptr(i):ptr(i + 1) - 1)
219 :
220 : END ASSOCIATE
221 :
222 1130592 : END SUBROUTINE
223 :
224 : ! **************************************************************************************************
225 : !> \brief get ith array
226 : !> \author Patrick Seewald
227 : ! **************************************************************************************************
228 1478040 : SUBROUTINE allocate_and_get_ith_array(list, i, array)
229 : TYPE(array_list), INTENT(IN) :: list
230 : INTEGER, INTENT(IN) :: i
231 : INTEGER, DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: array
232 :
233 : ASSOCIATE (ptr => list%ptr, col_data => list%col_data)
234 0 : CPASSERT(i <= number_of_arrays(list))
235 :
236 14871288 : ALLOCATE (array, source=col_data(ptr(i):ptr(i + 1) - 1))
237 : END ASSOCIATE
238 1478040 : END SUBROUTINE
239 :
240 : ! **************************************************************************************************
241 : !> \brief sizes of arrays stored in list
242 : !> \author Patrick Seewald
243 : ! **************************************************************************************************
244 4379326 : FUNCTION sizes_of_arrays(list)
245 : TYPE(array_list), INTENT(IN) :: list
246 : INTEGER, ALLOCATABLE, DIMENSION(:) :: sizes_of_arrays
247 :
248 : INTEGER :: i_data, num_data
249 :
250 2189663 : num_data = number_of_arrays(list)
251 6568989 : ALLOCATE (sizes_of_arrays(num_data))
252 6778008 : DO i_data = 1, num_data
253 6778008 : sizes_of_arrays(i_data) = list%ptr(i_data + 1) - list%ptr(i_data)
254 : END DO
255 : END FUNCTION sizes_of_arrays
256 :
257 : ! **************************************************************************************************
258 : !> \brief sum of all elements for each array stored in list
259 : !> \author Patrick Seewald
260 : ! **************************************************************************************************
261 1281288 : FUNCTION sum_of_arrays(list)
262 : TYPE(array_list), INTENT(IN) :: list
263 : INTEGER, ALLOCATABLE, DIMENSION(:) :: sum_of_arrays
264 :
265 : INTEGER :: i_data, num_data
266 :
267 640644 : num_data = number_of_arrays(list)
268 1921932 : ALLOCATE (sum_of_arrays(num_data))
269 1721692 : DO i_data = 1, num_data
270 10027872 : sum_of_arrays(i_data) = SUM(list%col_data(list%ptr(i_data):list%ptr(i_data + 1) - 1))
271 : END DO
272 :
273 : END FUNCTION sum_of_arrays
274 :
275 : ! **************************************************************************************************
276 : !> \brief partial sums of array elements.
277 : !> \author Patrick Seewald
278 : ! **************************************************************************************************
279 213548 : SUBROUTINE array_offsets(list_in, list_out)
280 : TYPE(array_list), INTENT(IN) :: list_in
281 : TYPE(array_list), INTENT(OUT) :: list_out
282 :
283 : INTEGER :: i_data, i_ptr, num_data, partial_sum
284 :
285 213548 : num_data = number_of_arrays(list_in)
286 1394716 : ALLOCATE (list_out%ptr, source=list_in%ptr)
287 640644 : ALLOCATE (list_out%col_data(SIZE(list_in%col_data)))
288 754072 : DO i_data = 1, num_data
289 540524 : partial_sum = 1
290 4907162 : DO i_ptr = list_out%ptr(i_data), list_out%ptr(i_data + 1) - 1
291 4153090 : list_out%col_data(i_ptr) = partial_sum
292 4693614 : partial_sum = partial_sum + list_in%col_data(i_ptr)
293 : END DO
294 : END DO
295 213548 : END SUBROUTINE
296 :
297 : ! **************************************************************************************************
298 : !> \brief reorder array list.
299 : !> \author Patrick Seewald
300 : ! **************************************************************************************************
301 2731023 : SUBROUTINE reorder_arrays(list_in, list_out, order)
302 : TYPE(array_list), INTENT(IN) :: list_in
303 : TYPE(array_list), INTENT(OUT) :: list_out
304 2731023 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
305 : INTEGER, DIMENSION(number_of_arrays(list_in)), &
306 : INTENT(IN) :: order
307 :
308 : #:for ndim in ndims
309 5461998 : IF (number_of_arrays(list_in) == ${ndim}$) THEN
310 2731023 : CALL get_arrays(list_in, ${varlist("data", nmax=ndim)}$, i_selected=dbt_inverse_order(order))
311 : CALL create_array_list(list_out, number_of_arrays(list_in), &
312 2731023 : ${varlist("data", nmax=ndim)}$)
313 : END IF
314 : #:endfor
315 :
316 2731023 : END SUBROUTINE
317 :
318 : ! **************************************************************************************************
319 : !> \brief check whether two array lists are equal
320 : !> \author Patrick Seewald
321 : ! **************************************************************************************************
322 745553 : FUNCTION check_equal(list1, list2)
323 : TYPE(array_list), INTENT(IN) :: list1, list2
324 : LOGICAL :: check_equal
325 :
326 745553 : check_equal = array_eq_i(list1%col_data, list2%col_data) .AND. array_eq_i(list1%ptr, list2%ptr)
327 745553 : END FUNCTION
328 :
329 : ! **************************************************************************************************
330 : !> \brief check whether two arrays are equal
331 : !> \author Patrick Seewald
332 : ! **************************************************************************************************
333 3730934 : PURE_ARRAY_EQ FUNCTION array_eq_i(arr1, arr2)
334 : INTEGER, INTENT(IN), DIMENSION(:) :: arr1
335 : INTEGER, INTENT(IN), DIMENSION(:) :: arr2
336 : LOGICAL :: array_eq_i
337 :
338 : #if CPVERSION_CHECK(1, 11, <=, LIBXSMM_CONFIG_VERSION_MAJOR, LIBXSMM_CONFIG_VERSION_MINOR)
339 48353860 : array_eq_i = .NOT. libxsmm_diff(arr1, arr2)
340 : #else
341 : array_eq_i = .FALSE.
342 : IF (SIZE(arr1) .EQ. SIZE(arr2)) array_eq_i = ALL(arr1 == arr2)
343 : #endif
344 3730934 : END FUNCTION
345 :
346 0 : END MODULE dbt_array_list_methods
|
