10 USE dbcsr_api,
ONLY: dbcsr_get_block_p,&
24 #include "./base/base_uses.f90"
38 PUBLIC :: fb_com_tasks_obj, &
63 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'qs_fb_com_tasks_types'
97 TYPE fb_com_tasks_data
99 INTEGER(KIND=int_8),
DIMENSION(:, :),
POINTER :: tasks
103 END TYPE fb_com_tasks_data
109 TYPE fb_com_tasks_obj
110 TYPE(fb_com_tasks_data),
POINTER,
PRIVATE :: obj
111 END TYPE fb_com_tasks_obj
128 TYPE fb_com_atom_pairs_data
129 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs
131 INTEGER :: natoms_encode
132 END TYPE fb_com_atom_pairs_data
138 TYPE fb_com_atom_pairs_obj
139 TYPE(fb_com_atom_pairs_data),
POINTER,
PRIVATE :: obj
140 END TYPE fb_com_atom_pairs_obj
152 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: com_tasks
154 IF (
ASSOCIATED(com_tasks%obj))
THEN
155 IF (
ASSOCIATED(com_tasks%obj%tasks))
THEN
156 DEALLOCATE (com_tasks%obj%tasks)
158 DEALLOCATE (com_tasks%obj)
160 NULLIFY (com_tasks%obj)
172 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
174 IF (
ASSOCIATED(atom_pairs%obj))
THEN
175 IF (
ASSOCIATED(atom_pairs%obj%pairs))
THEN
176 DEALLOCATE (atom_pairs%obj%pairs)
178 DEALLOCATE (atom_pairs%obj)
180 NULLIFY (atom_pairs%obj)
193 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: com_tasks
195 NULLIFY (com_tasks%obj)
207 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
209 NULLIFY (atom_pairs%obj)
218 SUBROUTINE fb_com_tasks_associate(a, b)
219 TYPE(fb_com_tasks_obj),
INTENT(OUT) :: a
220 TYPE(fb_com_tasks_obj),
INTENT(IN) :: b
223 END SUBROUTINE fb_com_tasks_associate
231 SUBROUTINE fb_com_atom_pairs_associate(a, b)
232 TYPE(fb_com_atom_pairs_obj),
INTENT(OUT) :: a
233 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: b
236 END SUBROUTINE fb_com_atom_pairs_associate
245 FUNCTION fb_com_tasks_has_data(com_tasks)
RESULT(res)
246 TYPE(fb_com_tasks_obj),
INTENT(IN) :: com_tasks
249 res =
ASSOCIATED(com_tasks%obj)
250 END FUNCTION fb_com_tasks_has_data
260 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: atom_pairs
263 res =
ASSOCIATED(atom_pairs%obj)
273 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: com_tasks
275 cpassert(.NOT.
ASSOCIATED(com_tasks%obj))
276 ALLOCATE (com_tasks%obj)
278 com_tasks%obj%ntasks = 0
279 com_tasks%obj%nencode = 0
280 NULLIFY (com_tasks%obj%tasks)
290 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
292 cpassert(.NOT.
ASSOCIATED(atom_pairs%obj))
293 ALLOCATE (atom_pairs%obj)
294 atom_pairs%obj%npairs = 0
295 atom_pairs%obj%natoms_encode = 0
296 NULLIFY (atom_pairs%obj%pairs)
305 SUBROUTINE fb_com_tasks_init(com_tasks)
306 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: com_tasks
308 cpassert(
ASSOCIATED(com_tasks%obj))
309 IF (
ASSOCIATED(com_tasks%obj%tasks))
THEN
310 DEALLOCATE (com_tasks%obj%tasks)
313 com_tasks%obj%ntasks = 0
314 com_tasks%obj%nencode = 0
315 END SUBROUTINE fb_com_tasks_init
324 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
326 cpassert(
ASSOCIATED(atom_pairs%obj))
327 IF (
ASSOCIATED(atom_pairs%obj%pairs))
THEN
328 DEALLOCATE (atom_pairs%obj%pairs)
330 atom_pairs%obj%npairs = 0
331 atom_pairs%obj%natoms_encode = 0
351 TYPE(fb_com_tasks_obj),
INTENT(IN) :: com_tasks
352 INTEGER,
INTENT(OUT),
OPTIONAL :: task_dim, ntasks, nencode
353 INTEGER(KIND=int_8),
DIMENSION(:, :),
OPTIONAL, &
356 cpassert(
ASSOCIATED(com_tasks%obj))
357 IF (
PRESENT(task_dim)) task_dim = com_tasks%obj%task_dim
358 IF (
PRESENT(ntasks)) ntasks = com_tasks%obj%ntasks
359 IF (
PRESENT(nencode)) nencode = com_tasks%obj%nencode
360 IF (
PRESENT(tasks)) tasks => com_tasks%obj%tasks
378 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: atom_pairs
379 INTEGER,
INTENT(OUT),
OPTIONAL :: npairs, natoms_encode
380 INTEGER(KIND=int_8),
DIMENSION(:),
OPTIONAL, &
383 cpassert(
ASSOCIATED(atom_pairs%obj))
384 IF (
PRESENT(npairs)) npairs = atom_pairs%obj%npairs
385 IF (
PRESENT(natoms_encode)) natoms_encode = atom_pairs%obj%natoms_encode
386 IF (
PRESENT(pairs)) pairs => atom_pairs%obj%pairs
406 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: com_tasks
407 INTEGER,
INTENT(IN),
OPTIONAL :: task_dim, ntasks, nencode
408 INTEGER(KIND=int_8),
DIMENSION(:, :),
OPTIONAL, &
411 cpassert(
ASSOCIATED(com_tasks%obj))
412 IF (
PRESENT(task_dim)) com_tasks%obj%task_dim = task_dim
413 IF (
PRESENT(ntasks)) com_tasks%obj%ntasks = ntasks
414 IF (
PRESENT(nencode)) com_tasks%obj%nencode = nencode
415 IF (
PRESENT(tasks))
THEN
416 IF (
ASSOCIATED(com_tasks%obj%tasks))
THEN
417 DEALLOCATE (com_tasks%obj%tasks)
419 com_tasks%obj%tasks => tasks
434 SUBROUTINE fb_com_atom_pairs_set(atom_pairs, &
438 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
439 INTEGER,
INTENT(IN),
OPTIONAL :: npairs, natoms_encode
440 INTEGER(KIND=int_8),
DIMENSION(:),
OPTIONAL, &
443 cpassert(
ASSOCIATED(atom_pairs%obj))
444 IF (
PRESENT(npairs)) atom_pairs%obj%npairs = npairs
445 IF (
PRESENT(natoms_encode)) atom_pairs%obj%natoms_encode = natoms_encode
446 IF (
PRESENT(pairs))
THEN
447 IF (
ASSOCIATED(atom_pairs%obj%pairs))
THEN
448 DEALLOCATE (atom_pairs%obj%pairs)
450 atom_pairs%obj%pairs => pairs
452 END SUBROUTINE fb_com_atom_pairs_set
474 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: tasks_dest_is_me
475 CHARACTER,
INTENT(IN) :: direction
476 TYPE(fb_com_tasks_obj),
INTENT(INOUT) :: tasks_src_is_me
477 TYPE(mp_para_env_type),
POINTER :: para_env
479 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_com_tasks_transpose_dest_src'
481 INTEGER :: handle, ii, ind, ipe, itask, jj, &
482 nencode, ntasks_in, ntasks_out, rank, &
484 INTEGER(KIND=int_8),
DIMENSION(:, :),
POINTER :: tasks_in, tasks_out
485 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: recv_buf, recv_disps, recv_sizes, &
486 send_buf, send_disps, send_sizes
488 CALL timeset(routinen, handle)
490 NULLIFY (tasks_in, tasks_out)
492 IF (direction ==
"<")
THEN
509 ALLOCATE (send_sizes(para_env%num_pe))
510 ALLOCATE (send_disps(para_env%num_pe))
511 ALLOCATE (send_buf(para_env%num_pe))
513 ALLOCATE (recv_sizes(para_env%num_pe))
514 ALLOCATE (recv_disps(para_env%num_pe))
515 ALLOCATE (recv_buf(para_env%num_pe))
522 DO itask = 1, ntasks_in
523 rank = int(tasks_in(rank_pos, itask)) + 1
524 send_buf(rank) = send_buf(rank) + 1
527 CALL para_env%alltoall(send_buf, recv_buf, 1)
541 send_sizes(1) = send_buf(1)*task_dim
542 recv_sizes(1) = recv_buf(1)*task_dim
543 DO ipe = 2, para_env%num_pe
544 send_sizes(ipe) = send_buf(ipe)*task_dim
545 send_disps(ipe) = send_disps(ipe - 1) + send_sizes(ipe - 1)
546 recv_sizes(ipe) = recv_buf(ipe)*task_dim
547 recv_disps(ipe) = recv_disps(ipe - 1) + recv_sizes(ipe - 1)
552 DEALLOCATE (send_buf)
553 DEALLOCATE (recv_buf)
554 ALLOCATE (send_buf(sum(send_sizes)))
555 ALLOCATE (recv_buf(sum(recv_sizes)))
559 IF (
SIZE(send_buf) > 0) send_buf = 0
560 IF (
SIZE(recv_buf) > 0) recv_buf = 0
562 DO itask = 1, ntasks_in
563 rank = int(tasks_in(rank_pos, itask)) + 1
565 ind = send_disps(rank) + send_sizes(rank) + ii
566 send_buf(ind) = int(tasks_in(ii, itask))
568 send_sizes(rank) = send_sizes(rank) + task_dim
571 CALL para_env%alltoall(send_buf, send_sizes, send_disps, &
572 recv_buf, recv_sizes, recv_disps)
575 DEALLOCATE (send_buf)
576 DEALLOCATE (send_sizes)
577 DEALLOCATE (send_disps)
580 ntasks_out = sum(recv_sizes)/task_dim
582 ALLOCATE (tasks_out(task_dim, ntasks_out))
586 DO ipe = 1, para_env%num_pe
587 DO ii = 0, recv_sizes(ipe)/task_dim - 1
590 ind = recv_disps(ipe) + ii*task_dim + jj
591 tasks_out(jj, itask) = recv_buf(ind)
597 IF (direction ==
"<")
THEN
612 DEALLOCATE (recv_buf)
613 DEALLOCATE (recv_sizes)
614 DEALLOCATE (recv_disps)
616 CALL timestop(handle)
641 TYPE(fb_com_tasks_obj),
INTENT(IN) :: com_tasks
642 TYPE(fb_com_atom_pairs_obj),
INTENT(INOUT) :: atom_pairs
643 INTEGER,
INTENT(IN) :: natoms_encode
644 CHARACTER(len=*),
INTENT(IN) :: send_or_recv
646 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_com_tasks_build_atom_pairs'
648 INTEGER :: handle, iatom, ii, itask, jatom, npairs, &
649 ntasks, rank, rank_pos
650 INTEGER(KIND=int_8) :: pair
651 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs
652 INTEGER(KIND=int_8),
DIMENSION(:, :),
POINTER :: tasks
653 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: tmp_index
656 CALL timeset(routinen, handle)
658 NULLIFY (pairs, tasks)
666 IF (trim(send_or_recv) ==
"send")
THEN
676 ALLOCATE (pairs(ntasks))
678 IF (
SIZE(pairs) > 0) pairs = 0
684 rank = int(tasks(rank_pos, itask))
685 CALL fb_com_atom_pairs_encode(pairs(itask), &
686 rank, iatom, jatom, natoms_encode)
694 ALLOCATE (tmp_index(npairs))
696 CALL sort(pairs, npairs, tmp_index)
697 DEALLOCATE (tmp_index)
705 IF (pairs(ii) > pairs(ii - 1))
THEN
707 pairs(npairs) = pairs(ii)
711 CALL reallocate(pairs, 1, npairs)
714 CALL fb_com_atom_pairs_set(atom_pairs=atom_pairs, &
717 natoms_encode=natoms_encode)
719 CALL timestop(handle)
733 INTEGER(KIND=int_8),
INTENT(OUT) :: ind
734 INTEGER,
INTENT(IN) :: iatom, jatom, natoms
736 INTEGER(KIND=int_8) :: iatom8, jatom8, natoms8
738 natoms8 = int(natoms,
int_8)
739 iatom8 = int(iatom,
int_8)
740 jatom8 = int(jatom,
int_8)
742 ind = (iatom8 - 1_int_8)*natoms8 + (jatom8 - 1_int_8)
755 INTEGER(KIND=int_8),
INTENT(IN) :: ind
756 INTEGER,
INTENT(OUT) :: iatom, jatom
757 INTEGER,
INTENT(IN) :: natoms
759 INTEGER(KIND=int_8) :: iatom8, jatom8, natoms8
761 natoms8 = int(natoms,
int_8)
762 iatom8 = ind/natoms8 + 1_int_8
763 jatom8 = mod(ind, natoms8) + 1_int_8
764 iatom = int(iatom8,
int_4)
765 jatom = int(jatom8,
int_4)
779 SUBROUTINE fb_com_atom_pairs_encode(ind, pe, iatom, jatom, natoms)
780 INTEGER(KIND=int_8),
INTENT(OUT) :: ind
781 INTEGER,
INTENT(IN) :: pe, iatom, jatom, natoms
783 INTEGER(KIND=int_8) :: natoms8, pair
787 natoms8 = int(natoms,
int_8)
789 ind = int(pe,
int_8)*natoms8*natoms8 + pair
790 END SUBROUTINE fb_com_atom_pairs_encode
805 INTEGER(KIND=int_8),
INTENT(IN) :: ind
806 INTEGER,
INTENT(OUT) :: pe, iatom, jatom
807 INTEGER,
INTENT(IN) :: natoms
809 INTEGER(KIND=int_8) :: natoms8, pair
813 natoms8 = int(natoms,
int_8)
814 pe = int(ind/(natoms8*natoms8),
int_4)
815 pair = mod(ind, natoms8*natoms8)
853 sendrecv_pair_counts, &
855 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: atom_pairs
856 INTEGER,
INTENT(IN) :: nprocs
857 INTEGER,
DIMENSION(:),
INTENT(IN) :: row_blk_sizes, col_blk_sizes
858 INTEGER,
DIMENSION(:),
INTENT(OUT) :: sendrecv_sizes, sendrecv_disps, &
859 sendrecv_pair_counts, &
862 INTEGER :: iatom, ipair, ipe, jatom, natoms_encode, &
863 ncols_blk, npairs, nrows_blk, pe
864 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs
869 check_ok =
SIZE(sendrecv_sizes) == nprocs .AND. &
870 SIZE(sendrecv_disps) == nprocs .AND. &
871 SIZE(sendrecv_pair_counts) == nprocs .AND. &
872 SIZE(sendrecv_pair_disps) == nprocs
881 natoms_encode=natoms_encode)
884 sendrecv_pair_counts = 0
888 pe, iatom, jatom, natoms_encode)
890 nrows_blk = row_blk_sizes(iatom)
891 ncols_blk = col_blk_sizes(jatom)
892 sendrecv_sizes(pe) = sendrecv_sizes(pe) + nrows_blk*ncols_blk
893 sendrecv_pair_counts(pe) = sendrecv_pair_counts(pe) + 1
898 sendrecv_pair_disps = 0
900 sendrecv_disps(ipe) = sendrecv_disps(ipe - 1) + sendrecv_sizes(ipe - 1)
901 sendrecv_pair_disps(ipe) = sendrecv_pair_disps(ipe - 1) + sendrecv_pair_counts(ipe - 1)
926 TYPE(dbcsr_type),
POINTER :: dbcsr_mat
927 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: atom_pairs_send, atom_pairs_recv
928 TYPE(mp_para_env_type),
POINTER :: para_env
929 TYPE(fb_matrix_data_obj),
INTENT(INOUT) :: matrix_storage
931 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_com_atom_pairs_gather_blks'
933 INTEGER :: handle, iatom, ii, ind, ipair, ipe, jatom, jj, ncols_blk, ncols_blk_max, &
934 npairs_recv, npairs_send, nrows_blk, nrows_blk_max, numprocs, pe, recv_encode, send_encode
935 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs_recv, pairs_send
936 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: recv_disps, recv_pair_count, recv_pair_disps, &
937 recv_sizes, send_disps, send_pair_count, send_pair_disps, send_sizes
938 INTEGER,
DIMENSION(:),
POINTER :: col_block_size_data, row_block_size_data
939 LOGICAL :: check_ok, found
940 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: recv_buf, send_buf
941 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mat_block
943 CALL timeset(routinen, handle)
945 NULLIFY (pairs_send, pairs_recv, mat_block, &
946 row_block_size_data, col_block_size_data)
958 npairs=npairs_send, &
959 natoms_encode=send_encode)
962 npairs=npairs_recv, &
963 natoms_encode=recv_encode)
965 numprocs = para_env%num_pe
968 CALL dbcsr_get_info(dbcsr_mat, row_blk_size=row_block_size_data, col_blk_size=col_block_size_data)
971 ALLOCATE (send_sizes(numprocs))
972 ALLOCATE (send_disps(numprocs))
973 ALLOCATE (send_pair_count(numprocs))
974 ALLOCATE (send_pair_disps(numprocs))
979 row_block_size_data, &
980 col_block_size_data, &
987 ALLOCATE (send_buf(sum(send_sizes)))
990 ALLOCATE (recv_sizes(numprocs))
991 ALLOCATE (recv_disps(numprocs))
992 ALLOCATE (recv_pair_count(numprocs))
993 ALLOCATE (recv_pair_disps(numprocs))
998 row_block_size_data, &
999 col_block_size_data, &
1006 ALLOCATE (recv_buf(sum(recv_sizes)))
1009 DO ipe = 1, numprocs
1012 DO ipair = 1, send_pair_count(ipe)
1014 pe, iatom, jatom, send_encode)
1015 nrows_blk = row_block_size_data(iatom)
1016 ncols_blk = col_block_size_data(jatom)
1017 CALL dbcsr_get_block_p(matrix=dbcsr_mat, &
1018 row=iatom, col=jatom, block=mat_block, &
1020 IF (.NOT. found)
THEN
1021 cpabort(
"Matrix block not found")
1024 DO jj = 1, ncols_blk
1025 DO ii = 1, nrows_blk
1027 ind = send_disps(ipe) + send_sizes(ipe) + ii + (jj - 1)*nrows_blk
1028 send_buf(ind) = mat_block(ii, jj)
1031 send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk
1037 CALL para_env%alltoall(send_buf, send_sizes, send_disps, &
1038 recv_buf, recv_sizes, recv_disps)
1041 DEALLOCATE (send_buf)
1042 DEALLOCATE (send_sizes)
1043 DEALLOCATE (send_disps)
1044 DEALLOCATE (send_pair_count)
1045 DEALLOCATE (send_pair_disps)
1049 nrows_blk_max = maxval(row_block_size_data)
1050 ncols_blk_max = maxval(col_block_size_data)
1051 ALLOCATE (mat_block(nrows_blk_max, ncols_blk_max))
1052 DO ipe = 1, numprocs
1054 DO ipair = 1, recv_pair_count(ipe)
1056 pe, iatom, jatom, recv_encode)
1057 nrows_blk = row_block_size_data(iatom)
1058 ncols_blk = col_block_size_data(jatom)
1061 mat_block(:, :) = 0.0_dp
1062 DO jj = 1, ncols_blk
1063 DO ii = 1, nrows_blk
1065 ind = recv_disps(ipe) + recv_sizes(ipe) + ii + (jj - 1)*nrows_blk
1066 mat_block(ii, jj) = recv_buf(ind)
1071 mat_block(1:nrows_blk, 1:ncols_blk))
1072 recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk
1077 DEALLOCATE (mat_block)
1080 DEALLOCATE (recv_buf)
1081 DEALLOCATE (recv_sizes)
1082 DEALLOCATE (recv_disps)
1083 DEALLOCATE (recv_pair_count)
1084 DEALLOCATE (recv_pair_disps)
1086 CALL timestop(handle)
1111 TYPE(fb_matrix_data_obj),
INTENT(IN) :: matrix_storage
1112 TYPE(fb_com_atom_pairs_obj),
INTENT(IN) :: atom_pairs_send, atom_pairs_recv
1113 TYPE(mp_para_env_type),
POINTER :: para_env
1114 TYPE(dbcsr_type),
POINTER :: dbcsr_mat
1116 CHARACTER(LEN=*),
PARAMETER :: routinen =
'fb_com_atom_pairs_distribute_blks'
1118 INTEGER :: handle, iatom, ii, ind, ipair, ipe, jatom, jj, ncols_blk, npairs_recv, &
1119 npairs_send, nrows_blk, numprocs, pe, recv_encode, send_encode
1120 INTEGER(KIND=int_8),
DIMENSION(:),
POINTER :: pairs_recv, pairs_send
1121 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: recv_disps, recv_pair_count, recv_pair_disps, &
1122 recv_sizes, send_disps, send_pair_count, send_pair_disps, send_sizes
1123 INTEGER,
DIMENSION(:),
POINTER :: col_block_size_data, row_block_size_data
1124 LOGICAL :: check_ok, found
1125 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: recv_buf, send_buf
1126 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: mat_block
1128 CALL timeset(routinen, handle)
1130 NULLIFY (pairs_send, pairs_recv, mat_block, &
1131 row_block_size_data, col_block_size_data)
1143 npairs=npairs_send, &
1144 natoms_encode=send_encode)
1147 npairs=npairs_recv, &
1148 natoms_encode=recv_encode)
1150 numprocs = para_env%num_pe
1153 CALL dbcsr_get_info(dbcsr_mat, row_blk_size=row_block_size_data, col_blk_size=col_block_size_data)
1156 ALLOCATE (send_sizes(numprocs))
1157 ALLOCATE (send_disps(numprocs))
1158 ALLOCATE (send_pair_count(numprocs))
1159 ALLOCATE (send_pair_disps(numprocs))
1164 row_block_size_data, &
1165 col_block_size_data, &
1172 ALLOCATE (send_buf(sum(send_sizes)))
1175 ALLOCATE (recv_sizes(numprocs))
1176 ALLOCATE (recv_disps(numprocs))
1177 ALLOCATE (recv_pair_count(numprocs))
1178 ALLOCATE (recv_pair_disps(numprocs))
1183 row_block_size_data, &
1184 col_block_size_data, &
1191 ALLOCATE (recv_buf(sum(recv_sizes)))
1194 DO ipe = 1, numprocs
1197 DO ipair = 1, send_pair_count(ipe)
1199 pe, iatom, jatom, send_encode)
1203 IF (.NOT. found)
THEN
1204 cpabort(
"Matrix block not found")
1206 nrows_blk = row_block_size_data(iatom)
1207 ncols_blk = col_block_size_data(jatom)
1208 DO jj = 1, ncols_blk
1209 DO ii = 1, nrows_blk
1211 ind = send_disps(ipe) + send_sizes(ipe) + ii + (jj - 1)*nrows_blk
1212 send_buf(ind) = mat_block(ii, jj)
1215 send_sizes(ipe) = send_sizes(ipe) + nrows_blk*ncols_blk
1221 CALL para_env%alltoall(send_buf, send_sizes, send_disps, &
1222 recv_buf, recv_sizes, recv_disps)
1225 DEALLOCATE (send_buf)
1226 DEALLOCATE (send_sizes)
1227 DEALLOCATE (send_disps)
1228 DEALLOCATE (send_pair_count)
1229 DEALLOCATE (send_pair_disps)
1232 DO ipe = 1, numprocs
1234 DO ipair = 1, recv_pair_count(ipe)
1236 pe, iatom, jatom, recv_encode)
1237 nrows_blk = row_block_size_data(iatom)
1238 ncols_blk = col_block_size_data(jatom)
1239 ind = recv_disps(ipe) + recv_sizes(ipe)
1240 CALL dbcsr_put_block(dbcsr_mat, &
1242 recv_buf((ind + 1):(ind + nrows_blk*ncols_blk)))
1243 recv_sizes(ipe) = recv_sizes(ipe) + nrows_blk*ncols_blk
1248 DEALLOCATE (recv_buf)
1249 DEALLOCATE (recv_sizes)
1250 DEALLOCATE (recv_disps)
1251 DEALLOCATE (recv_pair_count)
1252 DEALLOCATE (recv_pair_disps)
1256 CALL timestop(handle)
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp
integer, parameter, public int_4
Utility routines for the memory handling.
Interface to the message passing library MPI.
subroutine, public fb_com_atom_pairs_init(atom_pairs)
Initialises an fb_com_atom_pairs object, and makes it empty.
integer, parameter, public task_pair
subroutine, public fb_com_atom_pairs_decode(ind, pe, iatom, jatom, natoms)
Decodes a single integer into the (rank, iatom, jatom) index of a communication task to send/receive ...
integer, parameter, public task_src
subroutine, public fb_com_tasks_nullify(com_tasks)
Nullifies a fb_com_tasks object, note that it does not release the original object....
subroutine, public fb_com_tasks_encode_pair(ind, iatom, jatom, natoms)
Encodes (iatom, jatom) pair index of a block into a single integer.
subroutine, public fb_com_tasks_decode_pair(ind, iatom, jatom, natoms)
Dncodes a single integer into (iatom, jatom) pair index of a block into a single.
subroutine, public fb_com_tasks_get(com_tasks, task_dim, ntasks, nencode, tasks)
Gets attributes from a fb_com_tasks object, one should only access the data content in a fb_com_tasks...
subroutine, public fb_com_atom_pairs_distribute_blks(matrix_storage, atom_pairs_send, atom_pairs_recv, para_env, dbcsr_mat)
Given send and recv fb_com_atom_pair object, distribute the matrix blocks stored in a fb_matrix_data ...
subroutine, public fb_com_tasks_build_atom_pairs(com_tasks, atom_pairs, natoms_encode, send_or_recv)
Generate send or receive atom_pair lists from a com_tasks object. atom_pair list is used as a condens...
subroutine, public fb_com_atom_pairs_create(atom_pairs)
Creates and initialises an empty fb_com_atom_pairs object.
subroutine, public fb_com_tasks_transpose_dest_src(tasks_dest_is_me, direction, tasks_src_is_me, para_env)
Start from a local set of tasks that has desc/src process equal to the local MPI rank,...
logical function, public fb_com_atom_pairs_has_data(atom_pairs)
Checks if a fb_com_atom_pairs object is associated with an actual data content or not.
subroutine, public fb_com_atom_pairs_get(atom_pairs, npairs, natoms_encode, pairs)
Gets attributes from a fb_com_atom_pairs object, one should only access the data content in a fb_com_...
subroutine, public fb_com_atom_pairs_nullify(atom_pairs)
Nullifies a fb_com_atom_pairs object, note that it does not release the original object....
subroutine, public fb_com_atom_pairs_release(atom_pairs)
Releases an fb_com_atom_pairs object.
subroutine, public fb_com_tasks_create(com_tasks)
Creates and initialises an empty fb_com_tasks object.
integer, parameter, public task_cost
subroutine, public fb_com_tasks_release(com_tasks)
Releases an fb_com_tasks object.
subroutine, public fb_com_atom_pairs_gather_blks(dbcsr_mat, atom_pairs_send, atom_pairs_recv, para_env, matrix_storage)
Given send and recv fb_com_atom_pair object, gather all the relevant DBCSR matrix blocks together,...
subroutine, public fb_com_tasks_set(com_tasks, task_dim, ntasks, nencode, tasks)
Sets attributes in a fb_com_tasks object, one should only access the data content in a fb_com_tasks o...
integer, parameter, public task_dest
integer, parameter, public task_n_records
subroutine, public fb_com_atom_pairs_calc_buffer_sizes(atom_pairs, nprocs, row_blk_sizes, col_blk_sizes, sendrecv_sizes, sendrecv_disps, sendrecv_pair_counts, sendrecv_pair_disps)
Calculate the MPI send or recv buffer sizes according to the communication pairs (atom_pairs) and DBC...
pure logical function, public fb_matrix_data_has_data(matrix_data)
check if the object has data associated to it
subroutine, public fb_matrix_data_add(matrix_data, row, col, blk)
Add a matrix block to a fb_matrix_data object.
subroutine, public fb_matrix_data_get(matrix_data, row, col, blk_p, found)
retrieve a matrix block from a matrix_data object
All kind of helpful little routines.