(git:0e87843)
Loading...
Searching...
No Matches
cp_dbcsr_redistribution.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Redistribution of DBCSR blocks and distributed matrix slices.
10! **************************************************************************************************
15 USE cp_dbcsr_api, ONLY: &
20 dbcsr_type_no_symmetry
27 USE cp_fm_types, ONLY: cp_fm_create,&
31 USE kinds, ONLY: dp
36#include "./base/base_uses.f90"
37
38 IMPLICIT NONE
39 PRIVATE
40 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_dbcsr_redistribution'
42
43CONTAINS
44
45! **************************************************************************************************
46!> \brief ...
47!> \param mat_global ...
48!> \param mat_local ...
49!> \param para_env ...
50!> \param num_pe_sub ...
51!> \param block_row_ranges ...
52! **************************************************************************************************
53 SUBROUTINE cp_dbcsr_to_subgroups(mat_global, mat_local, para_env, num_pe_sub, block_row_ranges)
54 TYPE(dbcsr_type) :: mat_global, mat_local
55 TYPE(mp_para_env_type), INTENT(IN) :: para_env
56 INTEGER :: num_pe_sub
57 INTEGER, DIMENSION(:, :), OPTIONAL :: block_row_ranges
58
59 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_dbcsr_to_subgroups'
60
61 INTEGER :: block_offset, block_size, col, col_size, handle, handle2, i_block, igroup, imep, &
62 imep_sub, msg_offset, ngroup, offset, row, row_size
63 INTEGER, ALLOCATABLE :: counts_rec(:, :), counts_send(:, :)
64 INTEGER, ALLOCATABLE, DIMENSION(:) :: blk_counter, entry_counter
65 LOGICAL :: found
66 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
67 TYPE(dbcsr_iterator_type) :: iter
68 TYPE(matrix_buffer_type) :: buffer_rec, buffer_send
69
70 CALL timeset(routinen, handle)
71
72 CALL timeset(routinen//"_count", handle2)
73
74 NULLIFY (data_block)
75
76 ALLOCATE (counts_send(2, 0:para_env%num_pe - 1), counts_rec(2, 0:para_env%num_pe - 1))
77 counts_send = 0
78
79 ngroup = para_env%num_pe/num_pe_sub
80
81 CALL dbcsr_iterator_start(iter, mat_global)
82 DO WHILE (dbcsr_iterator_blocks_left(iter))
83
84 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
85 row_size=row_size, col_size=col_size)
86
87 CALL dbcsr_get_stored_coordinates(mat_local, row, col, imep_sub)
88
89 DO igroup = 0, ngroup - 1
90
91 IF (PRESENT(block_row_ranges)) THEN
92 IF (row < block_row_ranges(1, igroup + 1) .OR. row > block_row_ranges(2, igroup + 1)) cycle
93 END IF
94 imep = imep_sub + igroup*num_pe_sub
95
96 counts_send(1, imep) = counts_send(1, imep) + row_size*col_size
97 counts_send(2, imep) = counts_send(2, imep) + 1
98
99 END DO
100
101 END DO
102
103 CALL dbcsr_iterator_stop(iter)
104
105 CALL timestop(handle2)
106
107 CALL timeset(routinen//"_exchange_counts", handle2)
108
109 IF (para_env%num_pe > 1) THEN
110 CALL para_env%alltoall(counts_send, counts_rec, 2)
111 ELSE
112 counts_rec(:, :) = counts_send
113 END IF
114
115 CALL timestop(handle2)
116
117 CALL timeset(routinen//"_pack", handle2)
118
119 CALL allocate_matrix_buffers(counts_send(1, :), counts_rec(1, :), 3, buffer_send, buffer_rec, &
120 counts_send(2, :), counts_rec(2, :))
121
122 ALLOCATE (entry_counter(0:para_env%num_pe - 1))
123 entry_counter(:) = buffer_send%msg_offset(:para_env%num_pe - 1)
124
125 ALLOCATE (blk_counter(0:para_env%num_pe - 1))
126 blk_counter(:) = buffer_send%indx_offset(:para_env%num_pe - 1)
127
128 CALL dbcsr_iterator_start(iter, mat_global)
129 DO WHILE (dbcsr_iterator_blocks_left(iter))
130
131 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
132 row_size=row_size, col_size=col_size)
133
134 CALL dbcsr_get_stored_coordinates(mat_local, row, col, imep_sub)
135
136 DO igroup = 0, ngroup - 1
137
138 IF (PRESENT(block_row_ranges)) THEN
139 IF (row < block_row_ranges(1, igroup + 1) .OR. row > block_row_ranges(2, igroup + 1)) cycle
140 END IF
141
142 imep = imep_sub + igroup*num_pe_sub
143
144 msg_offset = entry_counter(imep)
145
146 block_size = row_size*col_size
147
148 buffer_send%msg(msg_offset + 1:msg_offset + block_size) = &
149 reshape(data_block(1:row_size, 1:col_size), [block_size])
150
151 entry_counter(imep) = entry_counter(imep) + block_size
152
153 blk_counter(imep) = blk_counter(imep) + 1
154
155 block_offset = blk_counter(imep)
156
157 ! The payload offset in each record is relative to its peer's segment.
158 buffer_send%indx(:, block_offset) = [row, col, msg_offset - buffer_send%msg_offset(imep)]
159
160 END DO
161
162 END DO
163
164 CALL dbcsr_iterator_stop(iter)
165
166 CALL timestop(handle2)
167
168 CALL timeset(routinen//"_exchange_data", handle2)
169
170 CALL exchange_matrix_buffers(para_env, buffer_rec, buffer_send)
171
172 CALL timestop(handle2)
173
174 CALL timeset(routinen//"_reserve", handle2)
175
176 CALL dbcsr_set(mat_local, 0.0_dp)
177 CALL dbcsr_filter(mat_local, 1.0_dp)
178 CALL dbcsr_reserve_blocks(mat_local, rows=buffer_rec%indx(1, :), cols=buffer_rec%indx(2, :))
179 CALL dbcsr_finalize(mat_local)
180 CALL dbcsr_set(mat_local, 0.0_dp)
181
182 CALL timestop(handle2)
183
184 CALL timeset(routinen//"_unpack", handle2)
185
186 DO imep = 0, para_env%num_pe - 1
187 DO i_block = buffer_rec%indx_offset(imep) + 1, buffer_rec%indx_offset(imep + 1)
188 row = buffer_rec%indx(1, i_block)
189 col = buffer_rec%indx(2, i_block)
190 offset = buffer_rec%msg_offset(imep) + buffer_rec%indx(3, i_block)
191 CALL dbcsr_get_block_p(mat_local, row, col, data_block, found=found, &
192 row_size=row_size, col_size=col_size)
193 cpassert(found)
194 data_block(:, :) = reshape(buffer_rec%msg(offset + 1:offset + row_size*col_size), &
195 [row_size, col_size])
196 END DO
197 END DO
198
199 CALL timestop(handle2)
200
201 CALL timestop(handle)
202
203 END SUBROUTINE cp_dbcsr_to_subgroups
204
205! **************************************************************************************************
206!> \brief Sum subgroup blocks into the global layout, or copy mapped blocks.
207!> \param mat_local ...
208!> \param mat_global ...
209!> \param para_env communicator covering all source and destination ranks
210!> \param row_mapping optional source-to-destination block-row permutation
211!> \param copy_only copy without summation, filtering, or consuming the source (default: false)
212! **************************************************************************************************
213 SUBROUTINE cp_dbcsr_from_subgroups(mat_local, mat_global, para_env, row_mapping, copy_only)
214
215 TYPE(dbcsr_type) :: mat_local, mat_global
216 TYPE(mp_para_env_type), INTENT(IN) :: para_env
217 INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: row_mapping
218 LOGICAL, INTENT(IN), OPTIONAL :: copy_only
219
220 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_dbcsr_from_subgroups'
221
222 INTEGER :: block_size, col, col_size, handle, &
223 handle2, i_block, imep, mapped_row, &
224 offset, row, row_size
225 INTEGER, ALLOCATABLE :: counts_rec(:, :), counts_send(:, :)
226 INTEGER, ALLOCATABLE, DIMENSION(:) :: block_counter, entry_counter
227 LOGICAL :: found, my_copy_only
228 REAL(kind=dp), DIMENSION(:, :), POINTER :: data_block
229 TYPE(dbcsr_iterator_type) :: iter
230 TYPE(matrix_buffer_type) :: buffer_rec, buffer_send
231
232 CALL timeset(routinen, handle)
233 my_copy_only = .false.
234 IF (PRESENT(copy_only)) my_copy_only = copy_only
235
236 CALL timeset(routinen//"_prepare", handle2)
237
238 IF (.NOT. my_copy_only) THEN
239 CALL dbcsr_clear(mat_global)
240 CALL dbcsr_reserve_all_blocks(mat_global)
241 END IF
242
243 ALLOCATE (counts_send(2, 0:para_env%num_pe - 1), counts_rec(2, 0:para_env%num_pe - 1))
244 counts_send = 0
245
246 CALL dbcsr_iterator_readonly_start(iter, mat_local)
247 DO WHILE (dbcsr_iterator_blocks_left(iter))
248
249 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
250 row_size=row_size, col_size=col_size)
251
252 mapped_row = row
253 IF (PRESENT(row_mapping)) mapped_row = row_mapping(row)
254 CALL dbcsr_get_stored_coordinates(mat_global, mapped_row, col, imep)
255
256 counts_send(1, imep) = counts_send(1, imep) + row_size*col_size
257 counts_send(2, imep) = counts_send(2, imep) + 1
258
259 END DO
260
261 CALL dbcsr_iterator_stop(iter)
262
263 CALL timestop(handle2)
264
265 CALL timeset(routinen//"_exchange_counts", handle2)
266
267 IF (para_env%num_pe > 1) THEN
268 CALL para_env%alltoall(counts_send, counts_rec, 2)
269 ELSE
270 counts_rec(:, :) = counts_send
271 END IF
272
273 CALL timestop(handle2)
274
275 CALL timeset(routinen//"_pack", handle2)
276
277 CALL allocate_matrix_buffers(counts_send(1, :), counts_rec(1, :), 3, buffer_send, buffer_rec, &
278 counts_send(2, :), counts_rec(2, :))
279
280 ALLOCATE (block_counter(0:para_env%num_pe - 1))
281 block_counter(:) = buffer_send%indx_offset(:para_env%num_pe - 1)
282
283 ALLOCATE (entry_counter(0:para_env%num_pe - 1))
284 entry_counter(:) = buffer_send%msg_offset(:para_env%num_pe - 1)
285
286 ! fill buffer_send
287 CALL dbcsr_iterator_readonly_start(iter, mat_local)
288 DO WHILE (dbcsr_iterator_blocks_left(iter))
289
290 CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
291 row_size=row_size, col_size=col_size)
292
293 mapped_row = row
294 IF (PRESENT(row_mapping)) mapped_row = row_mapping(row)
295 CALL dbcsr_get_stored_coordinates(mat_global, mapped_row, col, imep)
296
297 block_size = row_size*col_size
298
299 offset = entry_counter(imep)
300
301 buffer_send%msg(offset + 1:offset + block_size) = &
302 reshape(data_block(1:row_size, 1:col_size), [block_size])
303
304 i_block = block_counter(imep) + 1
305
306 ! The receiver adds its own segment start to this peer-relative offset.
307 buffer_send%indx(:, i_block) = [mapped_row, col, offset - buffer_send%msg_offset(imep)]
308
309 entry_counter(imep) = entry_counter(imep) + block_size
310
311 block_counter(imep) = block_counter(imep) + 1
312
313 END DO
314
315 CALL dbcsr_iterator_stop(iter)
316
317 CALL timestop(handle2)
318
319 CALL timeset(routinen//"_exchange_data", handle2)
320
321 CALL exchange_matrix_buffers(para_env, buffer_rec, buffer_send)
322
323 CALL timestop(handle2)
324
325 CALL timeset(routinen//"_unpack", handle2)
326
327 ! Keep the rank and receive-buffer order of the block-wise accumulation.
328 DO imep = 0, para_env%num_pe - 1
329 DO i_block = buffer_rec%indx_offset(imep) + 1, buffer_rec%indx_offset(imep + 1)
330 row = buffer_rec%indx(1, i_block)
331 col = buffer_rec%indx(2, i_block)
332 offset = buffer_rec%msg_offset(imep) + buffer_rec%indx(3, i_block)
333 CALL dbcsr_get_block_p(mat_global, row, col, data_block, found=found, &
334 row_size=row_size, col_size=col_size)
335 cpassert(found)
336 IF (my_copy_only) THEN
337 data_block(:, :) = reshape(buffer_rec%msg(offset + 1:offset + row_size*col_size), &
338 [row_size, col_size])
339 ELSE
340 data_block(:, :) = data_block + &
341 reshape(buffer_rec%msg(offset + 1:offset + row_size*col_size), &
342 [row_size, col_size])
343 END IF
344 END DO
345 END DO
346
347 IF (.NOT. my_copy_only) THEN
348 ! Remove numerically zero blocks from the summed matrix.
349 CALL dbcsr_filter(mat_global, 1.0e-30_dp)
350 END IF
351
352 IF (.NOT. my_copy_only) THEN
353 CALL dbcsr_set(mat_local, 0.0_dp)
354 CALL dbcsr_filter(mat_local, 1.0_dp)
355 END IF
356
357 CALL timestop(handle2)
358
359 CALL timestop(handle)
360
361 END SUBROUTINE cp_dbcsr_from_subgroups
362
363! **************************************************************************************************
364!> \brief Consume a distributed flattened array and create a DBCSR matrix per slice.
365!> \param array local flattened rows; all ranks have the same number of slices; deallocated on return
366!> \param nrows number of rows in each output matrix
367!> \param ncols number of columns in each output matrix
368!> \param para_env_sub communicator for the output matrices
369!> \param first_row first flattened row held locally
370!> \param last_row last flattened row held locally
371!> \param template DBCSR template defining output distribution and block sizes
372!> \param matrices preallocated array of output matrices
373!> \param matrix_ptrs preallocated array of output pointers; pointees are allocated here
374!> \note Supply exactly one output representation. Flattened rows use (i-1)*ncols+j.
375! **************************************************************************************************
376 SUBROUTINE cp_array_to_dbcsr_slices(array, nrows, ncols, para_env_sub, &
377 first_row, last_row, template, matrices, matrix_ptrs)
378 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :), &
379 INTENT(INOUT) :: array
380 INTEGER, INTENT(IN) :: nrows, ncols
381 TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env_sub
382 INTEGER, INTENT(IN) :: first_row, last_row
383 TYPE(dbcsr_type), INTENT(INOUT) :: template
384 TYPE(dbcsr_type), DIMENSION(:), INTENT(INOUT), &
385 OPTIONAL, TARGET :: matrices
386 TYPE(dbcsr_p_type), DIMENSION(:), INTENT(INOUT), &
387 OPTIONAL :: matrix_ptrs
388
389 CHARACTER(LEN=*), PARAMETER :: routinen = 'cp_array_to_dbcsr_slices'
390
391 INTEGER :: flat_row, handle, i, ientry, islice, j, &
392 nprocs, pass, peer
393 INTEGER, ALLOCATABLE :: counter(:), recv_count(:), &
394 send_count(:), source_rows(:)
395 TYPE(cp_blacs_env_type), POINTER :: blacs_env
396 TYPE(cp_fm_struct_type), POINTER :: fm_struct
397 TYPE(cp_fm_type) :: fm_ia
398 TYPE(dbcsr_type), POINTER :: output_matrix
399 TYPE(matrix_buffer_type) :: buffer_rec, buffer_send
400
401 CALL timeset(routinen, handle)
402 cpassert(PRESENT(matrices) .NEQV. PRESENT(matrix_ptrs))
403 NULLIFY (blacs_env, fm_struct)
404 CALL cp_blacs_env_create(blacs_env=blacs_env, para_env=para_env_sub)
405 CALL cp_fm_struct_create(fm_struct, context=blacs_env, nrow_global=nrows, &
406 ncol_global=ncols, para_env=para_env_sub)
407 CALL cp_fm_create(fm_ia, fm_struct, name="fm_ia")
408 CALL cp_fm_struct_release(fm_struct)
409 CALL cp_blacs_env_release(blacs_env)
410
411 nprocs = para_env_sub%num_pe
412 ALLOCATE (send_count(0:nprocs - 1), recv_count(0:nprocs - 1), counter(0:nprocs - 1))
413 send_count = 0
414
415 ! Build the coordinate and packing maps once for all slices.
416 DO pass = 1, 2
417 IF (pass == 2) THEN
418 CALL para_env_sub%alltoall(send_count, recv_count, 1)
419 CALL allocate_matrix_buffers(send_count, recv_count, 2, buffer_send, buffer_rec)
420 ALLOCATE (source_rows(SIZE(buffer_send%msg)))
421 counter(:) = buffer_send%msg_offset(:nprocs - 1)
422 END IF
423 DO flat_row = first_row, last_row
424 i = (flat_row - 1)/ncols + 1
425 j = mod(flat_row - 1, ncols) + 1
426 peer = fm_ia%matrix_struct%context%blacs2mpi( &
427 fm_ia%matrix_struct%g2p_row(i), fm_ia%matrix_struct%g2p_col(j))
428 IF (pass == 1) THEN
429 send_count(peer) = send_count(peer) + 1
430 ELSE
431 counter(peer) = counter(peer) + 1
432 ientry = counter(peer)
433 buffer_send%indx(:, ientry) = [i, j]
434 source_rows(ientry) = flat_row - first_row + 1
435 END IF
436 END DO
437 END DO
438
439 CALL exchange_matrix_buffers(para_env_sub, buffer_rec, buffer_send, do_msg=.false.)
440 DO ientry = 1, SIZE(buffer_rec%msg)
441 buffer_rec%indx(1, ientry) = fm_ia%matrix_struct%g2l_row(buffer_rec%indx(1, ientry))
442 buffer_rec%indx(2, ientry) = fm_ia%matrix_struct%g2l_col(buffer_rec%indx(2, ientry))
443 END DO
444
445 DO islice = 1, SIZE(array, 2)
446 DO ientry = 1, SIZE(buffer_send%msg)
447 buffer_send%msg(ientry) = array(source_rows(ientry), islice)
448 END DO
449 CALL exchange_matrix_buffers(para_env_sub, buffer_rec, buffer_send, do_indx=.false.)
450 CALL cp_fm_set_all(fm_ia, 0.0_dp)
451 DO ientry = 1, SIZE(buffer_rec%msg)
452 i = buffer_rec%indx(1, ientry)
453 j = buffer_rec%indx(2, ientry)
454 fm_ia%local_data(i, j) = buffer_rec%msg(ientry)
455 END DO
456
457 IF (PRESENT(matrices)) THEN
458 output_matrix => matrices(islice)
459 ELSE
460 ALLOCATE (matrix_ptrs(islice)%matrix)
461 output_matrix => matrix_ptrs(islice)%matrix
462 END IF
463 CALL cp_dbcsr_m_by_n_from_template(output_matrix, template=template, &
464 m=nrows, n=ncols, sym=dbcsr_type_no_symmetry)
465 CALL copy_fm_to_dbcsr(fm_ia, output_matrix, keep_sparsity=.false.)
466 END DO
467
468 DEALLOCATE (array)
469 CALL cp_fm_release(fm_ia)
470 CALL timestop(handle)
471 END SUBROUTINE cp_array_to_dbcsr_slices
472
methods related to the blacs parallel environment
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
subroutine, public cp_blacs_env_create(blacs_env, para_env, blacs_grid_layout, blacs_repeatable, row_major, grid_2d)
allocates and initializes a type that represent a blacs context
logical function, public dbcsr_iterator_blocks_left(iterator)
...
subroutine, public dbcsr_iterator_stop(iterator)
...
subroutine, public dbcsr_get_block_p(matrix, row, col, block, found, row_size, col_size)
...
subroutine, public dbcsr_reserve_blocks(matrix, rows, cols)
...
subroutine, public dbcsr_get_stored_coordinates(matrix, row, column, processor)
...
subroutine, public dbcsr_iterator_next_block(iterator, row, column, block, block_number_argument_has_been_removed, row_size, col_size, row_offset, col_offset, transposed)
...
subroutine, public dbcsr_filter(matrix, eps)
...
subroutine, public dbcsr_finalize(matrix)
...
subroutine, public dbcsr_iterator_start(iterator, matrix, shared, dynamic, dynamic_byrows)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_iterator_readonly_start(iterator, matrix, shared, dynamic, dynamic_byrows)
Like dbcsr_iterator_start() but with matrix being INTENT(IN). When invoking this routine,...
subroutine, public dbcsr_clear(matrix)
...
subroutine, public dbcsr_reserve_all_blocks(matrix)
Reserves all blocks.
DBCSR operations in CP2K.
subroutine, public cp_dbcsr_m_by_n_from_template(matrix, template, m, n, sym)
Utility function to create an arbitrary shaped dbcsr matrix with the same processor grid as the templ...
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Redistribution of DBCSR blocks and distributed matrix slices.
subroutine, public cp_array_to_dbcsr_slices(array, nrows, ncols, para_env_sub, first_row, last_row, template, matrices, matrix_ptrs)
Consume a distributed flattened array and create a DBCSR matrix per slice.
subroutine, public cp_dbcsr_to_subgroups(mat_global, mat_local, para_env, num_pe_sub, block_row_ranges)
...
subroutine, public cp_dbcsr_from_subgroups(mat_local, mat_global, para_env, row_mapping, copy_only)
Sum subgroup blocks into the global layout, or copy mapped blocks.
represent the structure of a full matrix
subroutine, public cp_fm_struct_create(fmstruct, para_env, context, nrow_global, ncol_global, nrow_block, ncol_block, descriptor, first_p_pos, local_leading_dimension, template_fmstruct, square_blocks, force_block)
allocates and initializes a full matrix structure
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
Exchange numerical matrix payloads and integer metadata between MPI ranks.
subroutine, public exchange_matrix_buffers(comm, buffer_rec, buffer_send, do_indx, do_msg)
Synchronously exchange flat matrix buffers with nonempty peers.
subroutine, public allocate_matrix_buffers(send_count, recv_count, n_index, buffer_send, buffer_rec, send_blocks, recv_blocks)
Allocate flat, rank-grouped matrix buffers and their zero-based offsets.
Interface to the message passing library MPI.
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
keeps the information about the structure of a full matrix
represent a full matrix
stores all the informations relevant to an mpi environment