(git:374b731)
Loading...
Searching...
No Matches
dbt_index.F
Go to the documentation of this file.
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 tensor index and mapping to DBM index
10!> \author Patrick Seewald
11! **************************************************************************************************
12MODULE dbt_index
13 USE dbt_allocate_wrap, ONLY: allocate_any
14 USE kinds, ONLY: int_8
15#include "../base/base_uses.f90"
16
17
18 IMPLICIT NONE
19 PRIVATE
20 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_index'
21
22 PUBLIC :: &
23 combine_tensor_index, &
24 combine_pgrid_index, &
25 create_nd_to_2d_mapping, &
26 destroy_nd_to_2d_mapping, &
27 get_2d_indices_tensor, &
28 get_2d_indices_pgrid, &
29 dbt_get_mapping_info, &
30 get_nd_indices_tensor, &
31 get_nd_indices_pgrid, &
32 nd_to_2d_mapping, &
33 ndims_mapping, &
34 split_tensor_index, &
35 split_pgrid_index, &
36 ndims_mapping_row, &
37 ndims_mapping_column, &
38 dbt_inverse_order, &
39 permute_index
40
41 TYPE nd_to_2d_mapping
42 INTEGER :: ndim_nd = -1
43 INTEGER :: ndim1_2d = -1
44 INTEGER :: ndim2_2d = -1
45
46 INTEGER, DIMENSION(:), ALLOCATABLE :: dims_nd
47 INTEGER(KIND=int_8), DIMENSION(2) :: dims_2d = -1
48 INTEGER, DIMENSION(:), ALLOCATABLE :: dims1_2d
49 INTEGER, DIMENSION(:), ALLOCATABLE :: dims2_2d
50
51 INTEGER, DIMENSION(:), ALLOCATABLE :: map1_2d
52 INTEGER, DIMENSION(:), ALLOCATABLE :: map2_2d
53 INTEGER, DIMENSION(:), ALLOCATABLE :: map_nd
54
55 INTEGER :: base = -1
56 LOGICAL :: col_major = .false.
57 END TYPE nd_to_2d_mapping
58
59CONTAINS
60
61! **************************************************************************************************
62!> \brief Create all data needed to quickly map between nd index and 2d index.
63!> \param map index mapping data
64!> \param dims nd sizes
65!> \param map1_2d which nd-indices map to first matrix index and in which order
66!> \param map2_2d which nd-indices map to second matrix index and in which order
67!> \param base base index (1 for Fortran-style, 0 for C-style, default is 1)
68!> \param col_major whether index should be column major order
69!> (.TRUE. for Fortran-style, .FALSE. for C-style, default is .TRUE.).
70!> \author Patrick Seewald
71! **************************************************************************************************
72 SUBROUTINE create_nd_to_2d_mapping(map, dims, map1_2d, map2_2d, base, col_major)
73 TYPE(nd_to_2d_mapping), INTENT(OUT) :: map
74 INTEGER, DIMENSION(:), INTENT(IN) :: dims, map1_2d, map2_2d
75 INTEGER, INTENT(IN), OPTIONAL :: base
76 LOGICAL, INTENT(IN), OPTIONAL :: col_major
77
78 INTEGER :: i
79
80 IF (PRESENT(col_major)) THEN
81 map%col_major = col_major
82 ELSE
83 map%col_major = .true.
84 END IF
85
86 IF (PRESENT(base)) THEN
87 map%base = base
88 ELSE
89 map%base = 1
90 END IF
91
92 map%ndim1_2d = SIZE(map1_2d)
93 map%ndim2_2d = SIZE(map2_2d)
94 map%ndim_nd = SIZE(dims)
95
96 ALLOCATE (map%map1_2d, source=map1_2d)
97 ALLOCATE (map%map2_2d, source=map2_2d)
98 ALLOCATE (map%dims_nd, source=dims)
99 ALLOCATE (map%dims1_2d, source=dims(map1_2d))
100 ALLOCATE (map%dims2_2d, source=dims(map2_2d))
101
102 ALLOCATE (map%map_nd(map%ndim_nd))
103 map%map_nd(map1_2d) = (/(i, i=1, SIZE(map1_2d))/)
104 map%map_nd(map2_2d) = (/(i + SIZE(map1_2d), i=1, SIZE(map2_2d))/)
105
106 map%dims_2d = [product(int(map%dims1_2d, kind=int_8)), product(int(map%dims2_2d, kind=int_8))]
107
108 END SUBROUTINE create_nd_to_2d_mapping
109
110! **************************************************************************************************
111!> \brief
112!> \author Patrick Seewald
113! **************************************************************************************************
114 SUBROUTINE destroy_nd_to_2d_mapping(map)
115 TYPE(nd_to_2d_mapping), INTENT(INOUT) :: map
116
117 DEALLOCATE (map%dims1_2d)
118 DEALLOCATE (map%dims2_2d)
119 DEALLOCATE (map%map1_2d)
120 DEALLOCATE (map%map2_2d)
121 DEALLOCATE (map%map_nd)
122 DEALLOCATE (map%dims_nd)
123 END SUBROUTINE destroy_nd_to_2d_mapping
124
125! **************************************************************************************************
126!> \brief
127!> \author Patrick Seewald
128! **************************************************************************************************
129 PURE FUNCTION ndims_mapping(map)
130 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
131 INTEGER :: ndims_mapping
132
133 ndims_mapping = map%ndim_nd
134 END FUNCTION
135
136! **************************************************************************************************
137!> \brief how many tensor dimensions are mapped to matrix row
138!> \author Patrick Seewald
139! **************************************************************************************************
140 PURE FUNCTION ndims_mapping_row(map)
141 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
142 INTEGER :: ndims_mapping_row
143 ndims_mapping_row = map%ndim1_2d
144 END FUNCTION
145
146! **************************************************************************************************
147!> \brief how many tensor dimensions are mapped to matrix column
148!> \author Patrick Seewald
149! **************************************************************************************************
150 PURE FUNCTION ndims_mapping_column(map)
151 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
152 INTEGER :: ndims_mapping_column
153 ndims_mapping_column = map%ndim2_2d
154 END FUNCTION
155
156! **************************************************************************************************
157!> \brief get mapping info
158!> \param map index mapping data
159!> \param ndim_nd number of dimensions
160!> \param ndim1_2d number of dimensions that map to first 2d index
161!> \param ndim2_2d number of dimensions that map to first 2d index
162!> \param dims_2d 2d dimensions
163!> \param dims_nd nd dimensions
164!> \param dims1_2d dimensions that map to first 2d index
165!> \param dims2_2d dimensions that map to second 2d index
166!> \param map1_2d indices that map to first 2d index
167!> \param map2_2d indices that map to second 2d index
168!> \param map_nd inverse of [map1_2d, map2_2d]
169!> \param base base index
170!> \param col_major is index in column major order
171!> \author Patrick Seewald
172! **************************************************************************************************
173 PURE SUBROUTINE dbt_get_mapping_info(map, ndim_nd, ndim1_2d, ndim2_2d, dims_2d_i8, &
174 dims_2d, dims_nd, dims1_2d, dims2_2d, &
175 map1_2d, map2_2d, map_nd, base, col_major)
176 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
177 INTEGER, INTENT(OUT), OPTIONAL :: ndim_nd, ndim1_2d, ndim2_2d
178 INTEGER(KIND=int_8), DIMENSION(2), INTENT(OUT), OPTIONAL :: dims_2d_i8
179 INTEGER, DIMENSION(2), INTENT(OUT), OPTIONAL :: dims_2d
180 INTEGER, DIMENSION(ndims_mapping(map)), &
181 INTENT(OUT), OPTIONAL :: dims_nd
182 INTEGER, DIMENSION(ndims_mapping_row(map)), INTENT(OUT), &
183 OPTIONAL :: dims1_2d
184 INTEGER, DIMENSION(ndims_mapping_column(map)), INTENT(OUT), &
185 OPTIONAL :: dims2_2d
186 INTEGER, DIMENSION(ndims_mapping_row(map)), INTENT(OUT), &
187 OPTIONAL :: map1_2d
188 INTEGER, DIMENSION(ndims_mapping_column(map)), INTENT(OUT), &
189 OPTIONAL :: map2_2d
190 INTEGER, DIMENSION(ndims_mapping(map)), &
191 INTENT(OUT), OPTIONAL :: map_nd
192 INTEGER, INTENT(OUT), OPTIONAL :: base
193 LOGICAL, INTENT(OUT), OPTIONAL :: col_major
194
195 IF (PRESENT(ndim_nd)) ndim_nd = map%ndim_nd
196 IF (PRESENT(ndim1_2d)) ndim1_2d = map%ndim1_2d
197 IF (PRESENT(ndim2_2d)) ndim2_2d = map%ndim2_2d
198 IF (PRESENT(dims_2d_i8)) dims_2d_i8(:) = map%dims_2d(:)
199 IF (PRESENT(dims_2d)) dims_2d(:) = int(map%dims_2d(:))
200 IF (PRESENT(dims_nd)) THEN
201 dims_nd(:) = map%dims_nd(:)
202 END IF
203 IF (PRESENT(dims1_2d)) THEN
204 dims1_2d(:) = map%dims1_2d
205 END IF
206 IF (PRESENT(dims2_2d)) THEN
207 dims2_2d(:) = map%dims2_2d
208 END IF
209 IF (PRESENT(map1_2d)) THEN
210 map1_2d(:) = map%map1_2d
211 END IF
212 IF (PRESENT(map2_2d)) THEN
213 map2_2d(:) = map%map2_2d
214 END IF
215 IF (PRESENT(map_nd)) THEN
216 map_nd(:) = map%map_nd(:)
217 END IF
218 IF (PRESENT(base)) THEN
219 base = map%base
220 END IF
221 IF (PRESENT(col_major)) THEN
222 col_major = map%col_major
223 END IF
224
225 END SUBROUTINE dbt_get_mapping_info
226
227! **************************************************************************************************
228!> \brief transform nd index to flat index
229!> \param ind_in nd index
230!> \param dims nd dimensions
231!> \param ind_out flat index
232!> \author Patrick Seewald
233! **************************************************************************************************
234 PURE FUNCTION combine_tensor_index(ind_in, dims) RESULT(ind_out)
235 INTEGER, DIMENSION(:), INTENT(IN) :: ind_in, dims
236 INTEGER(KIND=int_8) :: ind_out
237 INTEGER :: i_dim
238
239 ind_out = ind_in(SIZE(dims))
240 DO i_dim = SIZE(dims) - 1, 1, -1
241 ind_out = (ind_out - 1)*dims(i_dim) + ind_in(i_dim)
242 END DO
243
244 END FUNCTION
245
246! **************************************************************************************************
247!> \brief transform nd index to flat index
248!> \param ind_in nd index
249!> \param dims nd dimensions
250!> \param ind_out flat index
251!> \author Patrick Seewald
252! **************************************************************************************************
253 PURE FUNCTION combine_pgrid_index(ind_in, dims) RESULT(ind_out)
254 INTEGER, DIMENSION(:), INTENT(IN) :: ind_in, dims
255 INTEGER :: ind_out
256
257 INTEGER :: i_dim
258
259 ind_out = ind_in(1)
260 DO i_dim = 2, SIZE(dims)
261 ind_out = ind_out*dims(i_dim) + ind_in(i_dim)
262 END DO
263 END FUNCTION
264
265! **************************************************************************************************
266!> \brief transform flat index to nd index
267!> \param ind_in flat index
268!> \param dims nd dimensions
269!> \param ind_out nd index
270!> \author Patrick Seewald
271! **************************************************************************************************
272 PURE FUNCTION split_tensor_index(ind_in, dims) RESULT(ind_out)
273 INTEGER(KIND=int_8), INTENT(IN) :: ind_in
274 INTEGER, DIMENSION(:), INTENT(IN) :: dims
275 INTEGER, DIMENSION(SIZE(dims)) :: ind_out
276
277 INTEGER(KIND=int_8) :: tmp
278 INTEGER :: i_dim
279
280 tmp = ind_in
281 DO i_dim = 1, SIZE(dims)
282 ind_out(i_dim) = int(mod(tmp - 1, int(dims(i_dim), int_8)) + 1)
283 tmp = (tmp - 1)/dims(i_dim) + 1
284 END DO
285
286 END FUNCTION
287
288! **************************************************************************************************
289!> \brief transform flat index to nd index
290!> \param ind_in flat index
291!> \param dims nd dimensions
292!> \param ind_out nd index
293!> \author Patrick Seewald
294! **************************************************************************************************
295 PURE FUNCTION split_pgrid_index(ind_in, dims) RESULT(ind_out)
296 INTEGER, INTENT(IN) :: ind_in
297 INTEGER, DIMENSION(:), INTENT(IN) :: dims
298 INTEGER, DIMENSION(SIZE(dims)) :: ind_out
299
300 INTEGER :: tmp
301 INTEGER :: i_dim
302
303 tmp = ind_in
304 DO i_dim = SIZE(dims), 1, -1
305 ind_out(i_dim) = mod(tmp, dims(i_dim))
306 tmp = tmp/dims(i_dim)
307 END DO
308 END FUNCTION
309
310! **************************************************************************************************
311!> \brief transform nd index to 2d index, using info from index mapping.
312!> \param map index mapping
313!> \param ind_in nd index
314!> \param ind_out 2d index
315!> \author Patrick Seewald
316! **************************************************************************************************
317 PURE FUNCTION get_2d_indices_tensor(map, ind_in) RESULT(ind_out)
318 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
319 INTEGER, DIMENSION(map%ndim_nd), INTENT(IN) :: ind_in
320 INTEGER(KIND=int_8), DIMENSION(2) :: ind_out
321 INTEGER :: i
322 INTEGER, DIMENSION(4) :: ind_tmp
323
324 DO i = 1, map%ndim1_2d
325 ind_tmp(i) = ind_in(map%map1_2d(i))
326 END DO
327 ind_out(1) = combine_tensor_index(ind_tmp(:map%ndim1_2d), map%dims1_2d)
328
329 DO i = 1, map%ndim2_2d
330 ind_tmp(i) = ind_in(map%map2_2d(i))
331 END DO
332 ind_out(2) = combine_tensor_index(ind_tmp(:map%ndim2_2d), map%dims2_2d)
333 END FUNCTION
334
335! **************************************************************************************************
336!> \brief transform nd index to 2d index, using info from index mapping.
337!> \param map index mapping
338!> \param ind_in nd index
339!> \param ind_out 2d index
340!> \author Patrick Seewald
341! **************************************************************************************************
342 PURE FUNCTION get_2d_indices_pgrid(map, ind_in) RESULT(ind_out)
343 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
344 INTEGER, DIMENSION(map%ndim_nd), INTENT(IN) :: ind_in
345 INTEGER, DIMENSION(2) :: ind_out
346 INTEGER :: i
347 INTEGER, DIMENSION(4) :: ind_tmp
348
349 DO i = 1, map%ndim1_2d
350 ind_tmp(i) = ind_in(map%map1_2d(i))
351 END DO
352 ind_out(1) = combine_pgrid_index(ind_tmp(:map%ndim1_2d), map%dims1_2d)
353
354 DO i = 1, map%ndim2_2d
355 ind_tmp(i) = ind_in(map%map2_2d(i))
356 END DO
357 ind_out(2) = combine_pgrid_index(ind_tmp(:map%ndim2_2d), map%dims2_2d)
358 END FUNCTION
359
360! **************************************************************************************************
361!> \brief transform 2d index to nd index, using info from index mapping.
362!> \param map index mapping
363!> \param ind_in 2d index
364!> \param ind_out nd index
365!> \author Patrick Seewald
366! **************************************************************************************************
367 PURE FUNCTION get_nd_indices_tensor(map, ind_in) RESULT(ind_out)
368 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
369 INTEGER(KIND=int_8), DIMENSION(2), INTENT(IN) :: ind_in
370 INTEGER, DIMENSION(map%ndim_nd) :: ind_out
371 INTEGER, DIMENSION(4) :: ind_tmp
372 INTEGER :: i
373
374 ind_tmp(:map%ndim1_2d) = split_tensor_index(ind_in(1), map%dims1_2d)
375
376 DO i = 1, map%ndim1_2d
377 ind_out(map%map1_2d(i)) = ind_tmp(i)
378 END DO
379
380 ind_tmp(:map%ndim2_2d) = split_tensor_index(ind_in(2), map%dims2_2d)
381
382 DO i = 1, map%ndim2_2d
383 ind_out(map%map2_2d(i)) = ind_tmp(i)
384 END DO
385
386 END FUNCTION
387
388! **************************************************************************************************
389!> \brief transform 2d index to nd index, using info from index mapping.
390!> \param map index mapping
391!> \param ind_in 2d index
392!> \param ind_out nd index
393!> \author Patrick Seewald
394! **************************************************************************************************
395 PURE FUNCTION get_nd_indices_pgrid(map, ind_in) RESULT(ind_out)
396 TYPE(nd_to_2d_mapping), INTENT(IN) :: map
397 INTEGER, DIMENSION(2), INTENT(IN) :: ind_in
398 INTEGER, DIMENSION(map%ndim_nd) :: ind_out
399
400 ind_out(map%map1_2d) = split_pgrid_index(ind_in(1), map%dims1_2d)
401 ind_out(map%map2_2d) = split_pgrid_index(ind_in(2), map%dims2_2d)
402
403 END FUNCTION
404
405! **************************************************************************************************
406!> \brief Invert order
407!> \author Patrick Seewald
408! **************************************************************************************************
409 PURE FUNCTION dbt_inverse_order(order)
410 INTEGER, DIMENSION(:), INTENT(IN) :: order
411 INTEGER, DIMENSION(SIZE(order)) :: dbt_inverse_order
412
413 INTEGER :: i
414
415 dbt_inverse_order(order) = (/(i, i=1, SIZE(order))/)
416 END FUNCTION
417
418! **************************************************************************************************
419!> \brief reorder tensor index (no data)
420!> \author Patrick Seewald
421! **************************************************************************************************
422 SUBROUTINE permute_index(map_in, map_out, order)
423 TYPE(nd_to_2d_mapping), INTENT(IN) :: map_in
424 TYPE(nd_to_2d_mapping), INTENT(OUT) :: map_out
425 INTEGER, DIMENSION(ndims_mapping(map_in)), &
426 INTENT(IN) :: order
427
428 INTEGER :: ndim_nd
429 INTEGER, DIMENSION(ndims_mapping_row(map_in)) :: map1_2d, map1_2d_reorder
430 INTEGER, DIMENSION(ndims_mapping_column(map_in)) :: map2_2d, map2_2d_reorder
431 INTEGER, DIMENSION(ndims_mapping(map_in)) :: dims_nd, dims_reorder
432
433 CALL dbt_get_mapping_info(map_in, ndim_nd, dims_nd=dims_nd, map1_2d=map1_2d, map2_2d=map2_2d)
434
435 dims_reorder(order) = dims_nd
436
437 map1_2d_reorder(:) = order(map1_2d)
438 map2_2d_reorder(:) = order(map2_2d)
439
440 CALL create_nd_to_2d_mapping(map_out, dims_reorder, map1_2d_reorder, map2_2d_reorder)
441 END SUBROUTINE
442
443END MODULE dbt_index
dbt_allocate_wrap::allocate_any
Definition dbt_allocate_wrap.F:26
dbt_allocate_wrap
Wrapper for allocating, copying and reshaping arrays.
Definition dbt_allocate_wrap.F:15
dbt_index
tensor index and mapping to DBM index
Definition dbt_index.F:12
dbt_index::get_2d_indices_pgrid
pure integer function, dimension(2), public get_2d_indices_pgrid(map, ind_in)
transform nd index to 2d index, using info from index mapping.
Definition dbt_index.F:343
dbt_index::create_nd_to_2d_mapping
subroutine, public create_nd_to_2d_mapping(map, dims, map1_2d, map2_2d, base, col_major)
Create all data needed to quickly map between nd index and 2d index.
Definition dbt_index.F:73
dbt_index::get_nd_indices_pgrid
pure integer function, dimension(map%ndim_nd), public get_nd_indices_pgrid(map, ind_in)
transform 2d index to nd index, using info from index mapping.
Definition dbt_index.F:396
dbt_index::ndims_mapping_row
pure integer function, public ndims_mapping_row(map)
how many tensor dimensions are mapped to matrix row
Definition dbt_index.F:141
dbt_index::get_2d_indices_tensor
pure integer(kind=int_8) function, dimension(2), public get_2d_indices_tensor(map, ind_in)
transform nd index to 2d index, using info from index mapping.
Definition dbt_index.F:318
dbt_index::dbt_inverse_order
pure integer function, dimension(size(order)), public dbt_inverse_order(order)
Invert order.
Definition dbt_index.F:410
dbt_index::ndims_mapping
pure integer function, public ndims_mapping(map)
Definition dbt_index.F:130
dbt_index::combine_tensor_index
pure integer(kind=int_8) function, public combine_tensor_index(ind_in, dims)
transform nd index to flat index
Definition dbt_index.F:235
dbt_index::permute_index
subroutine, public permute_index(map_in, map_out, order)
reorder tensor index (no data)
Definition dbt_index.F:423
dbt_index::dbt_get_mapping_info
pure subroutine, public dbt_get_mapping_info(map, ndim_nd, ndim1_2d, ndim2_2d, dims_2d_i8, dims_2d, dims_nd, dims1_2d, dims2_2d, map1_2d, map2_2d, map_nd, base, col_major)
get mapping info
Definition dbt_index.F:176
dbt_index::combine_pgrid_index
pure integer function, public combine_pgrid_index(ind_in, dims)
transform nd index to flat index
Definition dbt_index.F:254
dbt_index::ndims_mapping_column
pure integer function, public ndims_mapping_column(map)
how many tensor dimensions are mapped to matrix column
Definition dbt_index.F:151
dbt_index::get_nd_indices_tensor
pure integer function, dimension(map%ndim_nd), public get_nd_indices_tensor(map, ind_in)
transform 2d index to nd index, using info from index mapping.
Definition dbt_index.F:368
dbt_index::destroy_nd_to_2d_mapping
subroutine, public destroy_nd_to_2d_mapping(map)
Definition dbt_index.F:115
dbt_index::split_tensor_index
pure integer function, dimension(size(dims)), public split_tensor_index(ind_in, dims)
transform flat index to nd index
Definition dbt_index.F:273
dbt_index::split_pgrid_index
pure integer function, dimension(size(dims)), public split_pgrid_index(ind_in, dims)
transform flat index to nd index
Definition dbt_index.F:296
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
dbt_index::nd_to_2d_mapping
Definition dbt_index.F:41