Gets a 1-d block from a dbcsr matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | matrix |
DBCSR matrix |
||
integer, | intent(in) | :: | row |
the row the column |
||
integer, | intent(in) | :: | col |
the row the column |
||
real(kind=real_8), | DIMENSION(:), POINTER | :: | block |
the block to get (rank-1 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_block_p_d (matrix, row, col, block, tr, found, &
row_size, col_size)
!! Gets a 1-d block from a dbcsr matrix
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! DBCSR matrix
INTEGER, INTENT(IN) :: row, col
!! the row
!! the column
REAL(kind=real_8), DIMENSION(:), POINTER :: block
!! the block to get (rank-1 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
INTEGER :: blk, csize, &
nze, offset, &
rsize, stored_row, &
stored_col
LOGICAL :: stored_tr
! ---------------------------------------------------------------------------
IF (debug_mod) THEN
IF (matrix%data_type /= dbcsr_type_real_8) &
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
!
block => pointer_view( &
dbcsr_get_data_p(matrix%data_area, 0.0_real_8), offset, offset + nze - 1 &
)
ELSEIF (ASSOCIATED(matrix%wms)) THEN
IF (.NOT. dbcsr_use_mutable(matrix)) &
DBCSR_ABORT("Can not retrieve blocks from non-mutable work matrices.")
IF (dbcsr_use_mutable(matrix)) &
DBCSR_ABORT("Can not retrieve rank-1 block pointers from mutable work matrices.")
END IF
END SUBROUTINE dbcsr_get_block_p_d