dbcsr_datablock_redistribute Subroutine

   SUBROUTINE dbcsr_datablock_redistribute(dblk, row_p, col_i, blk_p, &
                                           proc_nblks, proc_darea_sizes, new_matrix)
      !! Redistributes data blocks of a DBCSR matrix read from a file.
      !! This routine should be used with dbcsr_binary_read in the module
      !! dbcsr_io.F

      TYPE(dbcsr_data_obj), INTENT(IN)         :: dblk
         !! data blocks of the DBCSR matrix that the current node possesses after reading the data file
      INTEGER, DIMENSION(:), INTENT(IN), &
         POINTER                                :: row_p, col_i, blk_p, &
                                                   proc_nblks, proc_darea_sizes
         !! row_p of the DBCSR matrix that the current node possesses after reading the data file
         !! col_i of the DBCSR matrix that the current node possesses after reading the data file
         !! blk_p of the DBCSR matrix that the current node possesses after reading the data file
         !! 1D array holding nblks of those nodes of the mp environment, that created the file, whose contents have been read by the
         !! current node of the present mp environment
         !! 1D array holding data_area_size of those nodes of the mp environment, that created the file, whose contents have been
         !! read by the current node of the present mp environment
      TYPE(dbcsr_type), INTENT(INOUT)           :: new_matrix
         !! redistributed matrix

      CHARACTER(LEN=*), PARAMETER :: routineN = 'dbcsr_datablock_redistribute'
      INTEGER, PARAMETER                       :: metalen = 2

      COMPLEX(kind=dp), DIMENSION(:), POINTER, CONTIGUOUS :: c_dp
      COMPLEX(kind=sp), DIMENSION(:), POINTER, CONTIGUOUS :: c_sp
      INTEGER :: bcol, blk, blk_ps, blk_size, blks, brow, col_size, data_type, &
                 dst_p, handle, i, ind, job_count, meta_l, mp_group, &
                 nblkrows_total, numnodes, row_size, src_p, stored_col_new, &
                 stored_row_new
      INTEGER(kind=int_8)                      :: actual_blk, blkp, end_ind, &
                                                  start_ind
      INTEGER(kind=int_8), ALLOCATABLE, &
         DIMENSION(:)                           :: extra_darea_size, extra_nblks
      INTEGER, ALLOCATABLE, DIMENSION(:)       :: rd_disp, recv_meta, rm_disp, &
                                                  sd_disp, sdp, send_meta, &
                                                  sm_disp, smp
      INTEGER, ALLOCATABLE, DIMENSION(:, :)    :: recv_count, send_count, &
                                                  total_recv_count, &
                                                  total_send_count
      INTEGER, DIMENSION(:), POINTER           :: col_blk_size, row_blk_size
      LOGICAL                                  :: sym_tr, tr
      REAL(kind=dp), DIMENSION(:), POINTER, CONTIGUOUS :: r_dp
      REAL(kind=sp), DIMENSION(:), POINTER, CONTIGUOUS :: r_sp
      TYPE(dbcsr_data_obj)                     :: data_block, recv_data, &
                                                  send_data
      TYPE(dbcsr_distribution_obj)             :: dist
      TYPE(dbcsr_mp_obj)                       :: mp_env

      CALL timeset(routineN, handle)

      dist = dbcsr_distribution(new_matrix)
      mp_env = dbcsr_distribution_mp(dist)
      numnodes = dbcsr_mp_numnodes(mp_env)
      mp_group = dbcsr_mp_group(mp_env)

      data_type = dbcsr_get_data_type(new_matrix)
      nblkrows_total = dbcsr_nblkrows_total(new_matrix)
      row_blk_size => array_data(new_matrix%row_blk_size)
      col_blk_size => array_data(new_matrix%col_blk_size)

      ALLOCATE (send_count(2, 0:numnodes - 1))
      ALLOCATE (recv_count(2, 0:numnodes - 1))
      ALLOCATE (total_send_count(2, 0:numnodes - 1))
      ALLOCATE (total_recv_count(2, 0:numnodes - 1))
      ALLOCATE (sdp(0:numnodes - 1))
      ALLOCATE (sd_disp(0:numnodes - 1))
      ALLOCATE (smp(0:numnodes - 1))
      ALLOCATE (sm_disp(0:numnodes - 1))
      ALLOCATE (rd_disp(0:numnodes - 1))
      ALLOCATE (rm_disp(0:numnodes - 1))
      send_count(:, :) = 0
      dst_p = -1

      job_count = COUNT(proc_nblks .NE. 0)

      ALLOCATE (extra_nblks(job_count))
      ALLOCATE (extra_darea_size(job_count))
      IF (job_count > 0) THEN
         CALL cumsum_l(INT((/0, proc_nblks(1:job_count - 1)/), kind=int_8), extra_nblks)
         CALL cumsum_l(INT((/0, proc_darea_sizes(1:job_count - 1)/), kind=int_8), extra_darea_size)
      END IF

      i = 0
      DO ind = 1, job_count*nblkrows_total
         brow = MOD(ind - 1, nblkrows_total) + 1
         IF (brow .EQ. 1) i = i + 1
         row_size = row_blk_size(brow)
         DO blk = row_p(ind + i - 1) + 1, row_p(ind + i)
            actual_blk = INT(blk, kind=int_8) + extra_nblks(i)
            bcol = col_i(actual_blk)
            col_size = col_blk_size(bcol)
            blk_size = row_size*col_size
            sym_tr = .FALSE.
            CALL dbcsr_get_stored_coordinates(new_matrix, brow, bcol, dst_p)
            send_count(1, dst_p) = send_count(1, dst_p) + 1
            send_count(2, dst_p) = send_count(2, dst_p) + blk_size
         END DO
      END DO
      CALL mp_alltoall(send_count, recv_count, 2, mp_group)
      CALL dbcsr_data_init(recv_data)
      CALL dbcsr_data_new(recv_data, data_type, SUM(recv_count(2, :)))
      ALLOCATE (recv_meta(metalen*SUM(recv_count(1, :))))
      CALL dbcsr_data_init(send_data)
      CALL dbcsr_data_new(send_data, data_type, SUM(send_count(2, :)))
      ALLOCATE (send_meta(metalen*SUM(send_count(1, :))))
      DO dst_p = 0, numnodes - 1
         total_send_count(1, dst_p) = send_count(1, dst_p)
         total_send_count(2, dst_p) = send_count(2, dst_p)
         total_recv_count(1, dst_p) = recv_count(1, dst_p)
         total_recv_count(2, dst_p) = recv_count(2, dst_p)
      END DO
      sd_disp = -1; sm_disp = -1; rd_disp = -1; rm_disp = -1
      sd_disp(0) = 1; sm_disp(0) = 1; rd_disp(0) = 1; rm_disp(0) = 1
      DO dst_p = 1, numnodes - 1
         sm_disp(dst_p) = sm_disp(dst_p - 1) + metalen*total_send_count(1, dst_p - 1)
         sd_disp(dst_p) = sd_disp(dst_p - 1) + total_send_count(2, dst_p - 1)
         rm_disp(dst_p) = rm_disp(dst_p - 1) + metalen*total_recv_count(1, dst_p - 1)
         rd_disp(dst_p) = rd_disp(dst_p - 1) + total_recv_count(2, dst_p - 1)
      END DO
      sdp(:) = sd_disp
      smp(:) = sm_disp - metalen

      SELECT CASE (data_type)
      CASE (dbcsr_type_real_4)
         r_sp => dblk%d%r_sp
      CASE (dbcsr_type_real_8)
         r_dp => dblk%d%r_dp
      CASE (dbcsr_type_complex_4)
         c_sp => dblk%d%c_sp
      CASE (dbcsr_type_complex_8)
         c_dp => dblk%d%c_dp
      END SELECT

      CALL dbcsr_data_init(data_block)
      CALL dbcsr_data_new(data_block, data_type)
      i = 0
      dst_p = -1
      DO ind = 1, job_count*nblkrows_total
         brow = MOD(ind - 1, nblkrows_total) + 1
         IF (brow .EQ. 1) i = i + 1
         row_size = row_blk_size(brow)
         DO blk = row_p(ind + i - 1) + 1, row_p(ind + i)
            actual_blk = INT(blk, kind=int_8) + extra_nblks(i)
            bcol = col_i(actual_blk)
            col_size = col_blk_size(bcol)
            blk_size = row_size*col_size
            blkp = INT(blk_p(actual_blk), kind=int_8)
            start_ind = blkp + extra_darea_size(i)
            end_ind = blkp + extra_darea_size(i) + blk_size - 1

            SELECT CASE (data_type)
            CASE (dbcsr_type_real_4)
               data_block%d%r_sp => r_sp(start_ind:end_ind)
            CASE (dbcsr_type_real_8)
               data_block%d%r_dp => r_dp(start_ind:end_ind)
            CASE (dbcsr_type_complex_4)
               data_block%d%c_sp => c_sp(start_ind:end_ind)
            CASE (dbcsr_type_complex_8)
               data_block%d%c_dp => c_dp(start_ind:end_ind)
            END SELECT
            sym_tr = .FALSE.
            CALL dbcsr_get_stored_coordinates(new_matrix, brow, bcol, dst_p)
            smp(dst_p) = smp(dst_p) + metalen
            tr = .FALSE.
