(git:374b731)
Loading...
Searching...
No Matches
rpa_communication.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Auxiliary routines necessary to redistribute an fm_matrix from a
10!> given blacs_env to another
11!> \par History
12!> 12.2012 created [Mauro Del Ben]
13! **************************************************************************************************
14MODULE rpa_communication
15 USE cp_blacs_env, ONLY: cp_blacs_env_create,&
16 cp_blacs_env_release,&
17 cp_blacs_env_type
18 USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr,&
19 cp_dbcsr_m_by_n_from_template,&
20 dbcsr_allocate_matrix_set
21 USE cp_fm_struct, ONLY: cp_fm_struct_create,&
22 cp_fm_struct_release,&
23 cp_fm_struct_type
24 USE cp_fm_types, ONLY: cp_fm_create,&
25 cp_fm_get_info,&
26 cp_fm_indxg2l,&
27 cp_fm_indxg2p,&
28 cp_fm_release,&
29 cp_fm_set_all,&
30 cp_fm_type
31 USE dbcsr_api, ONLY: dbcsr_p_type,&
32 dbcsr_type,&
33 dbcsr_type_no_symmetry
34 USE group_dist_types, ONLY: create_group_dist,&
35 get_group_dist,&
36 group_dist_d1_type,&
37 release_group_dist
38 USE kinds, ONLY: dp
39 USE message_passing, ONLY: mp_para_env_type,&
40 mp_request_null,&
41 mp_request_type,&
42 mp_waitall
43 USE mp2_ri_grad_util, ONLY: fm2array,&
44 prepare_redistribution
45 USE mp2_types, ONLY: integ_mat_buffer_type
46 USE util, ONLY: get_limit
47#include "./base/base_uses.f90"
48
49 IMPLICIT NONE
50
51 PRIVATE
52
53 TYPE index_map
54 INTEGER, DIMENSION(:, :), ALLOCATABLE :: map
55 END TYPE
56
57 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rpa_communication'
58
59 PUBLIC :: gamma_fm_to_dbcsr, &
60 communicate_buffer
61
62CONTAINS
63
64! **************************************************************************************************
65!> \brief Redistribute RPA-AXK Gamma_3 density matrices: from fm to dbcsr
66!> \param fm_mat_Gamma_3 ... ia*dime_RI sized density matrix (fm type on para_env_RPA)
67!> \param dbcsr_Gamma_3 ... redistributed Gamma_3 (dbcsr array): dimen_RI of i*a: i*a on subgroup, L distributed in RPA_group
68!> \param para_env_RPA ...
69!> \param para_env_sub ...
70!> \param homo ...
71!> \param virtual ...
72!> \param mo_coeff_o ... dbcsr on a subgroup
73!> \param ngroup ...
74!> \param my_group_L_start ...
75!> \param my_group_L_end ...
76!> \param my_group_L_size ...
77!> \author Vladimir Rybkin, 07/2016
78! **************************************************************************************************
79 SUBROUTINE gamma_fm_to_dbcsr(fm_mat_Gamma_3, dbcsr_Gamma_3, para_env_RPA, para_env_sub, &
80 homo, virtual, mo_coeff_o, ngroup, my_group_L_start, my_group_L_end, &
81 my_group_L_size)
82 TYPE(cp_fm_type), INTENT(INOUT) :: fm_mat_gamma_3
83 TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: dbcsr_gamma_3
84 TYPE(mp_para_env_type), INTENT(IN) :: para_env_rpa
85 TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env_sub
86 INTEGER, INTENT(IN) :: homo, virtual
87 TYPE(dbcsr_type), POINTER :: mo_coeff_o
88 INTEGER, INTENT(IN) :: ngroup, my_group_l_start, &
89 my_group_l_end, my_group_l_size
90
91 CHARACTER(LEN=*), PARAMETER :: routinen = 'gamma_fm_to_dbcsr'
92
93 INTEGER :: dimen_ia, dummy_proc, handle, i_global, i_local, iaia, iib, iii, itmp(2), &
94 j_global, j_local, jjb, jjj, kkb, my_ia_end, my_ia_size, my_ia_start, mypcol, myprow, &
95 ncol_block, ncol_local, npcol, nprow, nrow_block, nrow_local, number_of_rec, &
96 number_of_send, proc_receive, proc_send, proc_shift, rec_counter, rec_iaia_end, &
97 rec_iaia_size, rec_iaia_start, rec_pcol, rec_prow, ref_send_pcol, ref_send_prow, &
98 send_counter, send_pcol, send_prow, size_rec_buffer, size_send_buffer
99 INTEGER, ALLOCATABLE, DIMENSION(:) :: iii_vet, map_rec_size, map_send_size
100 INTEGER, ALLOCATABLE, DIMENSION(:, :) :: grid_2_mepos, grid_ref_2_send_pos, &
101 group_grid_2_mepos, indices_map_my, &
102 mepos_2_grid, mepos_2_grid_group
103 INTEGER, DIMENSION(:), POINTER :: col_indices, row_indices
104 REAL(kind=dp) :: part_ia
105 REAL(kind=dp), ALLOCATABLE, DIMENSION(:, :) :: gamma_2d
106 TYPE(cp_blacs_env_type), POINTER :: blacs_env
107 TYPE(cp_fm_struct_type), POINTER :: fm_struct
108 TYPE(cp_fm_type) :: fm_ia
109 TYPE(group_dist_d1_type) :: gd_ia
110 TYPE(index_map), ALLOCATABLE, DIMENSION(:) :: indices_rec
111 TYPE(integ_mat_buffer_type), ALLOCATABLE, &
112 DIMENSION(:) :: buffer_rec, buffer_send
113 TYPE(mp_request_type), ALLOCATABLE, DIMENSION(:) :: req_send
114
115 CALL timeset(routinen, handle)
116
117 dimen_ia = virtual*homo
118
119 ! Prepare sizes for a 2D array
120 CALL create_group_dist(gd_ia, para_env_sub%num_pe, dimen_ia)
121 CALL get_group_dist(gd_ia, para_env_sub%mepos, my_ia_start, my_ia_end, my_ia_size)
122
123 ! Make a 2D array intermediate
124
125 CALL prepare_redistribution(para_env_rpa, para_env_sub, ngroup, &
126 group_grid_2_mepos, mepos_2_grid_group)
127
128 ! fm_mat_Gamma_3 is released here
129 CALL fm2array(gamma_2d, my_ia_size, my_ia_start, my_ia_end, &
130 my_group_l_size, my_group_l_start, my_group_l_end, &
131 group_grid_2_mepos, mepos_2_grid_group, &
132 para_env_sub%num_pe, ngroup, &
133 fm_mat_gamma_3)
134
135 ! create sub blacs env
136 NULLIFY (blacs_env)
137 CALL cp_blacs_env_create(blacs_env=blacs_env, para_env=para_env_sub)
138
139 ! create the fm_ia buffer matrix
140 NULLIFY (fm_struct)
141 CALL cp_fm_struct_create(fm_struct, context=blacs_env, nrow_global=homo, &
142 ncol_global=virtual, para_env=para_env_sub)
143 CALL cp_fm_create(fm_ia, fm_struct, name="fm_ia")
144
145 ! release structure
146 CALL cp_fm_struct_release(fm_struct)
147 ! release blacs_env
148 CALL cp_blacs_env_release(blacs_env)
149
150 ! get array information
151 CALL cp_fm_get_info(matrix=fm_ia, &
152 nrow_local=nrow_local, &
153 ncol_local=ncol_local, &
154 row_indices=row_indices, &
155 col_indices=col_indices, &
156 nrow_block=nrow_block, &
157 ncol_block=ncol_block)
158 myprow = fm_ia%matrix_struct%context%mepos(1)
159 mypcol = fm_ia%matrix_struct%context%mepos(2)
160 nprow = fm_ia%matrix_struct%context%num_pe(1)
161 npcol = fm_ia%matrix_struct%context%num_pe(2)
162
163 ! 0) create array containing the processes position and supporting infos
164 ALLOCATE (grid_2_mepos(0:nprow - 1, 0:npcol - 1))
165 grid_2_mepos = 0
166 ALLOCATE (mepos_2_grid(2, 0:para_env_sub%num_pe - 1))
167 ! fill the info array
168 grid_2_mepos(myprow, mypcol) = para_env_sub%mepos
169 ! sum infos
170 CALL para_env_sub%sum(grid_2_mepos)
171 CALL para_env_sub%allgather([myprow, mypcol], mepos_2_grid)
172
173 ! loop over local index range and define the sending map
174 ALLOCATE (map_send_size(0:para_env_sub%num_pe - 1))
175 map_send_size = 0
176 dummy_proc = 0
177 DO iaia = my_ia_start, my_ia_end
178 i_global = (iaia - 1)/virtual + 1
179 j_global = mod(iaia - 1, virtual) + 1
180 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, &
181 fm_ia%matrix_struct%first_p_pos(1), nprow)
182 send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, &
183 fm_ia%matrix_struct%first_p_pos(2), npcol)
184 proc_send = grid_2_mepos(send_prow, send_pcol)
185 map_send_size(proc_send) = map_send_size(proc_send) + 1
186 END DO
187
188 ! loop over local data of fm_ia and define the receiving map
189 ALLOCATE (map_rec_size(0:para_env_sub%num_pe - 1))
190 map_rec_size = 0
191 part_ia = real(dimen_ia, kind=dp)/real(para_env_sub%num_pe, kind=dp)
192
193 DO iib = 1, nrow_local
194 i_global = row_indices(iib)
195 DO jjb = 1, ncol_local
196 j_global = col_indices(jjb)
197 iaia = (i_global - 1)*virtual + j_global
198 proc_receive = int(real(iaia - 1, kind=dp)/part_ia)
199 proc_receive = max(0, proc_receive)
200 proc_receive = min(proc_receive, para_env_sub%num_pe - 1)
201 DO
202 itmp = get_limit(dimen_ia, para_env_sub%num_pe, proc_receive)
203 IF (iaia >= itmp(1) .AND. iaia <= itmp(2)) EXIT
204 IF (iaia < itmp(1)) proc_receive = proc_receive - 1
205 IF (iaia > itmp(2)) proc_receive = proc_receive + 1
206 END DO
207 map_rec_size(proc_receive) = map_rec_size(proc_receive) + 1
208 END DO
209 END DO
210
211 ! allocate the buffer for sending data
212 number_of_send = 0
213 DO proc_shift = 1, para_env_sub%num_pe - 1
214 proc_send = modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
215 IF (map_send_size(proc_send) > 0) THEN
216 number_of_send = number_of_send + 1
217 END IF
218 END DO
219 ! allocate the structure that will hold the messages to be sent
220 ALLOCATE (buffer_send(number_of_send))
221 ! and the map from the grid of processess to the message position
222 ALLOCATE (grid_ref_2_send_pos(0:nprow - 1, 0:npcol - 1))
223 grid_ref_2_send_pos = 0
224 ! finally allocate each message
225 send_counter = 0
226 DO proc_shift = 1, para_env_sub%num_pe - 1
227 proc_send = modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
228 size_send_buffer = map_send_size(proc_send)
229 IF (map_send_size(proc_send) > 0) THEN
230 send_counter = send_counter + 1
231 ! allocate the sending buffer (msg)
232 ALLOCATE (buffer_send(send_counter)%msg(size_send_buffer))
233 buffer_send(send_counter)%proc = proc_send
234 ! get the pointer to prow, pcol of the process that has
235 ! to receive this message
236 ref_send_prow = mepos_2_grid(1, proc_send)
237 ref_send_pcol = mepos_2_grid(2, proc_send)
238 ! save the rank of the process that has to receive this message
239 grid_ref_2_send_pos(ref_send_prow, ref_send_pcol) = send_counter
240 END IF
241 END DO
242
243 ! allocate the buffer for receiving data
244 number_of_rec = 0
245 DO proc_shift = 1, para_env_sub%num_pe - 1
246 proc_receive = modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
247 IF (map_rec_size(proc_receive) > 0) THEN
248 number_of_rec = number_of_rec + 1
249 END IF
250 END DO
251
252 ! allocate the structure that will hold the messages to be received
253 ! and relative indeces
254 ALLOCATE (buffer_rec(number_of_rec))
255 ALLOCATE (indices_rec(number_of_rec))
256 ! finally allocate each message and fill the array of indeces
257 rec_counter = 0
258 DO proc_shift = 1, para_env_sub%num_pe - 1
259 proc_receive = modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
260 size_rec_buffer = map_rec_size(proc_receive)
261 IF (map_rec_size(proc_receive) > 0) THEN
262 rec_counter = rec_counter + 1
263 ! prepare the buffer for receive
264 ALLOCATE (buffer_rec(rec_counter)%msg(size_rec_buffer))
265 buffer_rec(rec_counter)%proc = proc_receive
266 ! create the indices array
267 ALLOCATE (indices_rec(rec_counter)%map(2, size_rec_buffer))
268 indices_rec(rec_counter)%map = 0
269 CALL get_group_dist(gd_ia, proc_receive, rec_iaia_start, rec_iaia_end, rec_iaia_size)
270 iii = 0
271 DO iaia = rec_iaia_start, rec_iaia_end
272 i_global = (iaia - 1)/virtual + 1
273 j_global = mod(iaia - 1, virtual) + 1
274 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, &
275 fm_ia%matrix_struct%first_p_pos(1), nprow)
276 rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, &
277 fm_ia%matrix_struct%first_p_pos(2), npcol)
278 IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) cycle
279 iii = iii + 1
280 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, &
281 fm_ia%matrix_struct%first_p_pos(1), nprow)
282 j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, &
283 fm_ia%matrix_struct%first_p_pos(2), npcol)
284 indices_rec(rec_counter)%map(1, iii) = i_local
285 indices_rec(rec_counter)%map(2, iii) = j_local
286 END DO
287 END IF
288 END DO
289
290 ! and create the index map for my local data
291 IF (map_rec_size(para_env_sub%mepos) > 0) THEN
292 size_rec_buffer = map_rec_size(para_env_sub%mepos)
293 ALLOCATE (indices_map_my(2, size_rec_buffer))
294 indices_map_my = 0
295 iii = 0
296 DO iaia = my_ia_start, my_ia_end
297 i_global = (iaia - 1)/virtual + 1
298 j_global = mod(iaia - 1, virtual) + 1
299 rec_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, &
300 fm_ia%matrix_struct%first_p_pos(1), nprow)
301 rec_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, &
302 fm_ia%matrix_struct%first_p_pos(2), npcol)
303 IF (grid_2_mepos(rec_prow, rec_pcol) /= para_env_sub%mepos) cycle
304 iii = iii + 1
305 i_local = cp_fm_indxg2l(i_global, nrow_block, dummy_proc, &
306 fm_ia%matrix_struct%first_p_pos(1), nprow)
307 j_local = cp_fm_indxg2l(j_global, ncol_block, dummy_proc, &
308 fm_ia%matrix_struct%first_p_pos(2), npcol)
309 indices_map_my(1, iii) = i_local
310 indices_map_my(2, iii) = j_local
311 END DO
312 END IF
313
314 ! Allocate dbcsr_Gamma_3
315 NULLIFY (dbcsr_gamma_3)
316
317 !CALL dbcsr_allocate_matrix_set(dbcsr_Gamma_3, ncol_local)
318 CALL dbcsr_allocate_matrix_set(dbcsr_gamma_3, my_group_l_size)
319
320 ! auxiliary vector of indices for the send buffer
321 ALLOCATE (iii_vet(number_of_send))
322 ! vector for the send requests
323 ALLOCATE (req_send(number_of_send))
324 ! loop over auxiliary basis function and redistribute into a fm
325 ! and then compy the fm into a dbcsr matrix
326
327 !DO kkB = 1, ncol_local
328 DO kkb = 1, my_group_l_size
329 ! zero the matries of the buffers and post the messages to be received
330 CALL cp_fm_set_all(matrix=fm_ia, alpha=0.0_dp)
331 rec_counter = 0
332 DO proc_shift = 1, para_env_sub%num_pe - 1
333 proc_receive = modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
334 IF (map_rec_size(proc_receive) > 0) THEN
335 rec_counter = rec_counter + 1
336 buffer_rec(rec_counter)%msg = 0.0_dp
337 CALL para_env_sub%irecv(buffer_rec(rec_counter)%msg, proc_receive, &
338 buffer_rec(rec_counter)%msg_req)
339 END IF
340 END DO
341 ! fill the sending buffer and send the messages
342 DO send_counter = 1, number_of_send
343 buffer_send(send_counter)%msg = 0.0_dp
344 END DO
345 iii_vet = 0
346 jjj = 0
347 DO iaia = my_ia_start, my_ia_end
348 i_global = (iaia - 1)/virtual + 1
349 j_global = mod(iaia - 1, virtual) + 1
350 send_prow = cp_fm_indxg2p(i_global, nrow_block, dummy_proc, &
351 fm_ia%matrix_struct%first_p_pos(1), nprow)
352 send_pcol = cp_fm_indxg2p(j_global, ncol_block, dummy_proc, &
353 fm_ia%matrix_struct%first_p_pos(2), npcol)
354 proc_send = grid_2_mepos(send_prow, send_pcol)
355 ! we don't need to send to ourselves
356 IF (grid_2_mepos(send_prow, send_pcol) == para_env_sub%mepos) THEN
357 ! filling fm_ia with local data
358 jjj = jjj + 1
359 i_local = indices_map_my(1, jjj)
360 j_local = indices_map_my(2, jjj)
361 fm_ia%local_data(i_local, j_local) = &
362 gamma_2d(iaia - my_ia_start + 1, kkb)
363
364 ELSE
365 send_counter = grid_ref_2_send_pos(send_prow, send_pcol)
366 iii_vet(send_counter) = iii_vet(send_counter) + 1
367 iii = iii_vet(send_counter)
368 buffer_send(send_counter)%msg(iii) = &
369 gamma_2d(iaia - my_ia_start + 1, kkb)
370 END IF
371 END DO
372 req_send = mp_request_null
373 send_counter = 0
374 DO proc_shift = 1, para_env_sub%num_pe - 1
375 proc_send = modulo(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
376 IF (map_send_size(proc_send) > 0) THEN
377 send_counter = send_counter + 1
378 CALL para_env_sub%isend(buffer_send(send_counter)%msg, proc_send, &
379 buffer_send(send_counter)%msg_req)
380 req_send(send_counter) = buffer_send(send_counter)%msg_req
381 END IF
382 END DO
383
384 ! receive the messages and fill the fm_ia
385 rec_counter = 0
386 DO proc_shift = 1, para_env_sub%num_pe - 1
387 proc_receive = modulo(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
388 size_rec_buffer = map_rec_size(proc_receive)
389 IF (map_rec_size(proc_receive) > 0) THEN
390 rec_counter = rec_counter + 1
391 ! wait for the message
392 CALL buffer_rec(rec_counter)%msg_req%wait()
393 DO iii = 1, size_rec_buffer
394 i_local = indices_rec(rec_counter)%map(1, iii)
395 j_local = indices_rec(rec_counter)%map(2, iii)
396 fm_ia%local_data(i_local, j_local) = buffer_rec(rec_counter)%msg(iii)
397 END DO
398 END IF
399 END DO
400
401 ! wait all
402 CALL mp_waitall(req_send(:))
403
404 ! now create the DBCSR matrix and copy fm_ia into it
405 ALLOCATE (dbcsr_gamma_3(kkb)%matrix)
406 CALL cp_dbcsr_m_by_n_from_template(dbcsr_gamma_3(kkb)%matrix, &
407 template=mo_coeff_o, &
408 m=homo, n=virtual, sym=dbcsr_type_no_symmetry)
409 CALL copy_fm_to_dbcsr(fm_ia, dbcsr_gamma_3(kkb)%matrix, keep_sparsity=.false.)
410
411 END DO
412
413 ! Deallocate memory
414
415 DEALLOCATE (gamma_2d)
416 DEALLOCATE (iii_vet)
417 DEALLOCATE (req_send)
418 IF (map_rec_size(para_env_sub%mepos) > 0) THEN
419 DEALLOCATE (indices_map_my)
420 END IF
421 DO rec_counter = 1, number_of_rec
422 DEALLOCATE (indices_rec(rec_counter)%map)
423 DEALLOCATE (buffer_rec(rec_counter)%msg)
424 END DO
425 DEALLOCATE (indices_rec)
426 DEALLOCATE (buffer_rec)
427 DO send_counter = 1, number_of_send
428 DEALLOCATE (buffer_send(send_counter)%msg)
429 END DO
430 DEALLOCATE (buffer_send)
431 DEALLOCATE (map_send_size)
432 DEALLOCATE (map_rec_size)
433 DEALLOCATE (grid_2_mepos)
434 DEALLOCATE (mepos_2_grid)
435 CALL release_group_dist(gd_ia)
436
437 ! release buffer matrix
438 CALL cp_fm_release(fm_ia)
439
440 CALL timestop(handle)
441
442 END SUBROUTINE gamma_fm_to_dbcsr
443
444! **************************************************************************************************
445!> \brief ...
446!> \param para_env ...
447!> \param num_entries_rec ...
448!> \param num_entries_send ...
449!> \param buffer_rec ...
450!> \param buffer_send ...
451!> \param req_array ...
452!> \param do_indx ...
453!> \param do_msg ...
454! **************************************************************************************************
455 SUBROUTINE communicate_buffer(para_env, num_entries_rec, num_entries_send, buffer_rec, buffer_send, &
456 req_array, do_indx, do_msg)
457
458 TYPE(mp_para_env_type), INTENT(IN) :: para_env
459 INTEGER, ALLOCATABLE, DIMENSION(:), INTENT(IN) :: num_entries_rec, num_entries_send
460 TYPE(integ_mat_buffer_type), ALLOCATABLE, &
461 DIMENSION(:), INTENT(INOUT) :: buffer_rec, buffer_send
462 TYPE(mp_request_type), DIMENSION(:, :), POINTER :: req_array
463 LOGICAL, INTENT(IN), OPTIONAL :: do_indx, do_msg
464
465 CHARACTER(LEN=*), PARAMETER :: routinen = 'communicate_buffer'
466
467 INTEGER :: handle, imepos, rec_counter, send_counter
468 LOGICAL :: my_do_indx, my_do_msg
469
470 CALL timeset(routinen, handle)
471
472 my_do_indx = .true.
473 IF (PRESENT(do_indx)) my_do_indx = do_indx
474 my_do_msg = .true.
475 IF (PRESENT(do_msg)) my_do_msg = do_msg
476
477 IF (para_env%num_pe > 1) THEN
478
479 send_counter = 0
480 rec_counter = 0
481
482 DO imepos = 0, para_env%num_pe - 1
483 IF (num_entries_rec(imepos) > 0) THEN
484 rec_counter = rec_counter + 1
485 IF (my_do_indx) THEN
486 CALL para_env%irecv(buffer_rec(imepos)%indx, imepos, req_array(rec_counter, 3), tag=4)
487 END IF
488 IF (my_do_msg) THEN
489 CALL para_env%irecv(buffer_rec(imepos)%msg, imepos, req_array(rec_counter, 4), tag=7)
490 END IF
491 END IF
492 END DO
493
494 DO imepos = 0, para_env%num_pe - 1
495 IF (num_entries_send(imepos) > 0) THEN
496 send_counter = send_counter + 1
497 IF (my_do_indx) THEN
498 CALL para_env%isend(buffer_send(imepos)%indx, imepos, req_array(send_counter, 1), tag=4)
499 END IF
500 IF (my_do_msg) THEN
501 CALL para_env%isend(buffer_send(imepos)%msg, imepos, req_array(send_counter, 2), tag=7)
502 END IF
503 END IF
504 END DO
505
506 IF (my_do_indx) THEN
507 CALL mp_waitall(req_array(1:send_counter, 1))
508 CALL mp_waitall(req_array(1:rec_counter, 3))
509 END IF
510
511 IF (my_do_msg) THEN
512 CALL mp_waitall(req_array(1:send_counter, 2))
513 CALL mp_waitall(req_array(1:rec_counter, 4))
514 END IF
515
516 ELSE
517
518 buffer_rec(0)%indx(:, :) = buffer_send(0)%indx
519 buffer_rec(0)%msg(:) = buffer_send(0)%msg
520
521 END IF
522
523 CALL timestop(handle)
524
525 END SUBROUTINE communicate_buffer
526
527END MODULE rpa_communication
modulo
static GRID_HOST_DEVICE int modulo(int a, int m)
Equivalent of Fortran's MODULO, which always return a positive number. https://gcc....
Definition grid_common.h:117
cp_dbcsr_operations::dbcsr_allocate_matrix_set
Definition cp_dbcsr_operations.F:81
cp_fm_types::cp_fm_release
Definition cp_fm_types.F:90
group_dist_types::create_group_dist
Definition group_dist_types.F:39
group_dist_types::get_group_dist
Definition group_dist_types.F:47
group_dist_types::release_group_dist
Definition group_dist_types.F:53
message_passing::mp_waitall
Definition message_passing.F:871
cp_blacs_env
methods related to the blacs parallel environment
Definition cp_blacs_env.F:15
cp_blacs_env::cp_blacs_env_release
subroutine, public cp_blacs_env_release(blacs_env)
releases the given blacs_env
Definition cp_blacs_env.F:282
cp_blacs_env::cp_blacs_env_create
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
Definition cp_blacs_env.F:123
cp_dbcsr_operations
DBCSR operations in CP2K.
Definition cp_dbcsr_operations.F:18
cp_dbcsr_operations::cp_dbcsr_m_by_n_from_template
subroutine, public cp_dbcsr_m_by_n_from_template(matrix, template, m, n, sym, data_type)
Utility function to create an arbitrary shaped dbcsr matrix with the same processor grid as the templ...
Definition cp_dbcsr_operations.F:1105
cp_dbcsr_operations::copy_fm_to_dbcsr
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
Definition cp_dbcsr_operations.F:118
cp_fm_struct
represent the structure of a full matrix
Definition cp_fm_struct.F:14
cp_fm_struct::cp_fm_struct_create
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
Definition cp_fm_struct.F:125
cp_fm_struct::cp_fm_struct_release
subroutine, public cp_fm_struct_release(fmstruct)
releases a full matrix structure
Definition cp_fm_struct.F:320
cp_fm_types
represent a full matrix distributed on many processors
Definition cp_fm_types.F:15
cp_fm_types::cp_fm_get_info
subroutine, public cp_fm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, nrow_locals, ncol_locals, matrix_struct, para_env)
returns all kind of information about the full matrix
Definition cp_fm_types.F:1016
cp_fm_types::cp_fm_indxg2l
integer function, public cp_fm_indxg2l(indxglob, nb, iproc, isrcproc, nprocs)
wrapper to scalapack function INDXG2L that computes the local index of a distributed matrix entry poi...
Definition cp_fm_types.F:2525
cp_fm_types::cp_fm_set_all
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
Definition cp_fm_types.F:535
cp_fm_types::cp_fm_indxg2p
integer function, public cp_fm_indxg2p(indxglob, nb, iproc, isrcproc, nprocs)
wrapper to scalapack function INDXG2P that computes the process coordinate which possesses the entry ...
Definition cp_fm_types.F:2466
cp_fm_types::cp_fm_create
subroutine, public cp_fm_create(matrix, matrix_struct, name, use_sp)
creates a new full matrix with the given structure
Definition cp_fm_types.F:167
group_dist_types
Types to describe group distributions.
Definition group_dist_types.F:14
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
message_passing
Interface to the message passing library MPI.
Definition message_passing.F:23
message_passing::mp_request_null
type(mp_request_type), parameter, public mp_request_null
Definition message_passing.F:814
mp2_ri_grad_util
Routines for calculating RI-MP2 gradients.
Definition mp2_ri_grad_util.F:13
mp2_ri_grad_util::prepare_redistribution
subroutine, public prepare_redistribution(para_env, para_env_sub, ngroup, group_grid_2_mepos, mepos_2_grid_group, pos_info)
prepare array for redistribution
Definition mp2_ri_grad_util.F:1590
mp2_ri_grad_util::fm2array
subroutine, public fm2array(mat2d, my_rows, my_start_row, my_end_row, my_cols, my_start_col, my_end_col, group_grid_2_mepos, mepos_2_grid_group, ngroup_row, ngroup_col, fm_mat)
redistribute fm to local part of array
Definition mp2_ri_grad_util.F:902
mp2_types
Types needed for MP2 calculations.
Definition mp2_types.F:14
rpa_communication
Auxiliary routines necessary to redistribute an fm_matrix from a given blacs_env to another.
Definition rpa_communication.F:14
rpa_communication::communicate_buffer
subroutine, public communicate_buffer(para_env, num_entries_rec, num_entries_send, buffer_rec, buffer_send, req_array, do_indx, do_msg)
...
Definition rpa_communication.F:457
rpa_communication::gamma_fm_to_dbcsr
subroutine, public gamma_fm_to_dbcsr(fm_mat_gamma_3, dbcsr_gamma_3, para_env_rpa, para_env_sub, homo, virtual, mo_coeff_o, ngroup, my_group_l_start, my_group_l_end, my_group_l_size)
Redistribute RPA-AXK Gamma_3 density matrices: from fm to dbcsr.
Definition rpa_communication.F:82
util
All kind of helpful little routines.
Definition util.F:14
util::get_limit
pure integer function, dimension(2), public get_limit(m, n, me)
divide m entries into n parts, return size of part me
Definition util.F:333
cp_blacs_env::cp_blacs_env_type
represent a blacs multidimensional parallel environment (for the mpi corrispective see cp_paratypes/m...
Definition cp_blacs_env.F:53
cp_fm_struct::cp_fm_struct_type
keeps the information about the structure of a full matrix
Definition cp_fm_struct.F:82
cp_fm_types::cp_fm_type
represent a full matrix
Definition cp_fm_types.F:116
group_dist_types::group_dist_d1_type
Definition group_dist_types.F:35
message_passing::mp_para_env_type
stores all the informations relevant to an mpi environment
Definition message_passing.F:763
message_passing::mp_request_type
Definition message_passing.F:623
mp2_types::integ_mat_buffer_type
Definition mp2_types.F:377