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
Type | Intent | Optional | 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 |
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