!           IF (tr) THEN
!              send_meta(smp(dst_p)) = -brow
!           ELSE
            send_meta(smp(dst_p)) = brow
!           ENDIF
            send_meta(smp(dst_p) + 1) = bcol
            blk_size = dbcsr_data_get_size(data_block)

            CALL dbcsr_data_set(send_data, lb=sdp(dst_p), &
                                data_size=blk_size, src=data_block, source_lb=1)
            sdp(dst_p) = sdp(dst_p) + blk_size
         END DO
      END DO
      CALL dbcsr_data_clear_pointer(data_block)

      SELECT CASE (data_type)
      CASE (dbcsr_type_real_4)
         CALL hybrid_alltoall_s1( &
            send_data%d%r_sp(:), total_send_count(2, :), sd_disp(:) - 1, &
            recv_data%d%r_sp(:), total_recv_count(2, :), rd_disp(:) - 1, &
            mp_env)
      CASE (dbcsr_type_real_8)
         CALL hybrid_alltoall_d1( &
            send_data%d%r_dp(:), total_send_count(2, :), sd_disp(:) - 1, &
            recv_data%d%r_dp(:), total_recv_count(2, :), rd_disp(:) - 1, &
            mp_env)
      CASE (dbcsr_type_complex_4)
         CALL hybrid_alltoall_c1( &
            send_data%d%c_sp(:), total_send_count(2, :), sd_disp(:) - 1, &
            recv_data%d%c_sp(:), total_recv_count(2, :), rd_disp(:) - 1, &
            mp_env)
      CASE (dbcsr_type_complex_8)
         CALL hybrid_alltoall_z1( &
            send_data%d%c_dp(:), total_send_count(2, :), sd_disp(:) - 1, &
            recv_data%d%c_dp(:), total_recv_count(2, :), rd_disp(:) - 1, &
            mp_env)
      END SELECT
      CALL hybrid_alltoall_i1(send_meta(:), metalen*total_send_count(1, :), sm_disp(:) - 1, &
                              recv_meta(:), metalen*total_recv_count(1, :), rm_disp(:) - 1, mp_env)
      CALL dbcsr_work_create(new_matrix, SUM(recv_count(1, :)), &
                             SUM(recv_count(2, :)), work_mutable=.FALSE., n=1)

      blk_ps = 1
      blks = 0
      DO src_p = 0, numnodes - 1
         DO meta_l = 1, recv_count(1, src_p)
            brow = recv_meta(rm_disp(src_p) + metalen*(meta_l - 1))
            tr = brow .LT. 0
            stored_row_new = ABS(brow)
            stored_col_new = recv_meta(rm_disp(src_p) + metalen*(meta_l - 1) + 1)
            blk_size = row_blk_size(stored_row_new)*col_blk_size(stored_col_new)

            data_block = pointer_view(data_block, recv_data, blk_ps, blk_size)
            CALL dbcsr_put_block(new_matrix, stored_row_new, stored_col_new, data_block, transposed=tr)

            blk_ps = blk_ps + blk_size
            blks = blks + 1
         END DO
      END DO
      CALL dbcsr_data_clear_pointer(data_block)
      DEALLOCATE (data_block%d)
      CALL dbcsr_finalize(new_matrix, reshuffle=.TRUE.)
      CALL dbcsr_data_release(recv_data)
      CALL dbcsr_data_release(send_data)

      DEALLOCATE (send_count)
      DEALLOCATE (recv_count)
      DEALLOCATE (sdp); DEALLOCATE (sd_disp)
      DEALLOCATE (smp); DEALLOCATE (sm_disp)
      DEALLOCATE (rd_disp)
      DEALLOCATE (rm_disp)
      DEALLOCATE (recv_meta)
      DEALLOCATE (send_meta)
      DEALLOCATE (extra_nblks); DEALLOCATE (extra_darea_size)

      CALL timestop(handle)
   CONTAINS

      SUBROUTINE cumsum_l(arr, cumsum)
         INTEGER(kind=int_8), DIMENSION(:), INTENT(IN)      :: arr
         INTEGER(kind=int_8), DIMENSION(:), INTENT(OUT)     :: cumsum

         INTEGER                                            :: i

         IF (SIZE(cumsum) > 0) THEN
            cumsum(1) = arr(1)
            DO i = 2, SIZE(cumsum)
               cumsum(i) = cumsum(i - 1) + arr(i)
            END DO
         END IF
      END SUBROUTINE cumsum_l
   END SUBROUTINE dbcsr_datablock_redistribute