Shuffles the data from blocked to standard dense form
Used for making matrices dense/undense
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix |
Existing blocked matrix |
||
type(dbcsr_data_obj), | intent(inout) | :: | dense_data |
Dense data |
||
integer, | intent(in) | :: | nfullrows |
size of new data size of new data |
||
integer, | intent(in) | :: | nfullcols |
size of new data size of new data |
||
integer, | intent(in), | DIMENSION(:) | :: | und_row_blk_offsets | ||
integer, | intent(in), | DIMENSION(:) | :: | und_col_blk_offsets | ||
integer, | intent(in), | DIMENSION(:) | :: | dense_row_blk_offsets | ||
integer, | intent(in), | DIMENSION(:) | :: | dense_col_blk_offsets | ||
integer, | intent(in), | DIMENSION(:) | :: | row_map | ||
integer, | intent(in), | DIMENSION(:) | :: | col_map | ||
integer, | intent(in), | DIMENSION(:) | :: | row_internal_offsets | ||
integer, | intent(in), | DIMENSION(:) | :: | col_internal_offsets | ||
logical, | intent(in) | :: | join_rows |
make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed |
||
logical, | intent(in) | :: | join_cols |
make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed |
||
logical, | intent(in) | :: | make_tr |
make rows dense, default is yes make columns dense, default is yes make the dense blocks transposed |
SUBROUTINE make_dense_data(matrix, dense_data, nfullrows, nfullcols, &
und_row_blk_offsets, und_col_blk_offsets, &
dense_row_blk_offsets, dense_col_blk_offsets, &
row_map, col_map, &
row_internal_offsets, col_internal_offsets, &
join_rows, join_cols, make_tr)
!! Shuffles the data from blocked to standard dense form
!! @note Used for making matrices dense/undense
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! Existing blocked matrix
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dense_data
!! Dense data
INTEGER, INTENT(IN) :: nfullrows, nfullcols
!! size of new data
!! size of new data
INTEGER, DIMENSION(:), INTENT(IN) :: und_row_blk_offsets, und_col_blk_offsets, &
dense_row_blk_offsets, dense_col_blk_offsets, row_map, col_map, row_internal_offsets, &
col_internal_offsets
LOGICAL, INTENT(IN) :: join_rows, join_cols, make_tr
!! make rows dense, default is yes
!! make columns dense, default is yes
!! make the dense blocks transposed
CHARACTER(len=*), PARAMETER :: routineN = 'make_dense_data'
INTEGER :: blk_col, blk_col_size, blk_row, blk_row_size, dense_col, dense_row, error_handle, &
target_col_offset, target_cs, target_offset, target_row_offset, target_rs, tco, tro
LOGICAL :: tr
TYPE(dbcsr_data_obj) :: block
TYPE(dbcsr_iterator) :: iter
! ---------------------------------------------------------------------------
CALL timeset(routineN, error_handle)
IF (dbcsr_data_get_size(dense_data) < nfullrows*nfullcols) &
DBCSR_ABORT("Dense data too small")
IF (.NOT. join_cols .AND. .NOT. join_rows) &
DBCSR_WARN("Joining neither rows nor columns is untested")
!
CALL dbcsr_data_clear(dense_data)
IF (dbcsr_data_get_size(matrix%data_area) .GT. 0 &
.AND. nfullrows .GT. 0 .AND. nfullcols .GT. 0) THEN
!$OMP PARALLEL DEFAULT(NONE) &
!$OMP PRIVATE (block, iter, &
!$OMP target_rs, target_cs, blk_row, blk_col, tr, blk_row_size, blk_col_size,&
!$OMP tro, tco, target_offset,&
!$OMP target_row_offset, target_col_offset,&
!$OMP dense_row, dense_col) &
!$OMP SHARED (&
!$OMP dense_data, matrix, &
!$OMP make_tr, join_rows, join_cols, &
!$OMP und_row_blk_offsets, und_col_blk_offsets,&
!$OMP dense_row_blk_offsets, dense_col_blk_offsets,&
!$OMP row_internal_offsets, col_internal_offsets,&
!$OMP row_map, col_map,&
!$OMP nfullrows, nfullcols)
CALL dbcsr_data_init(block)
CALL dbcsr_data_new(block, &
dbcsr_type_1d_to_2d(dbcsr_data_get_type(dense_data)))
CALL dbcsr_iterator_start(iter, matrix, dynamic=.TRUE., shared=.TRUE., &
contiguous_pointers=.FALSE., read_only=.TRUE.)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, blk_row, blk_col, block, tr, &
row_size=blk_row_size, col_size=blk_col_size)
dense_row = row_map(blk_row)
dense_col = col_map(blk_col)
!
! Calculate the target block row/column size and the offset
! within the target block where the undense block is placed.
IF (join_rows) THEN
target_row_offset = dense_row_blk_offsets(dense_row)
target_rs = dense_row_blk_offsets(dense_row + 1) - &
dense_row_blk_offsets(dense_row)
tro = 1 + row_internal_offsets(blk_row)
ELSE
target_row_offset = und_row_blk_offsets(blk_row)
target_rs = blk_row_size
tro = 1
END IF
IF (join_cols) THEN
target_col_offset = dense_col_blk_offsets(dense_col)
target_cs = dense_col_blk_offsets(dense_col + 1) - &
dense_col_blk_offsets(dense_col)
tco = 1 + col_internal_offsets(blk_col)
ELSE
target_col_offset = und_col_blk_offsets(blk_col)
target_cs = blk_col_size
tco = 1
END IF
target_offset = (target_row_offset - 1)*nfullcols &
+ (target_col_offset - 1)*( &
dense_row_blk_offsets(dense_row + 1) - &
dense_row_blk_offsets(dense_row))
CALL dbcsr_block_partial_copy(dst=dense_data, &
dst_offset=target_offset, &
dst_rs=target_rs, dst_cs=target_cs, dst_tr=make_tr, &
dst_r_lb=tro, dst_c_lb=tco, &
src=block, src_rs=blk_row_size, src_cs=blk_col_size, src_tr=tr, &
src_r_lb=1, src_c_lb=1, nrow=blk_row_size, ncol=blk_col_size)
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_data_clear_pointer(block)
CALL dbcsr_data_release(block)
!$OMP END PARALLEL
END IF
CALL timestop(error_handle)
END SUBROUTINE make_dense_data