Detransposes all blocks in a matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
DBCSR matrix |
SUBROUTINE dbcsr_make_untransposed_blocks(matrix)
!! Detransposes all blocks in a matrix
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! DBCSR matrix
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_make_untransposed_blocks'
INTEGER :: blk, col, col_size, handle, row, row_size
INTEGER, DIMENSION(:), POINTER :: cbs, rbs
LOGICAL :: sym_negation, tr
TYPE(dbcsr_data_obj) :: block_data
TYPE(dbcsr_iterator) :: iter
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
rbs => dbcsr_row_block_sizes(matrix)
cbs => dbcsr_col_block_sizes(matrix)
sym_negation = matrix%negate_real
!$OMP PARALLEL DEFAULT(NONE) PRIVATE(block_data,iter,row,col,tr,blk,row_size,col_size) &
!$OMP SHARED(matrix,rbs,cbs,sym_negation)
CALL dbcsr_data_init(block_data)
CALL dbcsr_data_new(block_data, dbcsr_get_data_type(matrix))
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, block_data, &
transposed=tr, &
block_number=blk)
IF (tr) THEN
row_size = rbs(row)
col_size = cbs(col)
CALL dbcsr_block_transpose(block_data, col_size, row_size)
IF (sym_negation) THEN
SELECT CASE (block_data%d%data_type)
CASE (dbcsr_type_real_4)
block_data%d%r_sp(:) = -block_data%d%r_sp(:)
CASE (dbcsr_type_real_8)
block_data%d%r_dp(:) = -block_data%d%r_dp(:)
CASE (dbcsr_type_complex_4)
block_data%d%c_sp(:) = -block_data%d%c_sp(:)
CASE (dbcsr_type_complex_8)
block_data%d%c_dp(:) = -block_data%d%c_dp(:)
END SELECT
END IF
matrix%blk_p(blk) = -matrix%blk_p(blk)
END IF
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_data_clear_pointer(block_data)
CALL dbcsr_data_release(block_data)
!$OMP END PARALLEL
CALL timestop(handle)
END SUBROUTINE dbcsr_make_untransposed_blocks