Shuffles the data from blocked to standard dense form
Note
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