dbcsr_distribute Subroutine

   SUBROUTINE dbcsr_distribute(matrix, fast)
      !! Distributes a matrix that is currently replicated.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! matrix to replicate
      LOGICAL, INTENT(in), OPTIONAL                      :: fast
         !! change just the index, don't touch the data

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_distribute'

      COMPLEX(KIND=dp), DIMENSION(:), POINTER, CONTIGUOUS :: c_dp
      COMPLEX(KIND=sp), DIMENSION(:), POINTER, CONTIGUOUS :: c_sp
      INTEGER                                            :: blk, col, handle, mynode, nblks, nze, p, &
                                                            row
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: col_blk_size, row_blk_size, tmp_index
      LOGICAL                                            :: mini, tr
      REAL(KIND=dp), DIMENSION(:), POINTER, CONTIGUOUS   :: r_dp
      REAL(KIND=sp), DIMENSION(:), POINTER, CONTIGUOUS   :: r_sp
      TYPE(dbcsr_data_obj)                               :: tmp_data
      TYPE(dbcsr_distribution_obj)                       :: dist
      TYPE(dbcsr_iterator)                               :: iter
      TYPE(dbcsr_mp_obj)                                 :: mp_obj
      TYPE(dbcsr_type)                                   :: distributed

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      IF (.NOT. dbcsr_valid_index(matrix)) &
         DBCSR_ABORT("Matrix not initialized.")
      IF (matrix%replication_type .EQ. dbcsr_repl_none) &
         DBCSR_WARN("Distributing a non-replicated matrix makes no sense.")
      IF (PRESENT(fast)) THEN
         mini = fast
      ELSE
         mini = .FALSE.
      END IF
      SELECT CASE (matrix%data_type)
      CASE (dbcsr_type_real_8)
         CALL dbcsr_get_data(matrix%data_area, r_dp)
      CASE (dbcsr_type_real_4)
         CALL dbcsr_get_data(matrix%data_area, r_sp)
         DBCSR_ABORT("Only real double precision")
      CASE (dbcsr_type_complex_8)
         CALL dbcsr_get_data(matrix%data_area, c_dp)
         DBCSR_ABORT("Only real double precision")
      CASE (dbcsr_type_complex_4)
         CALL dbcsr_get_data(matrix%data_area, c_sp)
         DBCSR_ABORT("Only real double precision")
      END SELECT
      row_blk_size => array_data(matrix%row_blk_size)
      col_blk_size => array_data(matrix%col_blk_size)
      dist = dbcsr_distribution(matrix)
      mp_obj = dbcsr_distribution_mp(dist)
      mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dist))
      !
      IF (mini) THEN
         ! We just mark the blocks as deleted.
         CALL dbcsr_iterator_start(iter, matrix)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
            tr = .FALSE.
            CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
            IF (mynode .EQ. p) THEN
               matrix%blk_p(blk) = 0
            END IF
         END DO
         CALL dbcsr_iterator_stop(iter)
         matrix%replication_type = dbcsr_repl_none
      ELSE
         CALL dbcsr_create(distributed, name='Distributed '//TRIM(matrix%name), &
                           template=matrix, &
                           matrix_type=dbcsr_type_no_symmetry, &
                           replication_type=dbcsr_repl_none)
         distributed%replication_type = dbcsr_repl_none
         ! First count how many blocks are local.
         nze = 0
         nblks = 0
         CALL dbcsr_iterator_start(iter, matrix)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
            tr = .FALSE.
            CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
            IF (mynode .EQ. p) THEN
               nze = nze + row_blk_size(row)*col_blk_size(col)
               nblks = nblks + 1
            END IF
         END DO
         CALL dbcsr_iterator_stop(iter)
         ! Preallocate the array
         CALL dbcsr_work_create(distributed, nblks_guess=nblks, &
                                sizedata_guess=nze, work_mutable=.FALSE.)
         ! Now actually do the work
         CALL dbcsr_iterator_start(iter, matrix)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
            tr = .FALSE.
            CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
            IF (mynode .EQ. p) THEN
               CALL dbcsr_put_block(distributed, row, col, r_dp, transposed=tr)
            END IF
         END DO
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_finalize(distributed)
         ! Now replace the data and index
         CALL dbcsr_switch_data_area(matrix, distributed%data_area, &
                                     previous_data_area=tmp_data)
         CALL dbcsr_switch_data_area(distributed, tmp_data)
         CALL dbcsr_data_release(tmp_data)
         tmp_index => matrix%index
         matrix%index => distributed%index
         distributed%index => tmp_index
         CALL dbcsr_repoint_index(matrix)
         matrix%nze = distributed%nze
         matrix%nblks = distributed%nblks
         CALL dbcsr_release(distributed)
      END IF
      CALL timestop(handle)
   END SUBROUTINE dbcsr_distribute