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