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 |
||
complex(kind=real_4), | 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_c (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 COMPLEX(kind=real_4), 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_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 ! block => pointer_view( & dbcsr_get_data_p(matrix%data_area, CMPLX(0.0, 0.0, real_4)), 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_c