(git:ed6f26b)
Loading...
Searching...
No Matches
dbt_types.F
Go to the documentation of this file.
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 DBT tensor framework for block-sparse tensor contraction: Types and create/destroy routines.
10!> \author Patrick Seewald
11! **************************************************************************************************
12MODULE dbt_types
13
14
15 USE cp_dbcsr_api, ONLY: dbcsr_type, dbcsr_get_info, dbcsr_distribution_type, dbcsr_distribution_get
16 USE dbt_array_list_methods, ONLY: &
17 array_list, array_offsets, create_array_list, destroy_array_list, get_array_elements, &
18 sizes_of_arrays, sum_of_arrays, array_sublist, get_arrays, get_ith_array, array_eq_i
19 USE dbm_api, ONLY: &
20 dbm_distribution_obj, dbm_type
21 USE kinds, ONLY: dp, dp, default_string_length
22 USE dbt_tas_base, ONLY: &
23 dbt_tas_create, dbt_tas_distribution_new, &
24 dbt_tas_distribution_destroy, dbt_tas_finalize, dbt_tas_get_info, &
25 dbt_tas_destroy, dbt_tas_get_stored_coordinates, dbt_tas_filter, &
26 dbt_tas_get_num_blocks, dbt_tas_get_num_blocks_total, dbt_tas_get_nze, &
27 dbt_tas_get_nze_total, dbt_tas_clear
28 USE dbt_tas_types, ONLY: &
29 dbt_tas_type, dbt_tas_distribution_type, dbt_tas_split_info, dbt_tas_mm_storage
30 USE dbt_tas_mm, ONLY: dbt_tas_set_batched_state
31 USE dbt_index, ONLY: &
32 get_2d_indices_tensor, get_nd_indices_pgrid, create_nd_to_2d_mapping, destroy_nd_to_2d_mapping, &
33 dbt_get_mapping_info, nd_to_2d_mapping, split_tensor_index, combine_tensor_index, combine_pgrid_index, &
34 split_pgrid_index, ndims_mapping, ndims_mapping_row, ndims_mapping_column
35 USE dbt_tas_split, ONLY: &
36 dbt_tas_create_split_rows_or_cols, dbt_tas_release_info, dbt_tas_info_hold, &
37 dbt_tas_create_split, dbt_tas_get_split_info, dbt_tas_set_strict_split
38 USE kinds, ONLY: default_string_length, int_8, dp
39 USE message_passing, ONLY: &
40 mp_cart_type, mp_dims_create, mp_comm_type
41 USE dbt_tas_global, ONLY: dbt_tas_distribution, dbt_tas_rowcol_data, dbt_tas_default_distvec
42 USE dbt_allocate_wrap, ONLY: allocate_any
43 USE dbm_api, ONLY: dbm_scale
44 USE util, ONLY: sort
45#include "../base/base_uses.f90"
46
47 IMPLICIT NONE
48 PRIVATE
49 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'dbt_types'
50
51 PUBLIC :: &
52 blk_dims_tensor, &
53 dbt_blk_offsets, &
54 dbt_blk_sizes, &
55 dbt_clear, &
56 dbt_create, &
57 dbt_destroy, &
58 dbt_distribution, &
59 dbt_distribution_destroy, &
60 dbt_distribution_new, &
61 dbt_distribution_new_expert, &
62 dbt_distribution_type, &
63 dbt_filter, &
64 dbt_finalize, &
65 dbt_get_info, &
66 dbt_get_num_blocks, &
67 dbt_get_num_blocks_total, &
68 dbt_get_nze, &
69 dbt_get_nze_total, &
70 dbt_get_stored_coordinates, &
71 dbt_hold, &
72 dbt_mp_dims_create, &
73 dbt_nd_mp_comm, &
74 dbt_nd_mp_free, &
75 dbt_pgrid_change_dims, &
76 dbt_pgrid_create, &
77 dbt_pgrid_create_expert, &
78 dbt_pgrid_destroy, &
79 dbt_pgrid_type, &
80 dbt_pgrid_set_strict_split, &
81 dbt_scale, &
82 dbt_type, &
83 dims_tensor, &
84 mp_environ_pgrid, &
85 ndims_tensor, &
86 ndims_matrix_row, &
87 ndims_matrix_column, &
88 dbt_nblks_local, &
89 dbt_nblks_total, &
90 dbt_blk_size, &
91 dbt_max_nblks_local, &
92 dbt_default_distvec, &
93 dbt_contraction_storage, &
94 dbt_copy_contraction_storage
95
96 TYPE dbt_pgrid_type
97 TYPE(nd_to_2d_mapping) :: nd_index_grid
98 TYPE(mp_cart_type) :: mp_comm_2d
99 TYPE(dbt_tas_split_info), ALLOCATABLE :: tas_split_info
100 INTEGER :: nproc = -1
101 END TYPE
102
103 TYPE dbt_contraction_storage
104 REAL(dp) :: nsplit_avg = 0.0_dp
105 INTEGER :: ibatch = -1
106 TYPE(array_list) :: batch_ranges
107 LOGICAL :: static = .false.
108 END TYPE
109
110 TYPE dbt_type
111 TYPE(dbt_tas_type), POINTER :: matrix_rep => null()
112 TYPE(nd_to_2d_mapping) :: nd_index_blk
113 TYPE(nd_to_2d_mapping) :: nd_index
114 TYPE(array_list) :: blk_sizes
115 TYPE(array_list) :: blk_offsets
116 TYPE(array_list) :: nd_dist
117 TYPE(dbt_pgrid_type) :: pgrid
118 TYPE(array_list) :: blks_local
119 INTEGER, DIMENSION(:), ALLOCATABLE :: nblks_local
120 INTEGER, DIMENSION(:), ALLOCATABLE :: nfull_local
121 LOGICAL :: valid = .false.
122 LOGICAL :: owns_matrix = .false.
123 CHARACTER(LEN=default_string_length) :: name = ""
124 ! lightweight reference counting for communicators:
125 INTEGER, POINTER :: refcount => null()
126 TYPE(dbt_contraction_storage), ALLOCATABLE :: contraction_storage
127 END TYPE dbt_type
128
129 TYPE dbt_distribution_type
130 TYPE(dbt_tas_distribution_type) :: dist
131 TYPE(dbt_pgrid_type) :: pgrid
132 TYPE(array_list) :: nd_dist
133 ! lightweight reference counting for communicators:
134 INTEGER, POINTER :: refcount => null()
135 END TYPE
136
137! **************************************************************************************************
138!> \brief tas matrix distribution function object for one matrix index
139!> \var dims tensor dimensions only for this matrix dimension
140!> \var dims_grid grid dimensions only for this matrix dimension
141!> \var nd_dist dist only for tensor dimensions belonging to this matrix dimension
142!> \var tas_dist_t map matrix index to process grid
143!> \var tas_rowcols_t map process grid to matrix index
144! **************************************************************************************************
145 TYPE, EXTENDS(dbt_tas_distribution) :: dbt_tas_dist_t
146 INTEGER, DIMENSION(:), ALLOCATABLE :: dims
147 INTEGER, DIMENSION(:), ALLOCATABLE :: dims_grid
148 TYPE(array_list) :: nd_dist
149 CONTAINS
150 PROCEDURE :: dist => tas_dist_t
151 PROCEDURE :: rowcols => tas_rowcols_t
152 END TYPE
153
154! **************************************************************************************************
155!> \brief block size object for one matrix index
156!> \var dims tensor dimensions only for this matrix dimension
157!> \var blk_size block size only for this matrix dimension
158! **************************************************************************************************
159 TYPE, EXTENDS(dbt_tas_rowcol_data) :: dbt_tas_blk_size_t
160 INTEGER, DIMENSION(:), ALLOCATABLE :: dims
161 TYPE(array_list) :: blk_size
162 CONTAINS
163 PROCEDURE :: data => tas_blk_size_t
164 END TYPE
165
166 INTERFACE dbt_create
167 MODULE PROCEDURE dbt_create_new
168 MODULE PROCEDURE dbt_create_template
169 MODULE PROCEDURE dbt_create_matrix
170 END INTERFACE
171
172 INTERFACE dbt_tas_dist_t
173 MODULE PROCEDURE new_dbt_tas_dist_t
174 END INTERFACE
175
176 INTERFACE dbt_tas_blk_size_t
177 MODULE PROCEDURE new_dbt_tas_blk_size_t
178 END INTERFACE
179
180CONTAINS
181
182! **************************************************************************************************
183!> \brief Create distribution object for one matrix dimension
184!> \param nd_dist arrays for distribution vectors along all dimensions
185!> \param map_blks tensor to matrix mapping object for blocks
186!> \param map_grid tensor to matrix mapping object for process grid
187!> \param which_dim for which dimension (1 or 2) distribution should be created
188!> \return distribution object
189!> \author Patrick Seewald
190! **************************************************************************************************
191 FUNCTION new_dbt_tas_dist_t(nd_dist, map_blks, map_grid, which_dim)
192 TYPE(array_list), INTENT(IN) :: nd_dist
193 TYPE(nd_to_2d_mapping), INTENT(IN) :: map_blks, map_grid
194 INTEGER, INTENT(IN) :: which_dim
195
196 TYPE(dbt_tas_dist_t) :: new_dbt_tas_dist_t
197 INTEGER, DIMENSION(2) :: grid_dims
198 INTEGER(KIND=int_8), DIMENSION(2) :: matrix_dims
199 INTEGER, DIMENSION(:), ALLOCATABLE :: index_map
200
201 IF (which_dim == 1) THEN
202 ALLOCATE (new_dbt_tas_dist_t%dims(ndims_mapping_row(map_blks)))
203 ALLOCATE (index_map(ndims_mapping_row(map_blks)))
204 CALL dbt_get_mapping_info(map_blks, &
205 dims_2d_i8=matrix_dims, &
206 map1_2d=index_map, &
207 dims1_2d=new_dbt_tas_dist_t%dims)
208 ALLOCATE (new_dbt_tas_dist_t%dims_grid(ndims_mapping_row(map_grid)))
209 CALL dbt_get_mapping_info(map_grid, &
210 dims_2d=grid_dims, &
211 dims1_2d=new_dbt_tas_dist_t%dims_grid)
212 ELSEIF (which_dim == 2) THEN
213 ALLOCATE (new_dbt_tas_dist_t%dims(ndims_mapping_column(map_blks)))
214 ALLOCATE (index_map(ndims_mapping_column(map_blks)))
215 CALL dbt_get_mapping_info(map_blks, &
216 dims_2d_i8=matrix_dims, &
217 map2_2d=index_map, &
218 dims2_2d=new_dbt_tas_dist_t%dims)
219 ALLOCATE (new_dbt_tas_dist_t%dims_grid(ndims_mapping_column(map_grid)))
220 CALL dbt_get_mapping_info(map_grid, &
221 dims_2d=grid_dims, &
222 dims2_2d=new_dbt_tas_dist_t%dims_grid)
223 ELSE
224 cpabort("Unknown value for which_dim")
225 END IF
226
227 new_dbt_tas_dist_t%nd_dist = array_sublist(nd_dist, index_map)
228 new_dbt_tas_dist_t%nprowcol = grid_dims(which_dim)
229 new_dbt_tas_dist_t%nmrowcol = matrix_dims(which_dim)
230 END FUNCTION
231
232! **************************************************************************************************
233!> \author Patrick Seewald
234! **************************************************************************************************
235 FUNCTION tas_dist_t(t, rowcol)
236 CLASS(dbt_tas_dist_t), INTENT(IN) :: t
237 INTEGER(KIND=int_8), INTENT(IN) :: rowcol
238 INTEGER, DIMENSION(4) :: ind_blk
239 INTEGER, DIMENSION(4) :: dist_blk
240 INTEGER :: tas_dist_t
241
242 ind_blk(:SIZE(t%dims)) = split_tensor_index(rowcol, t%dims)
243 dist_blk(:SIZE(t%dims)) = get_array_elements(t%nd_dist, ind_blk(:SIZE(t%dims)))
244 tas_dist_t = combine_pgrid_index(dist_blk(:SIZE(t%dims)), t%dims_grid)
245 END FUNCTION
246
247! **************************************************************************************************
248!> \author Patrick Seewald
249! **************************************************************************************************
250 FUNCTION tas_rowcols_t(t, dist)
251 CLASS(dbt_tas_dist_t), INTENT(IN) :: t
252 INTEGER, INTENT(IN) :: dist
253 INTEGER(KIND=int_8), DIMENSION(:), ALLOCATABLE :: tas_rowcols_t
254 INTEGER, DIMENSION(4) :: dist_blk
255 INTEGER, DIMENSION(:), ALLOCATABLE :: dist_1, dist_2, dist_3, dist_4, blks_1, blks_2, blks_3, blks_4, blks_tmp, nd_ind
256 INTEGER :: i_1, i_2, i_3, i_4, i, iblk, iblk_count, nblks
257 INTEGER(KIND=int_8) :: nrowcols
258 TYPE(array_list) :: blks
259
260 dist_blk(:SIZE(t%dims)) = split_pgrid_index(dist, t%dims_grid)
261
262 IF (SIZE(t%dims) == 1) THEN
263 CALL get_arrays(t%nd_dist, dist_1)
264 END IF
265 IF (SIZE(t%dims) == 2) THEN
266 CALL get_arrays(t%nd_dist, dist_1, dist_2)
267 END IF
268 IF (SIZE(t%dims) == 3) THEN
269 CALL get_arrays(t%nd_dist, dist_1, dist_2, dist_3)
270 END IF
271 IF (SIZE(t%dims) == 4) THEN
272 CALL get_arrays(t%nd_dist, dist_1, dist_2, dist_3, dist_4)
273 END IF
274
275 IF (SIZE(t%dims) .GE. 1) THEN
276 nblks = SIZE(dist_1)
277 ALLOCATE (blks_tmp(nblks))
278 iblk_count = 0
279 DO iblk = 1, nblks
280 IF (dist_1(iblk) == dist_blk(1)) THEN
281 iblk_count = iblk_count + 1
282 blks_tmp(iblk_count) = iblk
283 END IF
284 END DO
285 ALLOCATE (blks_1(iblk_count))
286 blks_1(:) = blks_tmp(:iblk_count)
287 DEALLOCATE (blks_tmp)
288 END IF
289 IF (SIZE(t%dims) .GE. 2) THEN
290 nblks = SIZE(dist_2)
291 ALLOCATE (blks_tmp(nblks))
292 iblk_count = 0
293 DO iblk = 1, nblks
294 IF (dist_2(iblk) == dist_blk(2)) THEN
295 iblk_count = iblk_count + 1
296 blks_tmp(iblk_count) = iblk
297 END IF
298 END DO
299 ALLOCATE (blks_2(iblk_count))
300 blks_2(:) = blks_tmp(:iblk_count)
301 DEALLOCATE (blks_tmp)
302 END IF
303 IF (SIZE(t%dims) .GE. 3) THEN
304 nblks = SIZE(dist_3)
305 ALLOCATE (blks_tmp(nblks))
306 iblk_count = 0
307 DO iblk = 1, nblks
308 IF (dist_3(iblk) == dist_blk(3)) THEN
309 iblk_count = iblk_count + 1
310 blks_tmp(iblk_count) = iblk
311 END IF
312 END DO
313 ALLOCATE (blks_3(iblk_count))
314 blks_3(:) = blks_tmp(:iblk_count)
315 DEALLOCATE (blks_tmp)
316 END IF
317 IF (SIZE(t%dims) .GE. 4) THEN
318 nblks = SIZE(dist_4)
319 ALLOCATE (blks_tmp(nblks))
320 iblk_count = 0
321 DO iblk = 1, nblks
322 IF (dist_4(iblk) == dist_blk(4)) THEN
323 iblk_count = iblk_count + 1
324 blks_tmp(iblk_count) = iblk
325 END IF
326 END DO
327 ALLOCATE (blks_4(iblk_count))
328 blks_4(:) = blks_tmp(:iblk_count)
329 DEALLOCATE (blks_tmp)
330 END IF
331
332 IF (SIZE(t%dims) == 1) THEN
333 CALL create_array_list(blks, 1, blks_1)
334 END IF
335 IF (SIZE(t%dims) == 2) THEN
336 CALL create_array_list(blks, 2, blks_1, blks_2)
337 END IF
338 IF (SIZE(t%dims) == 3) THEN
339 CALL create_array_list(blks, 3, blks_1, blks_2, blks_3)
340 END IF
341 IF (SIZE(t%dims) == 4) THEN
342 CALL create_array_list(blks, 4, blks_1, blks_2, blks_3, blks_4)
343 END IF
344
345 nrowcols = product(int(sizes_of_arrays(blks), int_8))
346 ALLOCATE (tas_rowcols_t(nrowcols))
347
348 IF (SIZE(t%dims) == 1) THEN
349 ALLOCATE (nd_ind(1))
350 i = 0
351 DO i_1 = 1, SIZE(blks_1)
352 i = i + 1
353
354 nd_ind(:) = get_array_elements(blks, [i_1])
355 tas_rowcols_t(i) = combine_tensor_index(nd_ind, t%dims)
356 END DO
357 END IF
358 IF (SIZE(t%dims) == 2) THEN
359 ALLOCATE (nd_ind(2))
360 i = 0
361 DO i_1 = 1, SIZE(blks_1)
362 DO i_2 = 1, SIZE(blks_2)
363 i = i + 1
364
365 nd_ind(:) = get_array_elements(blks, [i_1, i_2])
366 tas_rowcols_t(i) = combine_tensor_index(nd_ind, t%dims)
367 END DO
368 END DO
369 END IF
370 IF (SIZE(t%dims) == 3) THEN
371 ALLOCATE (nd_ind(3))
372 i = 0
373 DO i_1 = 1, SIZE(blks_1)
374 DO i_2 = 1, SIZE(blks_2)
375 DO i_3 = 1, SIZE(blks_3)
376 i = i + 1
377
378 nd_ind(:) = get_array_elements(blks, [i_1, i_2, i_3])
379 tas_rowcols_t(i) = combine_tensor_index(nd_ind, t%dims)
380 END DO
381 END DO
382 END DO
383 END IF
384 IF (SIZE(t%dims) == 4) THEN
385 ALLOCATE (nd_ind(4))
386 i = 0
387 DO i_1 = 1, SIZE(blks_1)
388 DO i_2 = 1, SIZE(blks_2)
389 DO i_3 = 1, SIZE(blks_3)
390 DO i_4 = 1, SIZE(blks_4)
391 i = i + 1
392
393 nd_ind(:) = get_array_elements(blks, [i_1, i_2, i_3, i_4])
394 tas_rowcols_t(i) = combine_tensor_index(nd_ind, t%dims)
395 END DO
396 END DO
397 END DO
398 END DO
399 END IF
400
401 END FUNCTION
402
403! **************************************************************************************************
404!> \brief Create block size object for one matrix dimension
405!> \param blk_size arrays for block sizes along all dimensions
406!> \param map_blks tensor to matrix mapping object for blocks
407!> \param which_dim for which dimension (1 or 2) distribution should be created
408!> \return block size object
409!> \author Patrick Seewald
410! **************************************************************************************************
411 FUNCTION new_dbt_tas_blk_size_t(blk_size, map_blks, which_dim)
412 TYPE(array_list), INTENT(IN) :: blk_size
413 TYPE(nd_to_2d_mapping), INTENT(IN) :: map_blks
414 INTEGER, INTENT(IN) :: which_dim
415 INTEGER(KIND=int_8), DIMENSION(2) :: matrix_dims
416 INTEGER, DIMENSION(:), ALLOCATABLE :: index_map
417 TYPE(dbt_tas_blk_size_t) :: new_dbt_tas_blk_size_t
418
419 IF (which_dim == 1) THEN
420 ALLOCATE (index_map(ndims_mapping_row(map_blks)))
421 ALLOCATE (new_dbt_tas_blk_size_t%dims(ndims_mapping_row(map_blks)))
422 CALL dbt_get_mapping_info(map_blks, &
423 dims_2d_i8=matrix_dims, &
424 map1_2d=index_map, &
425 dims1_2d=new_dbt_tas_blk_size_t%dims)
426 ELSEIF (which_dim == 2) THEN
427 ALLOCATE (index_map(ndims_mapping_column(map_blks)))
428 ALLOCATE (new_dbt_tas_blk_size_t%dims(ndims_mapping_column(map_blks)))
429 CALL dbt_get_mapping_info(map_blks, &
430 dims_2d_i8=matrix_dims, &
431 map2_2d=index_map, &
432 dims2_2d=new_dbt_tas_blk_size_t%dims)
433 ELSE
434 cpabort("Unknown value for which_dim")
435 END IF
436
437 new_dbt_tas_blk_size_t%blk_size = array_sublist(blk_size, index_map)
438 new_dbt_tas_blk_size_t%nmrowcol = matrix_dims(which_dim)
439
440 new_dbt_tas_blk_size_t%nfullrowcol = product(int(sum_of_arrays(new_dbt_tas_blk_size_t%blk_size), &
441 kind=int_8))
442 END FUNCTION
443
444! **************************************************************************************************
445!> \author Patrick Seewald
446! **************************************************************************************************
447 FUNCTION tas_blk_size_t(t, rowcol)
448 CLASS(dbt_tas_blk_size_t), INTENT(IN) :: t
449 INTEGER(KIND=int_8), INTENT(IN) :: rowcol
450 INTEGER :: tas_blk_size_t
451 INTEGER, DIMENSION(SIZE(t%dims)) :: ind_blk
452 INTEGER, DIMENSION(SIZE(t%dims)) :: blk_size
453
454 ind_blk(:) = split_tensor_index(rowcol, t%dims)
455 blk_size(:) = get_array_elements(t%blk_size, ind_blk)
456 tas_blk_size_t = product(blk_size)
457
458 END FUNCTION
459
460! **************************************************************************************************
461!> \brief load balancing criterion whether to accept process grid dimension based on total number of
462!> cores and tensor dimension
463!> \param pdims_avail available process grid dimensions (total number of cores)
464!> \param pdim process grid dimension to test
465!> \param tdim tensor dimension corresponding to pdim
466!> \param lb_ratio load imbalance acceptance factor
467!> \author Patrick Seewald
468! **************************************************************************************************
469 PURE FUNCTION accept_pdims_loadbalancing(pdims_avail, pdim, tdim, lb_ratio)
470 INTEGER, INTENT(IN) :: pdims_avail
471 INTEGER, INTENT(IN) :: pdim
472 INTEGER, INTENT(IN) :: tdim
473 REAL(dp), INTENT(IN) :: lb_ratio
474 LOGICAL :: accept_pdims_loadbalancing
475
476 accept_pdims_loadbalancing = .false.
477 IF (mod(pdims_avail, pdim) == 0) THEN
478 IF (real(tdim, dp)*lb_ratio < real(pdim, dp)) THEN
479 IF (mod(tdim, pdim) == 0) accept_pdims_loadbalancing = .true.
480 ELSE
481 accept_pdims_loadbalancing = .true.
482 END IF
483 END IF
484
485 END FUNCTION
486
487! **************************************************************************************************
488!> \brief Create process grid dimensions corresponding to one dimension of the matrix representation
489!> of a tensor, imposing that no process grid dimension is greater than the corresponding
490!> tensor dimension.
491!> \param nodes Total number of nodes available for this matrix dimension
492!> \param dims process grid dimension corresponding to tensor_dims
493!> \param tensor_dims tensor dimensions
494!> \param lb_ratio load imbalance acceptance factor
495!> \author Patrick Seewald
496! **************************************************************************************************
497 RECURSIVE SUBROUTINE dbt_mp_dims_create(nodes, dims, tensor_dims, lb_ratio)
498 INTEGER, INTENT(IN) :: nodes
499 INTEGER, DIMENSION(:), INTENT(INOUT) :: dims
500 INTEGER, DIMENSION(:), INTENT(IN) :: tensor_dims
501 REAL(dp), INTENT(IN), OPTIONAL :: lb_ratio
502
503 INTEGER, DIMENSION(:), ALLOCATABLE :: tensor_dims_sorted, sort_indices, dims_store
504 REAL(dp), DIMENSION(:), ALLOCATABLE :: sort_key
505 INTEGER :: pdims_rem, idim, pdim
506 REAL(dp) :: lb_ratio_prv
507
508 IF (PRESENT(lb_ratio)) THEN
509 lb_ratio_prv = lb_ratio
510 ELSE
511 lb_ratio_prv = 0.1_dp
512 END IF
513
514 ALLOCATE (dims_store, source=dims)
515
516 ! get default process grid dimensions
517 IF (any(dims == 0)) THEN
518 CALL mp_dims_create(nodes, dims)
519 END IF
520
521 ! sort dimensions such that problematic grid dimensions (those who should be corrected) come first
522 ALLOCATE (sort_key(SIZE(tensor_dims)))
523 sort_key(:) = real(tensor_dims, dp)/dims
524
525 ALLOCATE (tensor_dims_sorted, source=tensor_dims)
526 ALLOCATE (sort_indices(SIZE(sort_key)))
527 CALL sort(sort_key, SIZE(sort_key), sort_indices)
528 tensor_dims_sorted(:) = tensor_dims_sorted(sort_indices)
529 dims(:) = dims(sort_indices)
530
531 ! remaining number of nodes
532 pdims_rem = nodes
533
534 DO idim = 1, SIZE(tensor_dims_sorted)
535 IF (.NOT. accept_pdims_loadbalancing(pdims_rem, dims(idim), tensor_dims_sorted(idim), lb_ratio_prv)) THEN
536 pdim = tensor_dims_sorted(idim)
537 DO WHILE (.NOT. accept_pdims_loadbalancing(pdims_rem, pdim, tensor_dims_sorted(idim), lb_ratio_prv))
538 pdim = pdim - 1
539 END DO
540 dims(idim) = pdim
541 pdims_rem = pdims_rem/dims(idim)
542
543 IF (idim .NE. SIZE(tensor_dims_sorted)) THEN
544 dims(idim + 1:) = 0
545 CALL mp_dims_create(pdims_rem, dims(idim + 1:))
546 ELSEIF (lb_ratio_prv < 0.5_dp) THEN
547 ! resort to a less strict load imbalance factor
548 dims(:) = dims_store
549 CALL dbt_mp_dims_create(nodes, dims, tensor_dims, 0.5_dp)
550 RETURN
551 ELSE
552 ! resort to default process grid dimensions
553 dims(:) = dims_store
554 CALL mp_dims_create(nodes, dims)
555 RETURN
556 END IF
557
558 ELSE
559 pdims_rem = pdims_rem/dims(idim)
560 END IF
561 END DO
562
563 dims(sort_indices) = dims
564
565 END SUBROUTINE
566
567! **************************************************************************************************
568!> \brief Create an n-dimensional process grid.
569!> We can not use a n-dimensional MPI cartesian grid for tensors since the mapping between
570!> n-dim. and 2-dim. index allows for an arbitrary reordering of tensor index. Therefore we
571!> can not use n-dim. MPI Cartesian grid because it may not be consistent with the respective
572!> 2d grid. The 2d Cartesian MPI grid is the reference grid (since tensor data is stored as
573!> DBM matrix) and this routine creates an object that is a n-dim. interface to this grid.
574!> map1_2d and map2_2d don't need to be specified (correctly), grid may be redefined in
575!> dbt_distribution_new. Note that pgrid is equivalent to a MPI cartesian grid only
576!> if map1_2d and map2_2d don't reorder indices (which is the case if
577!> [map1_2d, map2_2d] == [1, 2, ..., ndims]). Otherwise the mapping of grid coordinates to
578!> processes depends on the ordering of the indices and is not equivalent to a MPI cartesian
579!> grid.
580!> \param mp_comm simple MPI Communicator
581!> \param dims grid dimensions - if entries are 0, dimensions are chosen automatically.
582!> \param pgrid n-dimensional grid object
583!> \param map1_2d which nd-indices map to first matrix index and in which order
584!> \param map2_2d which nd-indices map to first matrix index and in which order
585!> \param tensor_dims tensor block dimensions. If present, process grid dimensions are created such
586!> that good load balancing is ensured even if some of the tensor dimensions are
587!> small (i.e. on the same order or smaller than nproc**(1/ndim) where ndim is
588!> the tensor rank)
589!> \param nsplit impose a constant split factor
590!> \param dimsplit which matrix dimension to split
591!> \author Patrick Seewald
592! **************************************************************************************************
593 SUBROUTINE dbt_pgrid_create_expert(mp_comm, dims, pgrid, map1_2d, map2_2d, tensor_dims, nsplit, dimsplit)
594 CLASS(mp_comm_type), INTENT(IN) :: mp_comm
595 INTEGER, DIMENSION(:), INTENT(INOUT) :: dims
596 TYPE(dbt_pgrid_type), INTENT(OUT) :: pgrid
597 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d, map2_2d
598 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: tensor_dims
599 INTEGER, INTENT(IN), OPTIONAL :: nsplit, dimsplit
600 INTEGER, DIMENSION(2) :: pdims_2d
601 INTEGER :: nproc, ndims, handle
602 TYPE(dbt_tas_split_info) :: info
603
604 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbt_pgrid_create_expert'
605
606 CALL timeset(routinen, handle)
607
608 ndims = SIZE(dims)
609
610 nproc = mp_comm%num_pe
611 IF (any(dims == 0)) THEN
612 IF (.NOT. PRESENT(tensor_dims)) THEN
613 CALL mp_dims_create(nproc, dims)
614 ELSE
615 CALL dbt_mp_dims_create(nproc, dims, tensor_dims)
616 END IF
617 END IF
618 CALL create_nd_to_2d_mapping(pgrid%nd_index_grid, dims, map1_2d, map2_2d, base=0, col_major=.false.)
619 CALL dbt_get_mapping_info(pgrid%nd_index_grid, dims_2d=pdims_2d)
620 CALL pgrid%mp_comm_2d%create(mp_comm, 2, pdims_2d)
621
622 IF (PRESENT(nsplit)) THEN
623 cpassert(PRESENT(dimsplit))
624 CALL dbt_tas_create_split(info, pgrid%mp_comm_2d, dimsplit, nsplit, opt_nsplit=.false.)
625 ALLOCATE (pgrid%tas_split_info, source=info)
626 END IF
627
628 ! store number of MPI ranks because we need it for PURE function dbt_max_nblks_local
629 pgrid%nproc = nproc
630
631 CALL timestop(handle)
632 END SUBROUTINE
633
634! **************************************************************************************************
635!> \brief Create a default nd process topology that is consistent with a given 2d topology.
636!> Purpose: a nd tensor defined on the returned process grid can be represented as a DBM
637!> matrix with the given 2d topology.
638!> This is needed to enable contraction of 2 tensors (must have the same 2d process grid).
639!> \param comm_2d communicator with 2-dimensional topology
640!> \param map1_2d which nd-indices map to first matrix index and in which order
641!> \param map2_2d which nd-indices map to second matrix index and in which order
642!> \param dims_nd nd dimensions
643!> \param pdims_2d if comm_2d does not have a cartesian topology associated, can input dimensions
644!> with pdims_2d
645!> \param tdims tensor block dimensions. If present, process grid dimensions are created such that
646!> good load balancing is ensured even if some of the tensor dimensions are small
647!> (i.e. on the same order or smaller than nproc**(1/ndim) where ndim is the tensor rank)
648!> \return with nd cartesian grid
649!> \author Patrick Seewald
650! **************************************************************************************************
651 FUNCTION dbt_nd_mp_comm(comm_2d, map1_2d, map2_2d, dims_nd, dims1_nd, dims2_nd, pdims_2d, tdims, &
652 nsplit, dimsplit)
653 CLASS(mp_comm_type), INTENT(IN) :: comm_2d
654 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d, map2_2d
655 INTEGER, DIMENSION(SIZE(map1_2d) + SIZE(map2_2d)), &
656 INTENT(IN), OPTIONAL :: dims_nd
657 INTEGER, DIMENSION(SIZE(map1_2d)), INTENT(IN), OPTIONAL :: dims1_nd
658 INTEGER, DIMENSION(SIZE(map2_2d)), INTENT(IN), OPTIONAL :: dims2_nd
659 INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: pdims_2d
660 INTEGER, DIMENSION(SIZE(map1_2d) + SIZE(map2_2d)), &
661 INTENT(IN), OPTIONAL :: tdims
662 INTEGER, INTENT(IN), OPTIONAL :: nsplit, dimsplit
663 INTEGER :: ndim1, ndim2
664 INTEGER, DIMENSION(2) :: dims_2d
665
666 INTEGER, DIMENSION(SIZE(map1_2d)) :: dims1_nd_prv
667 INTEGER, DIMENSION(SIZE(map2_2d)) :: dims2_nd_prv
668 INTEGER, DIMENSION(SIZE(map1_2d) + SIZE(map2_2d)) :: dims_nd_prv
669 INTEGER :: handle
670 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbt_nd_mp_comm'
671 TYPE(dbt_pgrid_type) :: dbt_nd_mp_comm
672
673 CALL timeset(routinen, handle)
674
675 ndim1 = SIZE(map1_2d); ndim2 = SIZE(map2_2d)
676
677 IF (PRESENT(pdims_2d)) THEN
678 dims_2d(:) = pdims_2d
679 ELSE
680! This branch allows us to call this routine with a plain mp_comm_type without actually requiring an mp_cart_type
681! In a few cases in CP2K, this prevents erroneous calls to mpi_cart_get with a non-cartesian communicator
682 SELECT TYPE (comm_2d)
683 CLASS IS (mp_cart_type)
684 dims_2d = comm_2d%num_pe_cart
685 CLASS DEFAULT
686 CALL cp_abort(__location__, "If the argument pdims_2d is not given, the "// &
687 "communicator comm_2d must be of class mp_cart_type.")
688 END SELECT
689 END IF
690
691 IF (.NOT. PRESENT(dims_nd)) THEN
692 dims1_nd_prv = 0; dims2_nd_prv = 0
693 IF (PRESENT(dims1_nd)) THEN
694 dims1_nd_prv(:) = dims1_nd
695 ELSE
696
697 IF (PRESENT(tdims)) THEN
698 CALL dbt_mp_dims_create(dims_2d(1), dims1_nd_prv, tdims(map1_2d))
699 ELSE
700 CALL mp_dims_create(dims_2d(1), dims1_nd_prv)
701 END IF
702 END IF
703
704 IF (PRESENT(dims2_nd)) THEN
705 dims2_nd_prv(:) = dims2_nd
706 ELSE
707 IF (PRESENT(tdims)) THEN
708 CALL dbt_mp_dims_create(dims_2d(2), dims2_nd_prv, tdims(map2_2d))
709 ELSE
710 CALL mp_dims_create(dims_2d(2), dims2_nd_prv)
711 END IF
712 END IF
713 dims_nd_prv(map1_2d) = dims1_nd_prv
714 dims_nd_prv(map2_2d) = dims2_nd_prv
715 ELSE
716 cpassert(product(dims_nd(map1_2d)) == dims_2d(1))
717 cpassert(product(dims_nd(map2_2d)) == dims_2d(2))
718 dims_nd_prv = dims_nd
719 END IF
720
721 CALL dbt_pgrid_create_expert(comm_2d, dims_nd_prv, dbt_nd_mp_comm, &
722 tensor_dims=tdims, map1_2d=map1_2d, map2_2d=map2_2d, nsplit=nsplit, dimsplit=dimsplit)
723
724 CALL timestop(handle)
725
726 END FUNCTION
727
728! **************************************************************************************************
729!> \brief Release the MPI communicator.
730!> \author Patrick Seewald
731! **************************************************************************************************
732 SUBROUTINE dbt_nd_mp_free(mp_comm)
733 TYPE(mp_comm_type), INTENT(INOUT) :: mp_comm
734
735 CALL mp_comm%free()
736 END SUBROUTINE dbt_nd_mp_free
737
738! **************************************************************************************************
739!> \brief remap a process grid (needed when mapping between tensor and matrix index is changed)
740!> \param map1_2d new mapping
741!> \param map2_2d new mapping
742!> \author Patrick Seewald
743! **************************************************************************************************
744 SUBROUTINE dbt_pgrid_remap(pgrid_in, map1_2d, map2_2d, pgrid_out)
745 TYPE(dbt_pgrid_type), INTENT(IN) :: pgrid_in
746 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d, map2_2d
747 TYPE(dbt_pgrid_type), INTENT(OUT) :: pgrid_out
748 INTEGER, DIMENSION(:), ALLOCATABLE :: dims
749 INTEGER, DIMENSION(ndims_mapping_row(pgrid_in%nd_index_grid)) :: map1_2d_old
750 INTEGER, DIMENSION(ndims_mapping_column(pgrid_in%nd_index_grid)) :: map2_2d_old
751
752 ALLOCATE (dims(SIZE(map1_2d) + SIZE(map2_2d)))
753 CALL dbt_get_mapping_info(pgrid_in%nd_index_grid, dims_nd=dims, map1_2d=map1_2d_old, map2_2d=map2_2d_old)
754 CALL dbt_pgrid_create_expert(pgrid_in%mp_comm_2d, dims, pgrid_out, map1_2d=map1_2d, map2_2d=map2_2d)
755 IF (array_eq_i(map1_2d_old, map1_2d) .AND. array_eq_i(map2_2d_old, map2_2d)) THEN
756 IF (ALLOCATED(pgrid_in%tas_split_info)) THEN
757 ALLOCATE (pgrid_out%tas_split_info, source=pgrid_in%tas_split_info)
758 CALL dbt_tas_info_hold(pgrid_out%tas_split_info)
759 END IF
760 END IF
761 END SUBROUTINE
762
763! **************************************************************************************************
764!> \brief as mp_environ but for special pgrid type
765!> \author Patrick Seewald
766! **************************************************************************************************
767 SUBROUTINE mp_environ_pgrid(pgrid, dims, task_coor)
768 TYPE(dbt_pgrid_type), INTENT(IN) :: pgrid
769 INTEGER, DIMENSION(ndims_mapping(pgrid%nd_index_grid)), INTENT(OUT) :: dims
770 INTEGER, DIMENSION(ndims_mapping(pgrid%nd_index_grid)), INTENT(OUT) :: task_coor
771 INTEGER, DIMENSION(2) :: task_coor_2d
772
773 task_coor_2d = pgrid%mp_comm_2d%mepos_cart
774 CALL dbt_get_mapping_info(pgrid%nd_index_grid, dims_nd=dims)
775 task_coor = get_nd_indices_pgrid(pgrid%nd_index_grid, task_coor_2d)
776 END SUBROUTINE
777
778! **************************************************************************************************
779!> \brief Create a tensor distribution.
780!> \param pgrid process grid
781!> \param map1_2d which nd-indices map to first matrix index and in which order
782!> \param map2_2d which nd-indices map to second matrix index and in which order
783!> \param own_comm whether distribution should own communicator
784!> \author Patrick Seewald
785! **************************************************************************************************
786 SUBROUTINE dbt_distribution_new_expert(dist, pgrid, map1_2d, map2_2d, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4, own_comm)
787 TYPE(dbt_distribution_type), INTENT(OUT) :: dist
788 TYPE(dbt_pgrid_type), INTENT(IN) :: pgrid
789 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d
790 INTEGER, DIMENSION(:), INTENT(IN) :: map2_2d
791 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4
792 LOGICAL, INTENT(IN), OPTIONAL :: own_comm
793 INTEGER :: ndims
794 TYPE(mp_cart_type) :: comm_2d
795 INTEGER, DIMENSION(2) :: pdims_2d_check, &
796 pdims_2d
797 INTEGER, DIMENSION(SIZE(map1_2d) + SIZE(map2_2d)) :: dims, nblks_nd, task_coor
798 TYPE(array_list) :: nd_dist
799 TYPE(nd_to_2d_mapping) :: map_blks, map_grid
800 INTEGER :: handle
801 TYPE(dbt_tas_dist_t) :: row_dist_obj, col_dist_obj
802 TYPE(dbt_pgrid_type) :: pgrid_prv
803 LOGICAL :: need_pgrid_remap
804 INTEGER, DIMENSION(ndims_mapping_row(pgrid%nd_index_grid)) :: map1_2d_check
805 INTEGER, DIMENSION(ndims_mapping_column(pgrid%nd_index_grid)) :: map2_2d_check
806 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbt_distribution_new_expert'
807
808 CALL timeset(routinen, handle)
809 ndims = SIZE(map1_2d) + SIZE(map2_2d)
810 cpassert(ndims .GE. 2 .AND. ndims .LE. 4)
811
812 CALL create_array_list(nd_dist, ndims, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4)
813
814 nblks_nd(:) = sizes_of_arrays(nd_dist)
815
816 need_pgrid_remap = .true.
817 IF (PRESENT(own_comm)) THEN
818 CALL dbt_get_mapping_info(pgrid%nd_index_grid, map1_2d=map1_2d_check, map2_2d=map2_2d_check)
819 IF (own_comm) THEN
820 IF (.NOT. array_eq_i(map1_2d_check, map1_2d) .OR. .NOT. array_eq_i(map2_2d_check, map2_2d)) THEN
821 cpabort("map1_2d / map2_2d are not consistent with pgrid")
822 END IF
823 pgrid_prv = pgrid
824 need_pgrid_remap = .false.
825 END IF
826 END IF
827
828 IF (need_pgrid_remap) CALL dbt_pgrid_remap(pgrid, map1_2d, map2_2d, pgrid_prv)
829
830 ! check that 2d process topology is consistent with nd topology.
831 CALL mp_environ_pgrid(pgrid_prv, dims, task_coor)
832
833 ! process grid index mapping
834 CALL create_nd_to_2d_mapping(map_grid, dims, map1_2d, map2_2d, base=0, col_major=.false.)
835
836 ! blk index mapping
837 CALL create_nd_to_2d_mapping(map_blks, nblks_nd, map1_2d, map2_2d)
838
839 row_dist_obj = dbt_tas_dist_t(nd_dist, map_blks, map_grid, 1)
840 col_dist_obj = dbt_tas_dist_t(nd_dist, map_blks, map_grid, 2)
841
842 CALL dbt_get_mapping_info(map_grid, dims_2d=pdims_2d)
843
844 comm_2d = pgrid_prv%mp_comm_2d
845
846 pdims_2d_check = comm_2d%num_pe_cart
847 IF (any(pdims_2d_check .NE. pdims_2d)) THEN
848 cpabort("inconsistent process grid dimensions")
849 END IF
850
851 IF (ALLOCATED(pgrid_prv%tas_split_info)) THEN
852 CALL dbt_tas_distribution_new(dist%dist, comm_2d, row_dist_obj, col_dist_obj, split_info=pgrid_prv%tas_split_info)
853 ELSE
854 CALL dbt_tas_distribution_new(dist%dist, comm_2d, row_dist_obj, col_dist_obj)
855 ALLOCATE (pgrid_prv%tas_split_info, source=dist%dist%info)
856 CALL dbt_tas_info_hold(pgrid_prv%tas_split_info)
857 END IF
858
859 dist%nd_dist = nd_dist
860 dist%pgrid = pgrid_prv
861
862 ALLOCATE (dist%refcount)
863 dist%refcount = 1
864 CALL timestop(handle)
865
866 END SUBROUTINE
867
868! **************************************************************************************************
869!> \brief Create a tensor distribution.
870!> \param pgrid process grid
871!> \param nd_dist_i distribution vectors for all tensor dimensions
872!> \author Patrick Seewald
873! **************************************************************************************************
874 SUBROUTINE dbt_distribution_new(dist, pgrid, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4)
875 TYPE(dbt_distribution_type), INTENT(OUT) :: dist
876 TYPE(dbt_pgrid_type), INTENT(IN) :: pgrid
877 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4
878 INTEGER, DIMENSION(ndims_mapping_row(pgrid%nd_index_grid)) :: map1_2d
879 INTEGER, DIMENSION(ndims_mapping_column(pgrid%nd_index_grid)) :: map2_2d
880 INTEGER :: ndims
881
882 CALL dbt_get_mapping_info(pgrid%nd_index_grid, map1_2d=map1_2d, map2_2d=map2_2d, ndim_nd=ndims)
883
884 CALL dbt_distribution_new_expert(dist, pgrid, map1_2d, map2_2d, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4)
885
886 END SUBROUTINE
887
888! **************************************************************************************************
889!> \brief destroy process grid
890!> \param keep_comm if .TRUE. communicator is not freed
891!> \author Patrick Seewald
892! **************************************************************************************************
893 SUBROUTINE dbt_pgrid_destroy(pgrid, keep_comm)
894 TYPE(dbt_pgrid_type), INTENT(INOUT) :: pgrid
895 LOGICAL, INTENT(IN), OPTIONAL :: keep_comm
896 LOGICAL :: keep_comm_prv
897 IF (PRESENT(keep_comm)) THEN
898 keep_comm_prv = keep_comm
899 ELSE
900 keep_comm_prv = .false.
901 END IF
902 IF (.NOT. keep_comm_prv) CALL pgrid%mp_comm_2d%free()
903 CALL destroy_nd_to_2d_mapping(pgrid%nd_index_grid)
904 IF (ALLOCATED(pgrid%tas_split_info) .AND. .NOT. keep_comm_prv) THEN
905 CALL dbt_tas_release_info(pgrid%tas_split_info)
906 DEALLOCATE (pgrid%tas_split_info)
907 END IF
908 END SUBROUTINE
909
910! **************************************************************************************************
911!> \brief Destroy tensor distribution
912!> \author Patrick Seewald
913! **************************************************************************************************
914 SUBROUTINE dbt_distribution_destroy(dist)
915 TYPE(dbt_distribution_type), INTENT(INOUT) :: dist
916 INTEGER :: handle
917 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbt_distribution_destroy'
918 LOGICAL :: abort
919
920 CALL timeset(routinen, handle)
921 CALL dbt_tas_distribution_destroy(dist%dist)
922 CALL destroy_array_list(dist%nd_dist)
923
924 abort = .false.
925 IF (.NOT. ASSOCIATED(dist%refcount)) THEN
926 abort = .true.
927 ELSEIF (dist%refcount < 1) THEN
928 abort = .true.
929 END IF
930
931 IF (abort) THEN
932 cpabort("can not destroy non-existing tensor distribution")
933 END IF
934
935 dist%refcount = dist%refcount - 1
936
937 IF (dist%refcount == 0) THEN
938 CALL dbt_pgrid_destroy(dist%pgrid)
939 DEALLOCATE (dist%refcount)
940 ELSE
941 CALL dbt_pgrid_destroy(dist%pgrid, keep_comm=.true.)
942 END IF
943
944 CALL timestop(handle)
945 END SUBROUTINE
946
947! **************************************************************************************************
948!> \brief reference counting for distribution
949!> (only needed for communicator handle that must be freed when no longer needed)
950!> \author Patrick Seewald
951! **************************************************************************************************
952 SUBROUTINE dbt_distribution_hold(dist)
953 TYPE(dbt_distribution_type), INTENT(IN) :: dist
954 INTEGER, POINTER :: ref
955
956 IF (dist%refcount < 1) THEN
957 cpabort("can not hold non-existing tensor distribution")
958 END IF
959 ref => dist%refcount
960 ref = ref + 1
961 END SUBROUTINE
962
963! **************************************************************************************************
964!> \brief get distribution from tensor
965!> \return distribution
966!> \author Patrick Seewald
967! **************************************************************************************************
968 FUNCTION dbt_distribution(tensor)
969 TYPE(dbt_type), INTENT(IN) :: tensor
970 TYPE(dbt_distribution_type) :: dbt_distribution
971
972 CALL dbt_tas_get_info(tensor%matrix_rep, distribution=dbt_distribution%dist)
973 dbt_distribution%pgrid = tensor%pgrid
974 dbt_distribution%nd_dist = tensor%nd_dist
975 dbt_distribution%refcount => dbt_distribution%refcount
976 END FUNCTION
977
978! **************************************************************************************************
979!> \author Patrick Seewald
980! **************************************************************************************************
981 SUBROUTINE dbt_distribution_remap(dist_in, map1_2d, map2_2d, dist_out)
982 TYPE(dbt_distribution_type), INTENT(IN) :: dist_in
983 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d, map2_2d
984 TYPE(dbt_distribution_type), INTENT(OUT) :: dist_out
985 INTEGER, DIMENSION(:), ALLOCATABLE :: dist_1, dist_2, dist_3, dist_4
986 INTEGER :: ndims
987 ndims = SIZE(map1_2d) + SIZE(map2_2d)
988 IF (ndims == 1) THEN
989 CALL get_arrays(dist_in%nd_dist, dist_1)
990 CALL dbt_distribution_new_expert(dist_out, dist_in%pgrid, map1_2d, map2_2d, dist_1)
991 END IF
992 IF (ndims == 2) THEN
993 CALL get_arrays(dist_in%nd_dist, dist_1, dist_2)
994 CALL dbt_distribution_new_expert(dist_out, dist_in%pgrid, map1_2d, map2_2d, dist_1, dist_2)
995 END IF
996 IF (ndims == 3) THEN
997 CALL get_arrays(dist_in%nd_dist, dist_1, dist_2, dist_3)
998 CALL dbt_distribution_new_expert(dist_out, dist_in%pgrid, map1_2d, map2_2d, dist_1, dist_2, dist_3)
999 END IF
1000 IF (ndims == 4) THEN
1001 CALL get_arrays(dist_in%nd_dist, dist_1, dist_2, dist_3, dist_4)
1002 CALL dbt_distribution_new_expert(dist_out, dist_in%pgrid, map1_2d, map2_2d, dist_1, dist_2, dist_3, dist_4)
1003 END IF
1004 END SUBROUTINE
1005
1006! **************************************************************************************************
1007!> \brief create a tensor.
1008!> For performance, the arguments map1_2d and map2_2d (controlling matrix representation of
1009!> tensor) should be consistent with the the contraction to be performed (see documentation
1010!> of dbt_contract).
1011!> \param map1_2d which nd-indices to map to first 2d index and in which order
1012!> \param map2_2d which nd-indices to map to first 2d index and in which order
1013!> \param blk_size_i blk sizes in each dimension
1014!> \author Patrick Seewald
1015! **************************************************************************************************
1016 SUBROUTINE dbt_create_new(tensor, name, dist, map1_2d, map2_2d, &
1017 blk_size_1, blk_size_2, blk_size_3, blk_size_4)
1018 TYPE(dbt_type), INTENT(OUT) :: tensor
1019 CHARACTER(len=*), INTENT(IN) :: name
1020 TYPE(dbt_distribution_type), INTENT(INOUT) :: dist
1021 INTEGER, DIMENSION(:), INTENT(IN) :: map1_2d
1022 INTEGER, DIMENSION(:), INTENT(IN) :: map2_2d
1023 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: blk_size_1, blk_size_2, blk_size_3, blk_size_4
1024 INTEGER :: ndims
1025 INTEGER(KIND=int_8), DIMENSION(2) :: dims_2d
1026 INTEGER, DIMENSION(SIZE(map1_2d) + SIZE(map2_2d)) :: dims, pdims, task_coor
1027 TYPE(dbt_tas_blk_size_t) :: col_blk_size_obj, row_blk_size_obj
1028 TYPE(dbt_distribution_type) :: dist_new
1029 TYPE(array_list) :: blk_size, blks_local
1030 TYPE(nd_to_2d_mapping) :: map
1031 INTEGER :: handle
1032 CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_create_new'
1033 INTEGER, DIMENSION(:), ALLOCATABLE :: blks_local_1, blks_local_2, blks_local_3, blks_local_4
1034 INTEGER, DIMENSION(:), ALLOCATABLE :: dist_1, dist_2, dist_3, dist_4
1035 INTEGER :: iblk_count, iblk
1036 INTEGER, DIMENSION(:), ALLOCATABLE :: nblks_local, nfull_local
1037
1038 CALL timeset(routinen, handle)
1039 ndims = SIZE(map1_2d) + SIZE(map2_2d)
1040 CALL create_array_list(blk_size, ndims, blk_size_1, blk_size_2, blk_size_3, blk_size_4)
1041 dims = sizes_of_arrays(blk_size)
1042
1043 CALL create_nd_to_2d_mapping(map, dims, map1_2d, map2_2d)
1044 CALL dbt_get_mapping_info(map, dims_2d_i8=dims_2d)
1045
1046 row_blk_size_obj = dbt_tas_blk_size_t(blk_size, map, 1)
1047 col_blk_size_obj = dbt_tas_blk_size_t(blk_size, map, 2)
1048
1049 CALL dbt_distribution_remap(dist, map1_2d, map2_2d, dist_new)
1050
1051 ALLOCATE (tensor%matrix_rep)
1052 CALL dbt_tas_create(matrix=tensor%matrix_rep, &
1053 name=trim(name)//" matrix", &
1054 dist=dist_new%dist, &
1055 row_blk_size=row_blk_size_obj, &
1056 col_blk_size=col_blk_size_obj)
1057
1058 tensor%owns_matrix = .true.
1059
1060 tensor%nd_index_blk = map
1061 tensor%name = name
1062
1063 CALL dbt_tas_finalize(tensor%matrix_rep)
1064 CALL destroy_nd_to_2d_mapping(map)
1065
1066 ! map element-wise tensor index
1067 CALL create_nd_to_2d_mapping(map, sum_of_arrays(blk_size), map1_2d, map2_2d)
1068 tensor%nd_index = map
1069 tensor%blk_sizes = blk_size
1070
1071 CALL mp_environ_pgrid(dist_new%pgrid, pdims, task_coor)
1072
1073 IF (ndims == 1) THEN
1074 CALL get_arrays(dist_new%nd_dist, dist_1)
1075 END IF
1076 IF (ndims == 2) THEN
1077 CALL get_arrays(dist_new%nd_dist, dist_1, dist_2)
1078 END IF
1079 IF (ndims == 3) THEN
1080 CALL get_arrays(dist_new%nd_dist, dist_1, dist_2, dist_3)
1081 END IF
1082 IF (ndims == 4) THEN
1083 CALL get_arrays(dist_new%nd_dist, dist_1, dist_2, dist_3, dist_4)
1084 END IF
1085
1086 ALLOCATE (nblks_local(ndims))
1087 ALLOCATE (nfull_local(ndims))
1088 nfull_local(:) = 0
1089 IF (ndims .GE. 1) THEN
1090 nblks_local(1) = count(dist_1 == task_coor(1))
1091 ALLOCATE (blks_local_1(nblks_local(1)))
1092 iblk_count = 0
1093 DO iblk = 1, SIZE(dist_1)
1094 IF (dist_1(iblk) == task_coor(1)) THEN
1095 iblk_count = iblk_count + 1
1096 blks_local_1(iblk_count) = iblk
1097 nfull_local(1) = nfull_local(1) + blk_size_1(iblk)
1098 END IF
1099 END DO
1100 END IF
1101 IF (ndims .GE. 2) THEN
1102 nblks_local(2) = count(dist_2 == task_coor(2))
1103 ALLOCATE (blks_local_2(nblks_local(2)))
1104 iblk_count = 0
1105 DO iblk = 1, SIZE(dist_2)
1106 IF (dist_2(iblk) == task_coor(2)) THEN
1107 iblk_count = iblk_count + 1
1108 blks_local_2(iblk_count) = iblk
1109 nfull_local(2) = nfull_local(2) + blk_size_2(iblk)
1110 END IF
1111 END DO
1112 END IF
1113 IF (ndims .GE. 3) THEN
1114 nblks_local(3) = count(dist_3 == task_coor(3))
1115 ALLOCATE (blks_local_3(nblks_local(3)))
1116 iblk_count = 0
1117 DO iblk = 1, SIZE(dist_3)
1118 IF (dist_3(iblk) == task_coor(3)) THEN
1119 iblk_count = iblk_count + 1
1120 blks_local_3(iblk_count) = iblk
1121 nfull_local(3) = nfull_local(3) + blk_size_3(iblk)
1122 END IF
1123 END DO
1124 END IF
1125 IF (ndims .GE. 4) THEN
1126 nblks_local(4) = count(dist_4 == task_coor(4))
1127 ALLOCATE (blks_local_4(nblks_local(4)))
1128 iblk_count = 0
1129 DO iblk = 1, SIZE(dist_4)
1130 IF (dist_4(iblk) == task_coor(4)) THEN
1131 iblk_count = iblk_count + 1
1132 blks_local_4(iblk_count) = iblk
1133 nfull_local(4) = nfull_local(4) + blk_size_4(iblk)
1134 END IF
1135 END DO
1136 END IF
1137
1138 IF (ndims == 1) THEN
1139 CALL create_array_list(blks_local, 1, blks_local_1)
1140 END IF
1141 IF (ndims == 2) THEN
1142 CALL create_array_list(blks_local, 2, blks_local_1, blks_local_2)
1143 END IF
1144 IF (ndims == 3) THEN
1145 CALL create_array_list(blks_local, 3, blks_local_1, blks_local_2, blks_local_3)
1146 END IF
1147 IF (ndims == 4) THEN
1148 CALL create_array_list(blks_local, 4, blks_local_1, blks_local_2, blks_local_3, blks_local_4)
1149 END IF
1150
1151 ALLOCATE (tensor%nblks_local(ndims))
1152 ALLOCATE (tensor%nfull_local(ndims))
1153 tensor%nblks_local(:) = nblks_local
1154 tensor%nfull_local(:) = nfull_local
1155
1156 tensor%blks_local = blks_local
1157
1158 tensor%nd_dist = dist_new%nd_dist
1159 tensor%pgrid = dist_new%pgrid
1160
1161 CALL dbt_distribution_hold(dist_new)
1162 tensor%refcount => dist_new%refcount
1163 CALL dbt_distribution_destroy(dist_new)
1164
1165 CALL array_offsets(tensor%blk_sizes, tensor%blk_offsets)
1166
1167 tensor%valid = .true.
1168 CALL timestop(handle)
1169 END SUBROUTINE
1170
1171! **************************************************************************************************
1172!> \brief reference counting for tensors
1173!> (only needed for communicator handle that must be freed when no longer needed)
1174!> \author Patrick Seewald
1175! **************************************************************************************************
1176 SUBROUTINE dbt_hold(tensor)
1177 TYPE(dbt_type), INTENT(IN) :: tensor
1178 INTEGER, POINTER :: ref
1179
1180 IF (tensor%refcount < 1) THEN
1181 cpabort("can not hold non-existing tensor")
1182 END IF
1183 ref => tensor%refcount
1184 ref = ref + 1
1185
1186 END SUBROUTINE
1187
1188! **************************************************************************************************
1189!> \brief how many tensor dimensions are mapped to matrix row
1190!> \author Patrick Seewald
1191! **************************************************************************************************
1192 PURE FUNCTION ndims_matrix_row(tensor)
1193 TYPE(dbt_type), INTENT(IN) :: tensor
1194 INTEGER(int_8) :: ndims_matrix_row
1195
1196 ndims_matrix_row = ndims_mapping_row(tensor%nd_index_blk)
1197
1198 END FUNCTION
1199
1200! **************************************************************************************************
1201!> \brief how many tensor dimensions are mapped to matrix column
1202!> \author Patrick Seewald
1203! **************************************************************************************************
1204 PURE FUNCTION ndims_matrix_column(tensor)
1205 TYPE(dbt_type), INTENT(IN) :: tensor
1206 INTEGER(int_8) :: ndims_matrix_column
1207
1208 ndims_matrix_column = ndims_mapping_column(tensor%nd_index_blk)
1209 END FUNCTION
1210
1211! **************************************************************************************************
1212!> \brief tensor rank
1213!> \author Patrick Seewald
1214! **************************************************************************************************
1215 PURE FUNCTION ndims_tensor(tensor)
1216 TYPE(dbt_type), INTENT(IN) :: tensor
1217 INTEGER :: ndims_tensor
1218
1219 ndims_tensor = tensor%nd_index%ndim_nd
1220 END FUNCTION
1221
1222! **************************************************************************************************
1223!> \brief tensor dimensions
1224!> \author Patrick Seewald
1225! **************************************************************************************************
1226 SUBROUTINE dims_tensor(tensor, dims)
1227 TYPE(dbt_type), INTENT(IN) :: tensor
1228 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1229 INTENT(OUT) :: dims
1230
1231 cpassert(tensor%valid)
1232 dims = tensor%nd_index%dims_nd
1233 END SUBROUTINE
1234
1235! **************************************************************************************************
1236!> \brief create a tensor from template
1237!> \author Patrick Seewald
1238! **************************************************************************************************
1239 SUBROUTINE dbt_create_template(tensor_in, tensor, name, dist, map1_2d, map2_2d)
1240 TYPE(dbt_type), INTENT(INOUT) :: tensor_in
1241 TYPE(dbt_type), INTENT(OUT) :: tensor
1242 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
1243 TYPE(dbt_distribution_type), &
1244 INTENT(INOUT), OPTIONAL :: dist
1245 INTEGER, DIMENSION(:), INTENT(IN), &
1246 OPTIONAL :: map1_2d, map2_2d
1247 INTEGER :: handle
1248 CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_create_template'
1249 INTEGER, DIMENSION(:), ALLOCATABLE :: bsize_1, bsize_2, bsize_3, bsize_4
1250 INTEGER, DIMENSION(:), ALLOCATABLE :: map1_2d_prv, map2_2d_prv
1251 CHARACTER(len=default_string_length) :: name_prv
1252 TYPE(dbt_distribution_type) :: dist_prv
1253
1254 CALL timeset(routinen, handle)
1255
1256 IF (PRESENT(dist) .OR. PRESENT(map1_2d) .OR. PRESENT(map2_2d)) THEN
1257 ! need to create matrix representation from scratch
1258 IF (PRESENT(dist)) THEN
1259 dist_prv = dist
1260 ELSE
1261 dist_prv = dbt_distribution(tensor_in)
1262 END IF
1263 IF (PRESENT(map1_2d) .AND. PRESENT(map2_2d)) THEN
1264 ALLOCATE (map1_2d_prv, source=map1_2d)
1265 ALLOCATE (map2_2d_prv, source=map2_2d)
1266 ELSE
1267 ALLOCATE (map1_2d_prv(ndims_matrix_row(tensor_in)))
1268 ALLOCATE (map2_2d_prv(ndims_matrix_column(tensor_in)))
1269 CALL dbt_get_mapping_info(tensor_in%nd_index_blk, map1_2d=map1_2d_prv, map2_2d=map2_2d_prv)
1270 END IF
1271 IF (PRESENT(name)) THEN
1272 name_prv = name
1273 ELSE
1274 name_prv = tensor_in%name
1275 END IF
1276
1277 IF (ndims_tensor(tensor_in) == 1) THEN
1278 CALL get_arrays(tensor_in%blk_sizes, bsize_1)
1279 CALL dbt_create(tensor, name_prv, dist_prv, map1_2d_prv, map2_2d_prv, &
1280 bsize_1)
1281 END IF
1282 IF (ndims_tensor(tensor_in) == 2) THEN
1283 CALL get_arrays(tensor_in%blk_sizes, bsize_1, bsize_2)
1284 CALL dbt_create(tensor, name_prv, dist_prv, map1_2d_prv, map2_2d_prv, &
1285 bsize_1, bsize_2)
1286 END IF
1287 IF (ndims_tensor(tensor_in) == 3) THEN
1288 CALL get_arrays(tensor_in%blk_sizes, bsize_1, bsize_2, bsize_3)
1289 CALL dbt_create(tensor, name_prv, dist_prv, map1_2d_prv, map2_2d_prv, &
1290 bsize_1, bsize_2, bsize_3)
1291 END IF
1292 IF (ndims_tensor(tensor_in) == 4) THEN
1293 CALL get_arrays(tensor_in%blk_sizes, bsize_1, bsize_2, bsize_3, bsize_4)
1294 CALL dbt_create(tensor, name_prv, dist_prv, map1_2d_prv, map2_2d_prv, &
1295 bsize_1, bsize_2, bsize_3, bsize_4)
1296 END IF
1297 ELSE
1298 ! create matrix representation from template
1299 ALLOCATE (tensor%matrix_rep)
1300 IF (.NOT. PRESENT(name)) THEN
1301 CALL dbt_tas_create(tensor_in%matrix_rep, tensor%matrix_rep, &
1302 name=trim(tensor_in%name)//" matrix")
1303 ELSE
1304 CALL dbt_tas_create(tensor_in%matrix_rep, tensor%matrix_rep, name=trim(name)//" matrix")
1305 END IF
1306 tensor%owns_matrix = .true.
1307 CALL dbt_tas_finalize(tensor%matrix_rep)
1308
1309 tensor%nd_index_blk = tensor_in%nd_index_blk
1310 tensor%nd_index = tensor_in%nd_index
1311 tensor%blk_sizes = tensor_in%blk_sizes
1312 tensor%blk_offsets = tensor_in%blk_offsets
1313 tensor%nd_dist = tensor_in%nd_dist
1314 tensor%blks_local = tensor_in%blks_local
1315 ALLOCATE (tensor%nblks_local(ndims_tensor(tensor_in)))
1316 tensor%nblks_local(:) = tensor_in%nblks_local
1317 ALLOCATE (tensor%nfull_local(ndims_tensor(tensor_in)))
1318 tensor%nfull_local(:) = tensor_in%nfull_local
1319 tensor%pgrid = tensor_in%pgrid
1320
1321 tensor%refcount => tensor_in%refcount
1322 CALL dbt_hold(tensor)
1323
1324 tensor%valid = .true.
1325 IF (PRESENT(name)) THEN
1326 tensor%name = name
1327 ELSE
1328 tensor%name = tensor_in%name
1329 END IF
1330 END IF
1331 CALL timestop(handle)
1332 END SUBROUTINE
1333
1334! **************************************************************************************************
1335!> \brief Create 2-rank tensor from matrix.
1336!> \author Patrick Seewald
1337! **************************************************************************************************
1338 SUBROUTINE dbt_create_matrix(matrix_in, tensor, order, name)
1339 TYPE(dbcsr_type), INTENT(IN) :: matrix_in
1340 TYPE(dbt_type), INTENT(OUT) :: tensor
1341 INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: order
1342 CHARACTER(len=*), INTENT(IN), OPTIONAL :: name
1343
1344 CHARACTER(len=default_string_length) :: name_in
1345 INTEGER, DIMENSION(2) :: order_in
1346 TYPE(mp_comm_type) :: comm_2d
1347 TYPE(dbcsr_distribution_type) :: matrix_dist
1348 TYPE(dbt_distribution_type) :: dist
1349 INTEGER, DIMENSION(:), POINTER :: row_blk_size, col_blk_size
1350 INTEGER, DIMENSION(:), POINTER :: col_dist, row_dist
1351 INTEGER :: handle, comm_2d_handle
1352 CHARACTER(LEN=*), PARAMETER :: routineN = 'dbt_create_matrix'
1353 TYPE(dbt_pgrid_type) :: comm_nd
1354 INTEGER, DIMENSION(2) :: pdims_2d
1355
1356 CALL timeset(routinen, handle)
1357
1358 NULLIFY (row_blk_size, col_blk_size, col_dist, row_dist)
1359 IF (PRESENT(name)) THEN
1360 name_in = name
1361 ELSE
1362 CALL dbcsr_get_info(matrix_in, name=name_in)
1363 END IF
1364
1365 IF (PRESENT(order)) THEN
1366 order_in = order
1367 ELSE
1368 order_in = [1, 2]
1369 END IF
1370
1371 CALL dbcsr_get_info(matrix_in, distribution=matrix_dist)
1372 CALL dbcsr_distribution_get(matrix_dist, group=comm_2d_handle, row_dist=row_dist, col_dist=col_dist, &
1373 nprows=pdims_2d(1), npcols=pdims_2d(2))
1374 CALL comm_2d%set_handle(comm_2d_handle)
1375 comm_nd = dbt_nd_mp_comm(comm_2d, [order_in(1)], [order_in(2)], pdims_2d=pdims_2d)
1376
1377 CALL dbt_distribution_new_expert( &
1378 dist, &
1379 comm_nd, &
1380 [order_in(1)], [order_in(2)], &
1381 row_dist, col_dist, own_comm=.true.)
1382
1383 CALL dbcsr_get_info(matrix_in, row_blk_size=row_blk_size, col_blk_size=col_blk_size)
1384
1385 CALL dbt_create_new(tensor, name_in, dist, &
1386 [order_in(1)], [order_in(2)], &
1387 row_blk_size, &
1388 col_blk_size)
1389
1390 CALL dbt_distribution_destroy(dist)
1391 CALL timestop(handle)
1392 END SUBROUTINE
1393
1394! **************************************************************************************************
1395!> \brief Destroy a tensor
1396!> \author Patrick Seewald
1397! **************************************************************************************************
1398 SUBROUTINE dbt_destroy(tensor)
1399 TYPE(dbt_type), INTENT(INOUT) :: tensor
1400 INTEGER :: handle
1401 CHARACTER(LEN=*), PARAMETER :: routinen = 'dbt_destroy'
1402 LOGICAL :: abort
1403
1404 CALL timeset(routinen, handle)
1405 IF (tensor%owns_matrix) THEN
1406 CALL dbt_tas_destroy(tensor%matrix_rep)
1407 DEALLOCATE (tensor%matrix_rep)
1408 ELSE
1409 NULLIFY (tensor%matrix_rep)
1410 END IF
1411 tensor%owns_matrix = .false.
1412
1413 CALL destroy_nd_to_2d_mapping(tensor%nd_index_blk)
1414 CALL destroy_nd_to_2d_mapping(tensor%nd_index)
1415 !CALL destroy_nd_to_2d_mapping(tensor%nd_index_grid)
1416 CALL destroy_array_list(tensor%blk_sizes)
1417 CALL destroy_array_list(tensor%blk_offsets)
1418 CALL destroy_array_list(tensor%nd_dist)
1419 CALL destroy_array_list(tensor%blks_local)
1420
1421 DEALLOCATE (tensor%nblks_local, tensor%nfull_local)
1422
1423 abort = .false.
1424 IF (.NOT. ASSOCIATED(tensor%refcount)) THEN
1425 abort = .true.
1426 ELSEIF (tensor%refcount < 1) THEN
1427 abort = .true.
1428 END IF
1429
1430 IF (abort) THEN
1431 cpabort("can not destroy non-existing tensor")
1432 END IF
1433
1434 tensor%refcount = tensor%refcount - 1
1435
1436 IF (tensor%refcount == 0) THEN
1437 CALL dbt_pgrid_destroy(tensor%pgrid)
1438 !CALL tensor%comm_2d%free()
1439 !CALL tensor%comm_nd%free()
1440 DEALLOCATE (tensor%refcount)
1441 ELSE
1442 CALL dbt_pgrid_destroy(tensor%pgrid, keep_comm=.true.)
1443 END IF
1444
1445 tensor%valid = .false.
1446 tensor%name = ""
1447 CALL timestop(handle)
1448 END SUBROUTINE
1449
1450! **************************************************************************************************
1451!> \brief tensor block dimensions
1452!> \author Patrick Seewald
1453! **************************************************************************************************
1454 SUBROUTINE blk_dims_tensor(tensor, dims)
1455 TYPE(dbt_type), INTENT(IN) :: tensor
1456 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1457 INTENT(OUT) :: dims
1458
1459 cpassert(tensor%valid)
1460 dims = tensor%nd_index_blk%dims_nd
1461 END SUBROUTINE
1462
1463! **************************************************************************************************
1464!> \brief Size of tensor block
1465!> \author Patrick Seewald
1466! **************************************************************************************************
1467 SUBROUTINE dbt_blk_sizes(tensor, ind, blk_size)
1468 TYPE(dbt_type), INTENT(IN) :: tensor
1469 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1470 INTENT(IN) :: ind
1471 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1472 INTENT(OUT) :: blk_size
1473
1474 blk_size(:) = get_array_elements(tensor%blk_sizes, ind)
1475 END SUBROUTINE
1476
1477! **************************************************************************************************
1478!> \brief offset of tensor block
1479!> \param ind block index
1480!> \param blk_offset block offset
1481!> \author Patrick Seewald
1482! **************************************************************************************************
1483 SUBROUTINE dbt_blk_offsets(tensor, ind, blk_offset)
1484 TYPE(dbt_type), INTENT(IN) :: tensor
1485 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1486 INTENT(IN) :: ind
1487 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1488 INTENT(OUT) :: blk_offset
1489
1490 cpassert(tensor%valid)
1491 blk_offset(:) = get_array_elements(tensor%blk_offsets, ind)
1492 END SUBROUTINE
1493
1494! **************************************************************************************************
1495!> \brief Generalization of block_get_stored_coordinates for tensors.
1496!> \author Patrick Seewald
1497! **************************************************************************************************
1498 SUBROUTINE dbt_get_stored_coordinates(tensor, ind_nd, processor)
1499 TYPE(dbt_type), INTENT(IN) :: tensor
1500 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1501 INTENT(IN) :: ind_nd
1502 INTEGER, INTENT(OUT) :: processor
1503
1504 INTEGER(KIND=int_8), DIMENSION(2) :: ind_2d
1505
1506 ind_2d(:) = get_2d_indices_tensor(tensor%nd_index_blk, ind_nd)
1507 CALL dbt_tas_get_stored_coordinates(tensor%matrix_rep, ind_2d(1), ind_2d(2), processor)
1508 END SUBROUTINE
1509
1510! **************************************************************************************************
1511!> \author Patrick Seewald
1512! **************************************************************************************************
1513 SUBROUTINE dbt_pgrid_create(mp_comm, dims, pgrid, tensor_dims)
1514 CLASS(mp_comm_type), INTENT(IN) :: mp_comm
1515 INTEGER, DIMENSION(:), INTENT(INOUT) :: dims
1516 TYPE(dbt_pgrid_type), INTENT(OUT) :: pgrid
1517 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: tensor_dims
1518 INTEGER, DIMENSION(:), ALLOCATABLE :: map1_2d, map2_2d
1519 INTEGER :: i, ndims
1520
1521 ndims = SIZE(dims)
1522
1523 ALLOCATE (map1_2d(ndims/2))
1524 ALLOCATE (map2_2d(ndims - ndims/2))
1525 map1_2d(:) = (/(i, i=1, SIZE(map1_2d))/)
1526 map2_2d(:) = (/(i, i=SIZE(map1_2d) + 1, SIZE(map1_2d) + SIZE(map2_2d))/)
1527
1528 CALL dbt_pgrid_create_expert(mp_comm, dims, pgrid, map1_2d, map2_2d, tensor_dims)
1529
1530 END SUBROUTINE
1531
1532! **************************************************************************************************
1533!> \brief freeze current split factor such that it is never changed during contraction
1534!> \author Patrick Seewald
1535! **************************************************************************************************
1536 SUBROUTINE dbt_pgrid_set_strict_split(pgrid)
1537 TYPE(dbt_pgrid_type), INTENT(INOUT) :: pgrid
1538 IF (ALLOCATED(pgrid%tas_split_info)) CALL dbt_tas_set_strict_split(pgrid%tas_split_info)
1539 END SUBROUTINE
1540
1541! **************************************************************************************************
1542!> \brief change dimensions of an existing process grid.
1543!> \param pgrid process grid to be changed
1544!> \param pdims new process grid dimensions, should all be set > 0
1545!> \author Patrick Seewald
1546! **************************************************************************************************
1547 SUBROUTINE dbt_pgrid_change_dims(pgrid, pdims)
1548 TYPE(dbt_pgrid_type), INTENT(INOUT) :: pgrid
1549 INTEGER, DIMENSION(:), INTENT(INOUT) :: pdims
1550 TYPE(dbt_pgrid_type) :: pgrid_tmp
1551 INTEGER :: nsplit, dimsplit
1552 INTEGER, DIMENSION(ndims_mapping_row(pgrid%nd_index_grid)) :: map1_2d
1553 INTEGER, DIMENSION(ndims_mapping_column(pgrid%nd_index_grid)) :: map2_2d
1554 TYPe(nd_to_2d_mapping) :: nd_index_grid
1555 INTEGER, DIMENSION(2) :: pdims_2d
1556
1557 cpassert(all(pdims > 0))
1558 CALL dbt_tas_get_split_info(pgrid%tas_split_info, nsplit=nsplit, split_rowcol=dimsplit)
1559 CALL dbt_get_mapping_info(pgrid%nd_index_grid, map1_2d=map1_2d, map2_2d=map2_2d)
1560 CALL create_nd_to_2d_mapping(nd_index_grid, pdims, map1_2d, map2_2d, base=0, col_major=.false.)
1561 CALL dbt_get_mapping_info(nd_index_grid, dims_2d=pdims_2d)
1562 IF (mod(pdims_2d(dimsplit), nsplit) == 0) THEN
1563 CALL dbt_pgrid_create_expert(pgrid%mp_comm_2d, pdims, pgrid_tmp, map1_2d=map1_2d, map2_2d=map2_2d, &
1564 nsplit=nsplit, dimsplit=dimsplit)
1565 ELSE
1566 CALL dbt_pgrid_create_expert(pgrid%mp_comm_2d, pdims, pgrid_tmp, map1_2d=map1_2d, map2_2d=map2_2d)
1567 END IF
1568 CALL dbt_pgrid_destroy(pgrid)
1569 pgrid = pgrid_tmp
1570 END SUBROUTINE
1571
1572! **************************************************************************************************
1573!> \brief As block_filter
1574!> \author Patrick Seewald
1575! **************************************************************************************************
1576 SUBROUTINE dbt_filter(tensor, eps)
1577 TYPE(dbt_type), INTENT(INOUT) :: tensor
1578 REAL(dp), INTENT(IN) :: eps
1579
1580 CALL dbt_tas_filter(tensor%matrix_rep, eps)
1581
1582 END SUBROUTINE
1583
1584! **************************************************************************************************
1585!> \brief local number of blocks along dimension idim
1586!> \author Patrick Seewald
1587! **************************************************************************************************
1588 PURE FUNCTION dbt_nblks_local(tensor, idim)
1589 TYPE(dbt_type), INTENT(IN) :: tensor
1590 INTEGER, INTENT(IN) :: idim
1591 INTEGER :: dbt_nblks_local
1592
1593 IF (idim > ndims_tensor(tensor)) THEN
1594 dbt_nblks_local = 0
1595 ELSE
1596 dbt_nblks_local = tensor%nblks_local(idim)
1597 END IF
1598
1599 END FUNCTION
1600
1601! **************************************************************************************************
1602!> \brief total numbers of blocks along dimension idim
1603!> \author Patrick Seewald
1604! **************************************************************************************************
1605 PURE FUNCTION dbt_nblks_total(tensor, idim)
1606 TYPE(dbt_type), INTENT(IN) :: tensor
1607 INTEGER, INTENT(IN) :: idim
1608 INTEGER :: dbt_nblks_total
1609
1610 IF (idim > ndims_tensor(tensor)) THEN
1611 dbt_nblks_total = 0
1612 ELSE
1613 dbt_nblks_total = tensor%nd_index_blk%dims_nd(idim)
1614 END IF
1615 END FUNCTION
1616
1617! **************************************************************************************************
1618!> \brief As block_get_info but for tensors
1619!> \param nblks_total number of blocks along each dimension
1620!> \param nfull_total number of elements along each dimension
1621!> \param nblks_local local number of blocks along each dimension
1622!> \param nfull_local local number of elements along each dimension
1623!> \param my_ploc process coordinates in process grid
1624!> \param pdims process grid dimensions
1625!> \param blks_local_4 local blocks along dimension 4
1626!> \param proc_dist_4 distribution along dimension 4
1627!> \param blk_size_4 block sizes along dimension 4
1628!> \param blk_offset_4 block offsets along dimension 4
1629!> \param distribution distribution object
1630!> \param name name of tensor
1631!> \author Patrick Seewald
1632! **************************************************************************************************
1633 SUBROUTINE dbt_get_info(tensor, nblks_total, &
1634 nfull_total, &
1635 nblks_local, &
1636 nfull_local, &
1637 pdims, &
1638 my_ploc, &
1639 blks_local_1, blks_local_2, blks_local_3, blks_local_4, &
1640 proc_dist_1, proc_dist_2, proc_dist_3, proc_dist_4, &
1641 blk_size_1, blk_size_2, blk_size_3, blk_size_4, &
1642 blk_offset_1, blk_offset_2, blk_offset_3, blk_offset_4, &
1643 distribution, &
1644 name)
1645 TYPE(dbt_type), INTENT(IN) :: tensor
1646 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: nblks_total
1647 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: nfull_total
1648 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: nblks_local
1649 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: nfull_local
1650 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: my_ploc
1651 INTEGER, INTENT(OUT), OPTIONAL, DIMENSION(ndims_tensor(tensor)) :: pdims
1652 INTEGER, DIMENSION(dbt_nblks_local(tensor, 1)), INTENT(OUT), OPTIONAL :: blks_local_1
1653 INTEGER, DIMENSION(dbt_nblks_total(tensor, 1)), INTENT(OUT), OPTIONAL :: proc_dist_1
1654 INTEGER, DIMENSION(dbt_nblks_total(tensor, 1)), INTENT(OUT), OPTIONAL :: blk_size_1
1655 INTEGER, DIMENSION(dbt_nblks_total(tensor, 1)), INTENT(OUT), OPTIONAL :: blk_offset_1
1656 INTEGER, DIMENSION(dbt_nblks_local(tensor, 2)), INTENT(OUT), OPTIONAL :: blks_local_2
1657 INTEGER, DIMENSION(dbt_nblks_total(tensor, 2)), INTENT(OUT), OPTIONAL :: proc_dist_2
1658 INTEGER, DIMENSION(dbt_nblks_total(tensor, 2)), INTENT(OUT), OPTIONAL :: blk_size_2
1659 INTEGER, DIMENSION(dbt_nblks_total(tensor, 2)), INTENT(OUT), OPTIONAL :: blk_offset_2
1660 INTEGER, DIMENSION(dbt_nblks_local(tensor, 3)), INTENT(OUT), OPTIONAL :: blks_local_3
1661 INTEGER, DIMENSION(dbt_nblks_total(tensor, 3)), INTENT(OUT), OPTIONAL :: proc_dist_3
1662 INTEGER, DIMENSION(dbt_nblks_total(tensor, 3)), INTENT(OUT), OPTIONAL :: blk_size_3
1663 INTEGER, DIMENSION(dbt_nblks_total(tensor, 3)), INTENT(OUT), OPTIONAL :: blk_offset_3
1664 INTEGER, DIMENSION(dbt_nblks_local(tensor, 4)), INTENT(OUT), OPTIONAL :: blks_local_4
1665 INTEGER, DIMENSION(dbt_nblks_total(tensor, 4)), INTENT(OUT), OPTIONAL :: proc_dist_4
1666 INTEGER, DIMENSION(dbt_nblks_total(tensor, 4)), INTENT(OUT), OPTIONAL :: blk_size_4
1667 INTEGER, DIMENSION(dbt_nblks_total(tensor, 4)), INTENT(OUT), OPTIONAL :: blk_offset_4
1668 TYPE(dbt_distribution_type), INTENT(OUT), OPTIONAL :: distribution
1669 CHARACTER(len=*), INTENT(OUT), OPTIONAL :: name
1670 INTEGER, DIMENSION(ndims_tensor(tensor)) :: pdims_tmp, my_ploc_tmp
1671
1672 IF (PRESENT(nblks_total)) CALL dbt_get_mapping_info(tensor%nd_index_blk, dims_nd=nblks_total)
1673 IF (PRESENT(nfull_total)) CALL dbt_get_mapping_info(tensor%nd_index, dims_nd=nfull_total)
1674 IF (PRESENT(nblks_local)) nblks_local(:) = tensor%nblks_local
1675 IF (PRESENT(nfull_local)) nfull_local(:) = tensor%nfull_local
1676
1677 IF (PRESENT(my_ploc) .OR. PRESENT(pdims)) CALL mp_environ_pgrid(tensor%pgrid, pdims_tmp, my_ploc_tmp)
1678 IF (PRESENT(my_ploc)) my_ploc = my_ploc_tmp
1679 IF (PRESENT(pdims)) pdims = pdims_tmp
1680
1681 IF (1 <= ndims_tensor(tensor)) THEN
1682 IF (PRESENT(blks_local_1)) CALL get_ith_array(tensor%blks_local, 1, &
1683 dbt_nblks_local(tensor, 1), &
1684 blks_local_1)
1685 IF (PRESENT(proc_dist_1)) CALL get_ith_array(tensor%nd_dist, 1, &
1686 dbt_nblks_total(tensor, 1), &
1687 proc_dist_1)
1688 IF (PRESENT(blk_size_1)) CALL get_ith_array(tensor%blk_sizes, 1, &
1689 dbt_nblks_total(tensor, 1), &
1690 blk_size_1)
1691 IF (PRESENT(blk_offset_1)) CALL get_ith_array(tensor%blk_offsets, 1, &
1692 dbt_nblks_total(tensor, 1), &
1693 blk_offset_1)
1694 END IF
1695 IF (2 <= ndims_tensor(tensor)) THEN
1696 IF (PRESENT(blks_local_2)) CALL get_ith_array(tensor%blks_local, 2, &
1697 dbt_nblks_local(tensor, 2), &
1698 blks_local_2)
1699 IF (PRESENT(proc_dist_2)) CALL get_ith_array(tensor%nd_dist, 2, &
1700 dbt_nblks_total(tensor, 2), &
1701 proc_dist_2)
1702 IF (PRESENT(blk_size_2)) CALL get_ith_array(tensor%blk_sizes, 2, &
1703 dbt_nblks_total(tensor, 2), &
1704 blk_size_2)
1705 IF (PRESENT(blk_offset_2)) CALL get_ith_array(tensor%blk_offsets, 2, &
1706 dbt_nblks_total(tensor, 2), &
1707 blk_offset_2)
1708 END IF
1709 IF (3 <= ndims_tensor(tensor)) THEN
1710 IF (PRESENT(blks_local_3)) CALL get_ith_array(tensor%blks_local, 3, &
1711 dbt_nblks_local(tensor, 3), &
1712 blks_local_3)
1713 IF (PRESENT(proc_dist_3)) CALL get_ith_array(tensor%nd_dist, 3, &
1714 dbt_nblks_total(tensor, 3), &
1715 proc_dist_3)
1716 IF (PRESENT(blk_size_3)) CALL get_ith_array(tensor%blk_sizes, 3, &
1717 dbt_nblks_total(tensor, 3), &
1718 blk_size_3)
1719 IF (PRESENT(blk_offset_3)) CALL get_ith_array(tensor%blk_offsets, 3, &
1720 dbt_nblks_total(tensor, 3), &
1721 blk_offset_3)
1722 END IF
1723 IF (4 <= ndims_tensor(tensor)) THEN
1724 IF (PRESENT(blks_local_4)) CALL get_ith_array(tensor%blks_local, 4, &
1725 dbt_nblks_local(tensor, 4), &
1726 blks_local_4)
1727 IF (PRESENT(proc_dist_4)) CALL get_ith_array(tensor%nd_dist, 4, &
1728 dbt_nblks_total(tensor, 4), &
1729 proc_dist_4)
1730 IF (PRESENT(blk_size_4)) CALL get_ith_array(tensor%blk_sizes, 4, &
1731 dbt_nblks_total(tensor, 4), &
1732 blk_size_4)
1733 IF (PRESENT(blk_offset_4)) CALL get_ith_array(tensor%blk_offsets, 4, &
1734 dbt_nblks_total(tensor, 4), &
1735 blk_offset_4)
1736 END IF
1737
1738 IF (PRESENT(distribution)) distribution = dbt_distribution(tensor)
1739 IF (PRESENT(name)) name = tensor%name
1740
1741 END SUBROUTINE
1742
1743! **************************************************************************************************
1744!> \brief As block_get_num_blocks: get number of local blocks
1745!> \author Patrick Seewald
1746! **************************************************************************************************
1747 PURE FUNCTION dbt_get_num_blocks(tensor) RESULT(num_blocks)
1748 TYPE(dbt_type), INTENT(IN) :: tensor
1749 INTEGER :: num_blocks
1750 num_blocks = dbt_tas_get_num_blocks(tensor%matrix_rep)
1751 END FUNCTION
1752
1753! **************************************************************************************************
1754!> \brief Get total number of blocks
1755!> \author Patrick Seewald
1756! **************************************************************************************************
1757 FUNCTION dbt_get_num_blocks_total(tensor) RESULT(num_blocks)
1758 TYPE(dbt_type), INTENT(IN) :: tensor
1759 INTEGER(KIND=int_8) :: num_blocks
1760 num_blocks = dbt_tas_get_num_blocks_total(tensor%matrix_rep)
1761 END FUNCTION
1762
1763! **************************************************************************************************
1764!> \brief Clear tensor (s.t. it does not contain any blocks)
1765!> \author Patrick Seewald
1766! **************************************************************************************************
1767 SUBROUTINE dbt_clear(tensor)
1768 TYPE(dbt_type), INTENT(INOUT) :: tensor
1769
1770 CALL dbt_tas_clear(tensor%matrix_rep)
1771 END SUBROUTINE
1772
1773! **************************************************************************************************
1774!> \brief Finalize tensor, as block_finalize. This should be taken care of internally in DBT
1775!> tensors, there should not be any need to call this routine outside of DBT tensors.
1776!> \author Patrick Seewald
1777! **************************************************************************************************
1778 SUBROUTINE dbt_finalize(tensor)
1779 TYPE(dbt_type), INTENT(INOUT) :: tensor
1780 CALL dbt_tas_finalize(tensor%matrix_rep)
1781 END SUBROUTINE
1782
1783! **************************************************************************************************
1784!> \brief as block_scale
1785!> \author Patrick Seewald
1786! **************************************************************************************************
1787 SUBROUTINE dbt_scale(tensor, alpha)
1788 TYPE(dbt_type), INTENT(INOUT) :: tensor
1789 REAL(dp), INTENT(IN) :: alpha
1790 CALL dbm_scale(tensor%matrix_rep%matrix, alpha)
1791 END SUBROUTINE
1792
1793! **************************************************************************************************
1794!> \author Patrick Seewald
1795! **************************************************************************************************
1796 PURE FUNCTION dbt_get_nze(tensor)
1797 TYPE(dbt_type), INTENT(IN) :: tensor
1798 INTEGER :: dbt_get_nze
1799 dbt_get_nze = dbt_tas_get_nze(tensor%matrix_rep)
1800 END FUNCTION
1801
1802! **************************************************************************************************
1803!> \author Patrick Seewald
1804! **************************************************************************************************
1805 FUNCTION dbt_get_nze_total(tensor)
1806 TYPE(dbt_type), INTENT(IN) :: tensor
1807 INTEGER(KIND=int_8) :: dbt_get_nze_total
1808 dbt_get_nze_total = dbt_tas_get_nze_total(tensor%matrix_rep)
1809 END FUNCTION
1810
1811! **************************************************************************************************
1812!> \brief block size of block with index ind along dimension idim
1813!> \author Patrick Seewald
1814! **************************************************************************************************
1815 PURE FUNCTION dbt_blk_size(tensor, ind, idim)
1816 TYPE(dbt_type), INTENT(IN) :: tensor
1817 INTEGER, DIMENSION(ndims_tensor(tensor)), &
1818 INTENT(IN) :: ind
1819 INTEGER, INTENT(IN) :: idim
1820 INTEGER, DIMENSION(ndims_tensor(tensor)) :: blk_size
1821 INTEGER :: dbt_blk_size
1822
1823 IF (idim > ndims_tensor(tensor)) THEN
1824 dbt_blk_size = 0
1825 ELSE
1826 blk_size(:) = get_array_elements(tensor%blk_sizes, ind)
1827 dbt_blk_size = blk_size(idim)
1828 END IF
1829 END FUNCTION
1830
1831! **************************************************************************************************
1832!> \brief returns an estimate of maximum number of local blocks in tensor
1833!> (irrespective of the actual number of currently present blocks)
1834!> this estimate is based on the following assumption: tensor data is dense and
1835!> load balancing is within a factor of 2
1836!> \author Patrick Seewald
1837! **************************************************************************************************
1838 PURE FUNCTION dbt_max_nblks_local(tensor) RESULT(blk_count)
1839 TYPE(dbt_type), INTENT(IN) :: tensor
1840 INTEGER :: blk_count, nproc
1841 INTEGER, DIMENSION(ndims_tensor(tensor)) :: bdims
1842 INTEGER(int_8) :: blk_count_total
1843 INTEGER, PARAMETER :: max_load_imbalance = 2
1844
1845 CALL dbt_get_mapping_info(tensor%nd_index_blk, dims_nd=bdims)
1846
1847 blk_count_total = product(int(bdims, int_8))
1848
1849 ! can not call an MPI routine due to PURE
1850 nproc = tensor%pgrid%nproc
1851
1852 blk_count = int(blk_count_total/nproc*max_load_imbalance)
1853
1854 END FUNCTION
1855
1856! **************************************************************************************************
1857!> \brief get a load-balanced and randomized distribution along one tensor dimension
1858!> \param nblk number of blocks (along one tensor dimension)
1859!> \param nproc number of processes (along one process grid dimension)
1860!> \param blk_size block sizes
1861!> \param dist distribution
1862!> \author Patrick Seewald
1863! **************************************************************************************************
1864 SUBROUTINE dbt_default_distvec(nblk, nproc, blk_size, dist)
1865 INTEGER, INTENT(IN) :: nblk
1866 INTEGER, INTENT(IN) :: nproc
1867 INTEGER, DIMENSION(nblk), INTENT(IN) :: blk_size
1868 INTEGER, DIMENSION(nblk), INTENT(OUT) :: dist
1869
1870 CALL dbt_tas_default_distvec(nblk, nproc, blk_size, dist)
1871 END SUBROUTINE
1872
1873! **************************************************************************************************
1874!> \author Patrick Seewald
1875! **************************************************************************************************
1876 SUBROUTINE dbt_copy_contraction_storage(tensor_in, tensor_out)
1877 TYPE(dbt_type), INTENT(IN) :: tensor_in
1878 TYPE(dbt_type), INTENT(INOUT) :: tensor_out
1879 TYPE(dbt_contraction_storage), ALLOCATABLE :: tensor_storage_tmp
1880 TYPE(dbt_tas_mm_storage), ALLOCATABLE :: tas_storage_tmp
1881
1882 IF (tensor_in%matrix_rep%do_batched > 0) THEN
1883 ALLOCATE (tas_storage_tmp, source=tensor_in%matrix_rep%mm_storage)
1884 ! transfer data for batched contraction
1885 IF (ALLOCATED(tensor_out%matrix_rep%mm_storage)) DEALLOCATE (tensor_out%matrix_rep%mm_storage)
1886 CALL move_alloc(tas_storage_tmp, tensor_out%matrix_rep%mm_storage)
1887 END IF
1888 CALL dbt_tas_set_batched_state(tensor_out%matrix_rep, state=tensor_in%matrix_rep%do_batched, &
1889 opt_grid=tensor_in%matrix_rep%has_opt_pgrid)
1890 IF (ALLOCATED(tensor_in%contraction_storage)) THEN
1891 ALLOCATE (tensor_storage_tmp, source=tensor_in%contraction_storage)
1892 END IF
1893 IF (ALLOCATED(tensor_out%contraction_storage)) DEALLOCATE (tensor_out%contraction_storage)
1894 IF (ALLOCATED(tensor_storage_tmp)) CALL move_alloc(tensor_storage_tmp, tensor_out%contraction_storage)
1895
1896 END SUBROUTINE
1897
1898 END MODULE
tensor
struct tensor_ tensor
dbt_allocate_wrap::allocate_any
Definition dbt_allocate_wrap.F:26
dbt_array_list_methods::get_ith_array
Definition dbt_array_list_methods.F:58
dbt_tas_base::dbt_tas_create
Definition dbt_tas_base.F:89
dbt_types::dbt_create
Definition dbt_types.F:166
cp_dbcsr_api
Definition cp_dbcsr_api.F:8
cp_dbcsr_api::dbcsr_get_info
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
Definition cp_dbcsr_api.F:794
cp_dbcsr_api::dbcsr_distribution_get
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
Definition cp_dbcsr_api.F:564
dbm_api
Definition dbm_api.F:8
dbm_api::dbm_scale
subroutine, public dbm_scale(matrix, alpha)
Multiplies all entries in the given matrix by the given factor alpha.
Definition dbm_api.F:631
dbt_allocate_wrap
Wrapper for allocating, copying and reshaping arrays.
Definition dbt_allocate_wrap.F:15
dbt_array_list_methods
Representation of arbitrary number of 1d integer arrays with arbitrary sizes. This is needed for gene...
Definition dbt_array_list_methods.F:14
dbt_array_list_methods::sum_of_arrays
integer function, dimension(:), allocatable, public sum_of_arrays(list)
sum of all elements for each array stored in list
Definition dbt_array_list_methods.F:300
dbt_array_list_methods::get_arrays
subroutine, public get_arrays(list, data_1, data_2, data_3, data_4, i_selected)
Get all arrays contained in list.
Definition dbt_array_list_methods.F:208
dbt_array_list_methods::create_array_list
subroutine, public create_array_list(list, ndata, data_1, data_2, data_3, data_4)
collects any number of arrays of different sizes into a single array (listcol_data),...
Definition dbt_array_list_methods.F:105
dbt_array_list_methods::destroy_array_list
subroutine, public destroy_array_list(list)
destroy array list.
Definition dbt_array_list_methods.F:196
dbt_array_list_methods::sizes_of_arrays
integer function, dimension(:), allocatable, public sizes_of_arrays(list)
sizes of arrays stored in list
Definition dbt_array_list_methods.F:283
dbt_array_list_methods::array_offsets
subroutine, public array_offsets(list_in, list_out)
partial sums of array elements.
Definition dbt_array_list_methods.F:318
dbt_array_list_methods::get_array_elements
pure integer function, dimension(number_of_arrays(list)), public get_array_elements(list, indices)
Get an element for each array.
Definition dbt_array_list_methods.F:83
dbt_array_list_methods::array_sublist
type(array_list) function, public array_sublist(list, i_selected)
extract a subset of arrays
Definition dbt_array_list_methods.F:165
dbt_index
tensor index and mapping to DBM index
Definition dbt_index.F:12
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::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::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::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
dbt_tas_base
Tall-and-skinny matrices: base routines similar to DBM API, mostly wrappers around existing DBM routi...
Definition dbt_tas_base.F:13
dbt_tas_base::dbt_tas_get_nze_total
integer(kind=int_8) function, public dbt_tas_get_nze_total(matrix)
Get total number of non-zero elements.
Definition dbt_tas_base.F:961
dbt_tas_base::dbt_tas_distribution_destroy
subroutine, public dbt_tas_distribution_destroy(dist)
...
Definition dbt_tas_base.F:433
dbt_tas_base::dbt_tas_get_stored_coordinates
subroutine, public dbt_tas_get_stored_coordinates(matrix, row, column, processor)
As dbt_get_stored_coordinates.
Definition dbt_tas_base.F:462
dbt_tas_base::dbt_tas_get_nze
pure integer function, public dbt_tas_get_nze(matrix)
As dbt_get_nze: get number of local non-zero elements.
Definition dbt_tas_base.F:947
dbt_tas_base::dbt_tas_get_info
subroutine, public dbt_tas_get_info(matrix, nblkrows_total, nblkcols_total, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, distribution, name)
...
Definition dbt_tas_base.F:1002
dbt_tas_base::dbt_tas_finalize
subroutine, public dbt_tas_finalize(matrix)
...
Definition dbt_tas_base.F:327
dbt_tas_base::dbt_tas_distribution_new
subroutine, public dbt_tas_distribution_new(dist, mp_comm, row_dist, col_dist, split_info, nosplit)
create new distribution. Exactly like dbm_distribution_new but with custom types for row_dist and col...
Definition dbt_tas_base.F:346
dbt_tas_base::dbt_tas_filter
subroutine, public dbt_tas_filter(matrix, eps)
As dbm_filter.
Definition dbt_tas_base.F:1131
dbt_tas_base::dbt_tas_clear
subroutine, public dbt_tas_clear(matrix)
Clear matrix (erase all data)
Definition dbt_tas_base.F:977
dbt_tas_base::dbt_tas_destroy
subroutine, public dbt_tas_destroy(matrix)
...
Definition dbt_tas_base.F:233
dbt_tas_base::dbt_tas_get_num_blocks_total
integer(kind=int_8) function, public dbt_tas_get_num_blocks_total(matrix)
get total number of blocks
Definition dbt_tas_base.F:929
dbt_tas_base::dbt_tas_get_num_blocks
pure integer function, public dbt_tas_get_num_blocks(matrix)
As dbt_get_num_blocks: get number of local blocks.
Definition dbt_tas_base.F:916
dbt_tas_global
Global data (distribution and block sizes) for tall-and-skinny matrices For very sparse matrices with...
Definition dbt_tas_global.F:17
dbt_tas_global::dbt_tas_default_distvec
subroutine, public dbt_tas_default_distvec(nblk, nproc, blk_size, dist)
get a load-balanced and randomized distribution along one tensor dimension
Definition dbt_tas_global.F:485
dbt_tas_mm
Matrix multiplication for tall-and-skinny matrices. This uses the k-split (non-recursive) CARMA algor...
Definition dbt_tas_mm.F:18
dbt_tas_mm::dbt_tas_set_batched_state
subroutine, public dbt_tas_set_batched_state(matrix, state, opt_grid)
set state flags during batched multiplication
Definition dbt_tas_mm.F:1699
dbt_tas_split
methods to split tall-and-skinny matrices along longest dimension. Basically, we are splitting proces...
Definition dbt_tas_split.F:13
dbt_tas_split::dbt_tas_release_info
subroutine, public dbt_tas_release_info(split_info)
...
Definition dbt_tas_split.F:457
dbt_tas_split::dbt_tas_get_split_info
subroutine, public dbt_tas_get_split_info(info, mp_comm, nsplit, igroup, mp_comm_group, split_rowcol, pgrid_offset)
Get info on split.
Definition dbt_tas_split.F:427
dbt_tas_split::dbt_tas_create_split
subroutine, public dbt_tas_create_split(split_info, mp_comm, split_rowcol, nsplit, own_comm, opt_nsplit)
Split Cartesian process grid using a default split heuristic.
Definition dbt_tas_split.F:333
dbt_tas_split::dbt_tas_create_split_rows_or_cols
subroutine, public dbt_tas_create_split_rows_or_cols(split_info, mp_comm, ngroup, igroup, split_rowcol, own_comm)
split mpi grid by rows or columns
Definition dbt_tas_split.F:72
dbt_tas_split::dbt_tas_info_hold
subroutine, public dbt_tas_info_hold(split_info)
...
Definition dbt_tas_split.F:492
dbt_tas_split::dbt_tas_set_strict_split
subroutine, public dbt_tas_set_strict_split(info)
freeze current split factor such that it is never changed during multiplication
Definition dbt_tas_split.F:713
dbt_tas_types
DBT tall-and-skinny base types. Mostly wrappers around existing DBM routines.
Definition dbt_tas_types.F:13
dbt_types
DBT tensor framework for block-sparse tensor contraction: Types and create/destroy routines.
Definition dbt_types.F:12
dbt_types::dbt_pgrid_destroy
subroutine, public dbt_pgrid_destroy(pgrid, keep_comm)
destroy process grid
Definition dbt_types.F:894
dbt_types::dbt_distribution_new
subroutine, public dbt_distribution_new(dist, pgrid, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4)
Create a tensor distribution.
Definition dbt_types.F:875
dbt_types::blk_dims_tensor
subroutine, public blk_dims_tensor(tensor, dims)
tensor block dimensions
Definition dbt_types.F:1455
dbt_types::dims_tensor
subroutine, public dims_tensor(tensor, dims)
tensor dimensions
Definition dbt_types.F:1227
dbt_types::dbt_copy_contraction_storage
subroutine, public dbt_copy_contraction_storage(tensor_in, tensor_out)
Definition dbt_types.F:1877
dbt_types::dbt_nd_mp_comm
type(dbt_pgrid_type) function, public dbt_nd_mp_comm(comm_2d, map1_2d, map2_2d, dims_nd, dims1_nd, dims2_nd, pdims_2d, tdims, nsplit, dimsplit)
Create a default nd process topology that is consistent with a given 2d topology. Purpose: a nd tenso...
Definition dbt_types.F:653
dbt_types::dbt_blk_sizes
subroutine, public dbt_blk_sizes(tensor, ind, blk_size)
Size of tensor block.
Definition dbt_types.F:1468
dbt_types::dbt_destroy
subroutine, public dbt_destroy(tensor)
Destroy a tensor.
Definition dbt_types.F:1399
dbt_types::dbt_max_nblks_local
pure integer function, public dbt_max_nblks_local(tensor)
returns an estimate of maximum number of local blocks in tensor (irrespective of the actual number of...
Definition dbt_types.F:1839
dbt_types::dbt_mp_dims_create
recursive subroutine, public dbt_mp_dims_create(nodes, dims, tensor_dims, lb_ratio)
Create process grid dimensions corresponding to one dimension of the matrix representation of a tenso...
Definition dbt_types.F:498
dbt_types::dbt_get_info
subroutine, public dbt_get_info(tensor, nblks_total, nfull_total, nblks_local, nfull_local, pdims, my_ploc, blks_local_1, blks_local_2, blks_local_3, blks_local_4, proc_dist_1, proc_dist_2, proc_dist_3, proc_dist_4, blk_size_1, blk_size_2, blk_size_3, blk_size_4, blk_offset_1, blk_offset_2, blk_offset_3, blk_offset_4, distribution, name)
As block_get_info but for tensors.
Definition dbt_types.F:1645
dbt_types::dbt_distribution_new_expert
subroutine, public dbt_distribution_new_expert(dist, pgrid, map1_2d, map2_2d, nd_dist_1, nd_dist_2, nd_dist_3, nd_dist_4, own_comm)
Create a tensor distribution.
Definition dbt_types.F:787
dbt_types::dbt_distribution
type(dbt_distribution_type) function, public dbt_distribution(tensor)
get distribution from tensor
Definition dbt_types.F:969
dbt_types::ndims_tensor
pure integer function, public ndims_tensor(tensor)
tensor rank
Definition dbt_types.F:1216
dbt_types::dbt_pgrid_set_strict_split
subroutine, public dbt_pgrid_set_strict_split(pgrid)
freeze current split factor such that it is never changed during contraction
Definition dbt_types.F:1537
dbt_types::dbt_nblks_total
pure integer function, public dbt_nblks_total(tensor, idim)
total numbers of blocks along dimension idim
Definition dbt_types.F:1606
dbt_types::dbt_blk_size
pure integer function, public dbt_blk_size(tensor, ind, idim)
block size of block with index ind along dimension idim
Definition dbt_types.F:1816
dbt_types::dbt_get_num_blocks
pure integer function, public dbt_get_num_blocks(tensor)
As block_get_num_blocks: get number of local blocks.
Definition dbt_types.F:1748
dbt_types::dbt_default_distvec
subroutine, public dbt_default_distvec(nblk, nproc, blk_size, dist)
get a load-balanced and randomized distribution along one tensor dimension
Definition dbt_types.F:1865
dbt_types::dbt_hold
subroutine, public dbt_hold(tensor)
reference counting for tensors (only needed for communicator handle that must be freed when no longer...
Definition dbt_types.F:1177
dbt_types::dbt_pgrid_create_expert
subroutine, public dbt_pgrid_create_expert(mp_comm, dims, pgrid, map1_2d, map2_2d, tensor_dims, nsplit, dimsplit)
Create an n-dimensional process grid. We can not use a n-dimensional MPI cartesian grid for tensors s...
Definition dbt_types.F:594
dbt_types::dbt_clear
subroutine, public dbt_clear(tensor)
Clear tensor (s.t. it does not contain any blocks)
Definition dbt_types.F:1768
dbt_types::dbt_finalize
subroutine, public dbt_finalize(tensor)
Finalize tensor, as block_finalize. This should be taken care of internally in DBT tensors,...
Definition dbt_types.F:1779
dbt_types::dbt_get_nze_total
integer(kind=int_8) function, public dbt_get_nze_total(tensor)
Definition dbt_types.F:1806
dbt_types::dbt_nblks_local
pure integer function, public dbt_nblks_local(tensor, idim)
local number of blocks along dimension idim
Definition dbt_types.F:1589
dbt_types::mp_environ_pgrid
subroutine, public mp_environ_pgrid(pgrid, dims, task_coor)
as mp_environ but for special pgrid type
Definition dbt_types.F:768
dbt_types::dbt_get_stored_coordinates
subroutine, public dbt_get_stored_coordinates(tensor, ind_nd, processor)
Generalization of block_get_stored_coordinates for tensors.
Definition dbt_types.F:1499
dbt_types::dbt_get_nze
pure integer function, public dbt_get_nze(tensor)
Definition dbt_types.F:1797
dbt_types::dbt_pgrid_create
subroutine, public dbt_pgrid_create(mp_comm, dims, pgrid, tensor_dims)
Definition dbt_types.F:1514
dbt_types::dbt_get_num_blocks_total
integer(kind=int_8) function, public dbt_get_num_blocks_total(tensor)
Get total number of blocks.
Definition dbt_types.F:1758
dbt_types::ndims_matrix_row
pure integer(int_8) function, public ndims_matrix_row(tensor)
how many tensor dimensions are mapped to matrix row
Definition dbt_types.F:1193
dbt_types::dbt_pgrid_change_dims
subroutine, public dbt_pgrid_change_dims(pgrid, pdims)
change dimensions of an existing process grid.
Definition dbt_types.F:1548
dbt_types::ndims_matrix_column
pure integer(int_8) function, public ndims_matrix_column(tensor)
how many tensor dimensions are mapped to matrix column
Definition dbt_types.F:1205
dbt_types::dbt_nd_mp_free
subroutine, public dbt_nd_mp_free(mp_comm)
Release the MPI communicator.
Definition dbt_types.F:733
dbt_types::dbt_blk_offsets
subroutine, public dbt_blk_offsets(tensor, ind, blk_offset)
offset of tensor block
Definition dbt_types.F:1484
dbt_types::dbt_filter
subroutine, public dbt_filter(tensor, eps)
As block_filter.
Definition dbt_types.F:1577
dbt_types::dbt_distribution_destroy
subroutine, public dbt_distribution_destroy(dist)
Destroy tensor distribution.
Definition dbt_types.F:915
dbt_types::dbt_scale
subroutine, public dbt_scale(tensor, alpha)
as block_scale
Definition dbt_types.F:1788
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::int_8
integer, parameter, public int_8
Definition kinds.F:54
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
kinds::default_string_length
integer, parameter, public default_string_length
Definition kinds.F:57
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_dims_create
subroutine, public mp_dims_create(nodes, dims)
wrapper to MPI_Dims_create
Definition message_passing.F:2132
util
All kind of helpful little routines.
Definition util.F:14
cp_dbcsr_api::dbcsr_distribution_type
Definition cp_dbcsr_api.F:180
cp_dbcsr_api::dbcsr_type
Definition cp_dbcsr_api.F:174
dbm_api::dbm_distribution_obj
Definition dbm_api.F:122
dbm_api::dbm_type
Definition dbm_api.F:130
dbt_array_list_methods::array_list
Definition dbt_array_list_methods.F:53
dbt_index::nd_to_2d_mapping
Definition dbt_index.F:41
dbt_tas_global::dbt_tas_distribution
Definition dbt_tas_global.F:47
dbt_tas_global::dbt_tas_rowcol_data
Definition dbt_tas_global.F:100
dbt_tas_types::dbt_tas_distribution_type
Definition dbt_tas_types.F:66
dbt_tas_types::dbt_tas_mm_storage
Definition dbt_tas_types.F:81
dbt_tas_types::dbt_tas_split_info
Definition dbt_tas_types.F:52
dbt_tas_types::dbt_tas_type
Definition dbt_tas_types.F:102
dbt_types::dbt_contraction_storage
Definition dbt_types.F:103
dbt_types::dbt_distribution_type
Definition dbt_types.F:129
dbt_types::dbt_pgrid_type
Definition dbt_types.F:96
dbt_types::dbt_type
Definition dbt_types.F:110
message_passing::mp_cart_type
Definition message_passing.F:740
message_passing::mp_comm_type
Definition message_passing.F:189