dbcsr_make_untransposed_blocks Subroutine

public subroutine dbcsr_make_untransposed_blocks(matrix)

Detransposes all blocks in a matrix

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(inout) :: matrix

DBCSR matrix


Contents


Source Code

   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