dbcsr_copy_sort_data Subroutine

public subroutine dbcsr_copy_sort_data(blk_p, old_blk_p, row_p, col_i, rbs, cbs, dst, src, mark_transposed, transpose_blocks)

Sorts the data in a matrix so that the data blocks follow sequentially and does various transposing options. As opposed to dbcsr_sort_data, this routine calculates block sizes

Arguments

Type IntentOptional Attributes Name
integer, intent(inout), DIMENSION(:) :: blk_p

re-arranged block pointers reflecting the new data order

integer, intent(in), DIMENSION(:) :: old_blk_p

current block pointers index index sizes of the blocked rows sizes of the blocked columns

integer, intent(in), DIMENSION(:) :: row_p

current block pointers index index sizes of the blocked rows sizes of the blocked columns

integer, intent(in), DIMENSION(:) :: col_i

current block pointers index index sizes of the blocked rows sizes of the blocked columns

integer, intent(in), DIMENSION(:) :: rbs

current block pointers index index sizes of the blocked rows sizes of the blocked columns

integer, intent(in), DIMENSION(:) :: cbs

current block pointers index index sizes of the blocked rows sizes of the blocked columns

type(dbcsr_data_obj), intent(inout) :: dst

sorted data

type(dbcsr_data_obj), intent(in) :: src

existing unordered data

logical, intent(in), optional :: mark_transposed

mark data as transposed by negating the blk_p index entries transpose data blocks

logical, intent(in), optional :: transpose_blocks

mark data as transposed by negating the blk_p index entries transpose data blocks


Source Code

   SUBROUTINE dbcsr_copy_sort_data(blk_p, old_blk_p, row_p, col_i, rbs, cbs, &
                                   dst, src, mark_transposed, transpose_blocks)
      !! Sorts the data in a matrix so that the data blocks follow
      !! sequentially and does various transposing options.
      !! As opposed to dbcsr_sort_data, this routine calculates block sizes

      INTEGER, DIMENSION(:), INTENT(INOUT)               :: blk_p
         !! re-arranged block pointers reflecting the new data order
      INTEGER, DIMENSION(:), INTENT(IN)                  :: old_blk_p, row_p, col_i, rbs, cbs
         !! current block pointers
         !! index
         !! index
         !! sizes of the blocked rows
         !! sizes of the blocked columns
      TYPE(dbcsr_data_obj), INTENT(INOUT)                :: dst
         !! sorted data
      TYPE(dbcsr_data_obj), INTENT(IN)                   :: src
         !! existing unordered data
      LOGICAL, INTENT(IN), OPTIONAL                      :: mark_transposed, transpose_blocks
         !! mark data as transposed by negating the blk_p index entries
         !! transpose data blocks

      INTEGER                                            :: blk, col_size, nblks, nrows, nze, &
                                                            nze_prev, row, row_size
      LOGICAL                                            :: mark, trb

!   ---------------------------------------------------------------------------
! Analyze parameters

      mark = .FALSE.
      IF (PRESENT(mark_transposed)) mark = mark_transposed
      trb = .FALSE.
      IF (PRESENT(transpose_blocks)) trb = transpose_blocks
      !
      nblks = SIZE(old_blk_p)
      nrows = SIZE(row_p) - 1
      IF (SIZE(blk_p) < nblks) &
         DBCSR_ABORT('Destination blk_p too small.')
      IF (nblks .GE. 1) &
         blk_p(1) = SGN(1, old_blk_p(1), mark)
      nze_prev = 0
      DO row = 1, nrows
         row_size = rbs(row)
         DO blk = row_p(row) + 1, row_p(row + 1)
            IF (old_blk_p(blk) .NE. 0) THEN
               col_size = cbs(col_i(blk))
               nze = row_size*col_size
               IF (blk .GT. 1) THEN
                  blk_p(blk) = SGN(ABS(blk_p(blk - 1)) + nze_prev, old_blk_p(blk), &
                                   mark)
               END IF
               IF (ABS(blk_p(blk)) + nze - 1 > dbcsr_data_get_size(dst)) &
                  DBCSR_ABORT('Destination data space is too small.')
               IF (.NOT. trb) THEN
                  CALL dbcsr_data_copy(dst=dst, dst_lb=(/ABS(blk_p(blk))/), &
                                       dst_sizes=(/nze/), &
                                       src=src, src_lb=(/ABS(old_blk_p(blk))/), &
                                       src_sizes=(/nze/))
                  !CALL dbcsr_data_set (dst, ABS(blk_p(blk)), nze,&
                  !     src, source_lb=ABS(old_blk_p(blk)))
               ELSE
                  CALL dbcsr_block_transpose(dst, src, &
                                             col_size, row_size, &
                                             lb=ABS(blk_p(blk)), source_lb=ABS(old_blk_p(blk)))
               END IF
               nze_prev = nze
            END IF ! blk exists
         END DO ! blk
      END DO ! row
   END SUBROUTINE dbcsr_copy_sort_data