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 : ! **************************************************************************************************
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 157079678 : PURE FUNCTION number_of_arrays(list)
72 : TYPE(array_list), INTENT(IN) :: list
73 : INTEGER :: number_of_arrays
74 :
75 157079678 : number_of_arrays = SIZE(list%ptr) - 1
76 :
77 157079678 : 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 132229092 : 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 420262010 : DO i = 1, SIZE(indices)
92 288032918 : ind = indices(i) + list%ptr(i) - 1
93 420262010 : 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 6327248 : 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 6327248 : size_all = 0
113 :
114 : #:for dim in range(1, maxdim+1)
115 20119379 : IF (ndata .GE. ${dim}$) THEN
116 13793987 : CPASSERT(PRESENT(data_${dim}$))
117 13793987 : size_all = size_all + SIZE(data_${dim}$)
118 : END IF
119 : #:endfor
120 :
121 18981744 : ALLOCATE (list%ptr(ndata + 1))
122 18861227 : ALLOCATE (list%col_data(size_all))
123 :
124 6327248 : ptr = 1
125 6327248 : list%ptr(1) = ptr
126 :
127 : #:for dim in range(1, maxdim+1)
128 20119379 : IF (ndata .GE. ${dim}$) THEN
129 133274330 : list%col_data(ptr:ptr + SIZE(data_${dim}$) - 1) = data_${dim}$ (:)
130 13793987 : ptr = ptr + SIZE(data_${dim}$)
131 13793987 : list%ptr(${dim+1}$) = ptr
132 : END IF
133 : #:endfor
134 :
135 6327248 : 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 2613096 : 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 1306548 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
149 :
150 1306548 : ndata = SIZE(i_selected)
151 :
152 : #:for dim in range(1, maxdim+1)
153 2613096 : IF (ndata == ${dim}$) THEN
154 1306548 : CALL get_arrays(list, ${varlist("data", nmax=dim)}$, i_selected=i_selected)
155 1306548 : CALL create_array_list(array_sublist, ndata, ${varlist("data", nmax=dim)}$)
156 : END IF
157 : #:endfor
158 2613096 : END FUNCTION
159 :
160 : ! **************************************************************************************************
161 : !> \brief destroy array list.
162 : !> \author Patrick Seewald
163 : ! **************************************************************************************************
164 4877627 : SUBROUTINE destroy_array_list(list)
165 : TYPE(array_list), INTENT(INOUT) :: list
166 :
167 4877627 : DEALLOCATE (list%ptr, list%col_data)
168 4877627 : 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 5197295 : 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 5197295 : INTEGER, DIMENSION(number_of_arrays(list)) :: o
185 :
186 17762255 : o(:) = 0
187 5197295 : IF (PRESENT(i_selected)) THEN
188 3836968 : ndata = SIZE(i_selected)
189 12295960 : o(1:ndata) = i_selected(:)
190 : ELSE
191 1360327 : ndata = number_of_arrays(list)
192 6261873 : 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 16106400 : IF (ndata > ${dim-1}$) THEN
198 112916911 : ALLOCATE (data_${dim}$, source=col_data(ptr(o(${dim}$)):ptr(o(${dim}$) + 1) - 1))
199 : END IF
200 : #:endfor
201 : END ASSOCIATE
202 :
203 5197295 : END SUBROUTINE get_arrays
204 :
205 : ! **************************************************************************************************
206 : !> \brief get ith array
207 : !> \author Patrick Seewald
208 : ! **************************************************************************************************
209 1121712 : 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 5852569 : array(:) = col_data(ptr(i):ptr(i + 1) - 1)
219 :
220 : END ASSOCIATE
221 :
222 1121712 : END SUBROUTINE
223 :
224 : ! **************************************************************************************************
225 : !> \brief get ith array
226 : !> \author Patrick Seewald
227 : ! **************************************************************************************************
228 1479808 : 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 14871266 : ALLOCATE (array, source=col_data(ptr(i):ptr(i + 1) - 1))
237 : END ASSOCIATE
238 1479808 : END SUBROUTINE
239 :
240 : ! **************************************************************************************************
241 : !> \brief sizes of arrays stored in list
242 : !> \author Patrick Seewald
243 : ! **************************************************************************************************
244 4355224 : 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 2177612 : num_data = number_of_arrays(list)
251 6532836 : ALLOCATE (sizes_of_arrays(num_data))
252 6737604 : DO i_data = 1, num_data
253 6737604 : 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 1292598 : 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 646299 : num_data = number_of_arrays(list)
268 1938897 : ALLOCATE (sum_of_arrays(num_data))
269 1740833 : DO i_data = 1, num_data
270 10051655 : 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 215433 : 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 215433 : num_data = number_of_arrays(list_in)
286 1408999 : ALLOCATE (list_out%ptr, source=list_in%ptr)
287 646299 : ALLOCATE (list_out%col_data(SIZE(list_in%col_data)))
288 762700 : DO i_data = 1, num_data
289 547267 : partial_sum = 1
290 4918111 : DO i_ptr = list_out%ptr(i_data), list_out%ptr(i_data + 1) - 1
291 4155411 : list_out%col_data(i_ptr) = partial_sum
292 4702678 : partial_sum = partial_sum + list_in%col_data(i_ptr)
293 : END DO
294 : END DO
295 215433 : END SUBROUTINE
296 :
297 : ! **************************************************************************************************
298 : !> \brief reorder array list.
299 : !> \author Patrick Seewald
300 : ! **************************************************************************************************
301 2530420 : 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 2530420 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
305 : INTEGER, DIMENSION(number_of_arrays(list_in)), &
306 : INTENT(IN) :: order
307 :
308 : #:for ndim in ndims
309 5060792 : IF (number_of_arrays(list_in) == ${ndim}$) THEN
310 2530420 : 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 2530420 : ${varlist("data", nmax=ndim)}$)
313 : END IF
314 : #:endfor
315 :
316 2530420 : END SUBROUTINE
317 :
318 : ! **************************************************************************************************
319 : !> \brief check whether two array lists are equal
320 : !> \author Patrick Seewald
321 : ! **************************************************************************************************
322 707625 : FUNCTION check_equal(list1, list2)
323 : TYPE(array_list), INTENT(IN) :: list1, list2
324 : LOGICAL :: check_equal
325 :
326 707625 : check_equal = array_eq_i(list1%col_data, list2%col_data) .AND. array_eq_i(list1%ptr, list2%ptr)
327 707625 : END FUNCTION
328 :
329 : ! **************************************************************************************************
330 : !> \brief check whether two arrays are equal
331 : !> \author Patrick Seewald
332 : ! **************************************************************************************************
333 3592419 : 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 47012623 : 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 3592419 : END FUNCTION
345 :
346 0 : END MODULE dbt_array_list_methods
|
