Gets a 2-d block from a dbcsr matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
DBCSR matrix |
||
integer, | intent(in) | :: | row |
the row the column |
||
integer, | intent(in) | :: | col |
the row the column |
||
complex(kind=real_4), | DIMENSION(:, :), POINTER | :: | block |
the block to get (rank-2 array) |
||
logical, | intent(out) | :: | tr |
whether the data is transposed |
||
logical, | intent(out) | :: | found |
whether the block exists in the matrix |
||
integer, | intent(out), | optional | :: | row_size |
logical row size of block logical column size of block |
|
integer, | intent(out), | optional | :: | col_size |
logical row size of block logical column size of block |
SUBROUTINE dbcsr_get_2d_block_p_c (matrix, row, col, block, tr, found, &
row_size, col_size)
!! Gets a 2-d block from a dbcsr matrix
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! DBCSR matrix
INTEGER, INTENT(IN) :: row, col
!! the row
!! the column
COMPLEX(kind=real_4), DIMENSION(:, :), POINTER :: block
!! the block to get (rank-2 array)
LOGICAL, INTENT(OUT) :: tr
!! whether the data is transposed
LOGICAL, INTENT(OUT) :: found
!! whether the block exists in the matrix
INTEGER, INTENT(OUT), OPTIONAL :: row_size, col_size
!! logical row size of block
!! logical column size of block
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_get_2d_block_p_c'
COMPLEX(kind=real_4), DIMENSION(:), POINTER :: block_1d
INTEGER :: rsize, csize, &
blk, nze, offset, &
stored_row, &
stored_col, iw, nwms
INTEGER :: error_handle
TYPE(btree_data_cp2d) :: data_block
LOGICAL :: stored_tr
COMPLEX(kind=real_4), DIMENSION(1, 1), TARGET, SAVE :: block0
! ---------------------------------------------------------------------------
IF (careful_mod) CALL timeset(routineN, error_handle)
IF (debug_mod) THEN
IF (matrix%data_type /= dbcsr_type_complex_4) &
DBCSR_ABORT("Data type mismatch for requested block.")
END IF
CALL dbcsr_get_block_index(matrix, row, col, stored_row, stored_col, &
stored_tr, found, blk, offset)
tr = stored_tr
rsize = dbcsr_blk_row_size(matrix, stored_row)
csize = dbcsr_blk_column_size(matrix, stored_col)
IF (PRESENT(row_size)) row_size = rsize
IF (PRESENT(col_size)) col_size = csize
NULLIFY (block)
IF (found) THEN
nze = rsize*csize
IF (nze .eq. 0) THEN
found = .TRUE.
block => block0(1:0, 1:0)
ELSE
block_1d => pointer_view(dbcsr_get_data_p( &
matrix%data_area, CMPLX(0.0, 0.0, real_4)), offset, offset + nze - 1)
CALL dbcsr_set_block_pointer(matrix, block, rsize, csize, offset)
END IF
ELSEIF (ASSOCIATED(matrix%wms)) THEN
nwms = SIZE(matrix%wms)
iw = 1
!$ IF (nwms < omp_get_num_threads()) &
!$ DBCSR_ABORT("Number of work matrices not equal to number of threads")
!$ iw = omp_get_thread_num() + 1
IF (.NOT. dbcsr_use_mutable(matrix)) &
DBCSR_ABORT("Can not retrieve blocks from non-mutable work matrices.")
IF (dbcsr_use_mutable(matrix)) THEN
IF (.NOT. dbcsr_mutable_instantiated(matrix%wms(iw)%mutable)) THEN
CALL dbcsr_mutable_new(matrix%wms(iw)%mutable, &
dbcsr_get_data_type(matrix))
END IF
CALL btree_find( &
matrix%wms(iw)%mutable%m%btree_c, &
make_coordinate_tuple(stored_row, stored_col), &
data_block, found)
IF (found) THEN
block => data_block%p
END IF
END IF
END IF
IF (careful_mod) CALL timestop(error_handle)
END SUBROUTINE dbcsr_get_2d_block_p_c