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 192251578 : PURE FUNCTION number_of_arrays(list)
68 : TYPE(array_list), INTENT(IN) :: list
69 : INTEGER :: number_of_arrays
70 :
71 192251578 : number_of_arrays = SIZE(list%ptr) - 1
72 :
73 192251578 : 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 162748089 : 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 513283717 : DO i = 1, SIZE(indices)
88 350535628 : ind = indices(i) + list%ptr(i) - 1
89 513283717 : 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 7432938 : 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 7432938 : size_all = 0
109 :
110 : #:for dim in range(1, maxdim+1)
111 23675017 : IF (ndata >= ${dim}$) THEN
112 16243935 : CPASSERT(PRESENT(data_${dim}$))
113 16243935 : size_all = size_all + SIZE(data_${dim}$)
114 : END IF
115 : #:endfor
116 :
117 22298814 : ALLOCATE (list%ptr(ndata + 1))
118 22162705 : ALLOCATE (list%col_data(size_all))
119 :
120 7432938 : ptr = 1
121 7432938 : list%ptr(1) = ptr
122 :
123 : #:for dim in range(1, maxdim+1)
124 23675017 : IF (ndata >= ${dim}$) THEN
125 163383184 : list%col_data(ptr:ptr + SIZE(data_${dim}$) - 1) = data_${dim}$ (:)
126 16243935 : ptr = ptr + SIZE(data_${dim}$)
127 16243935 : list%ptr(${dim+1}$) = ptr
128 : END IF
129 : #:endfor
130 :
131 7432938 : 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 2967396 : 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 1483698 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
145 :
146 1483698 : ndata = SIZE(i_selected)
147 :
148 : #:for dim in range(1, maxdim+1)
149 2967396 : IF (ndata == ${dim}$) THEN
150 1483698 : CALL get_arrays(list, ${varlist("data", nmax=dim)}$, i_selected=i_selected)
151 1483698 : CALL create_array_list(array_sublist, ndata, ${varlist("data", nmax=dim)}$)
152 : END IF
153 : #:endfor
154 2967396 : END FUNCTION
155 :
156 : ! **************************************************************************************************
157 : !> \brief destroy array list.
158 : !> \author Patrick Seewald
159 : ! **************************************************************************************************
160 5817460 : SUBROUTINE destroy_array_list(list)
161 : TYPE(array_list), INTENT(INOUT) :: list
162 :
163 5817460 : DEALLOCATE (list%ptr, list%col_data)
164 5817460 : 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 6113401 : 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 6113401 : INTEGER, DIMENSION(number_of_arrays(list)) :: o
181 :
182 20882660 : o(:) = 0
183 6113401 : IF (PRESENT(i_selected)) THEN
184 4559148 : ndata = SIZE(i_selected)
185 14686691 : o(1:ndata) = i_selected(:)
186 : ELSE
187 1554253 : ndata = number_of_arrays(list)
188 7088699 : 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 19007507 : IF (ndata > ${dim-1}$) THEN
194 136597056 : ALLOCATE (data_${dim}$, source=col_data(ptr(o(${dim}$)):ptr(o(${dim}$) + 1) - 1))
195 : END IF
196 : #:endfor
197 : END ASSOCIATE
198 :
199 6113401 : END SUBROUTINE get_arrays
200 :
201 : ! **************************************************************************************************
202 : !> \brief get ith array
203 : !> \author Patrick Seewald
204 : ! **************************************************************************************************
205 1291598 : 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 7071989 : array(:) = col_data(ptr(i):ptr(i + 1) - 1)
215 :
216 : END ASSOCIATE
217 :
218 1291598 : END SUBROUTINE
219 :
220 : ! **************************************************************************************************
221 : !> \brief get ith array
222 : !> \author Patrick Seewald
223 : ! **************************************************************************************************
224 1678818 : 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 18514366 : ALLOCATE (array, source=col_data(ptr(i):ptr(i + 1) - 1))
233 : END ASSOCIATE
234 1678818 : END SUBROUTINE
235 :
236 : ! **************************************************************************************************
237 : !> \brief sizes of arrays stored in list
238 : !> \author Patrick Seewald
239 : ! **************************************************************************************************
240 5016594 : 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 2508297 : num_data = number_of_arrays(list)
247 7524891 : ALLOCATE (sizes_of_arrays(num_data))
248 7721118 : DO i_data = 1, num_data
249 7721118 : 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 1469808 : 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 734904 : num_data = number_of_arrays(list)
264 2204712 : ALLOCATE (sum_of_arrays(num_data))
265 1975646 : DO i_data = 1, num_data
266 12482350 : 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 244968 : 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 244968 : num_data = number_of_arrays(list_in)
282 1600243 : ALLOCATE (list_out%ptr, source=list_in%ptr)
283 734904 : ALLOCATE (list_out%col_data(SIZE(list_in%col_data)))
284 865339 : DO i_data = 1, num_data
285 620371 : partial_sum = 1
286 6118691 : DO i_ptr = list_out%ptr(i_data), list_out%ptr(i_data + 1) - 1
287 5253352 : list_out%col_data(i_ptr) = partial_sum
288 5873723 : partial_sum = partial_sum + list_in%col_data(i_ptr)
289 : END DO
290 : END DO
291 244968 : END SUBROUTINE
292 :
293 : ! **************************************************************************************************
294 : !> \brief reorder array list.
295 : !> \author Patrick Seewald
296 : ! **************************************************************************************************
297 3075450 : 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 3075450 : INTEGER, ALLOCATABLE, DIMENSION(:) :: ${varlist("data")}$
301 : INTEGER, DIMENSION(number_of_arrays(list_in)), &
302 : INTENT(IN) :: order
303 :
304 : #:for ndim in ndims
305 6150852 : IF (number_of_arrays(list_in) == ${ndim}$) THEN
306 3075450 : 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 3075450 : ${varlist("data", nmax=ndim)}$)
309 : END IF
310 : #:endfor
311 :
312 3075450 : END SUBROUTINE
313 :
314 : ! **************************************************************************************************
315 : !> \brief check whether two array lists are equal
316 : !> \author Patrick Seewald
317 : ! **************************************************************************************************
318 915034 : FUNCTION check_equal(list1, list2)
319 : TYPE(array_list), INTENT(IN) :: list1, list2
320 : LOGICAL :: check_equal
321 :
322 915034 : check_equal = array_eq_i(list1%col_data, list2%col_data) .AND. array_eq_i(list1%ptr, list2%ptr)
323 915034 : END FUNCTION
324 :
325 : ! **************************************************************************************************
326 : !> \brief check whether two arrays are equal
327 : !> \author Patrick Seewald
328 : ! **************************************************************************************************
329 4457341 : 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 4457341 : 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 4457341 : END FUNCTION
341 :
342 0 : END MODULE dbt_array_list_methods
|
