Gets a block from a dbcsr matrix as a data area
Data area The pointer encapsulated in the data area points to data stored in the matrix. It must be 2-dimensional.
| 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 |
||
| type(dbcsr_data_obj), | intent(inout) | :: | block |
the block to get |
||
| logical, | intent(out) | :: | tr |
whether the data is transposed whether the block exists in the matrix |
||
| logical, | intent(out) | :: | found |
whether the data is transposed 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_area(matrix, row, col, block, tr, found, &
row_size, col_size)
!! Gets a block from a dbcsr matrix as a data area
!!
!! Data area
!! The pointer encapsulated in the data area points to data stored in the
!! matrix. It must be 2-dimensional.
TYPE(dbcsr_type), INTENT(IN) :: matrix
!! DBCSR matrix
INTEGER, INTENT(IN) :: row, col
!! the row
!! the column
TYPE(dbcsr_data_obj), INTENT(INOUT) :: block
!! the block to get
LOGICAL, INTENT(OUT) :: tr, found
!! whether the data is transposed
!! 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_block_p_area'
INTEGER :: blk, csize, error_handle, iw, offset, &
rsize, stored_col, stored_row
LOGICAL :: stored_tr
TYPE(btree_data_cp2d) :: data_block_c
TYPE(btree_data_dp2d) :: data_block_d
TYPE(btree_data_sp2d) :: data_block_s
TYPE(btree_data_zp2d) :: data_block_z
! ---------------------------------------------------------------------------
IF (careful_mod) CALL timeset(routineN, error_handle)
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
CALL dbcsr_data_clear_pointer(block)
IF (found) THEN
CALL dbcsr_set_block_pointer(matrix, block, rsize, csize, stored_tr, offset)
ELSEIF (ASSOCIATED(matrix%wms)) THEN
iw = 1
!$ 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_mutable_instantiated(matrix%wms(iw)%mutable)) THEN
SELECT CASE (block%d%data_type)
CASE (dbcsr_type_real_4_2d)
CALL btree_find( &
matrix%wms(iw)%mutable%m%btree_s, &
make_coordinate_tuple(stored_row, stored_col), &
data_block_s, found)
IF (found) THEN
CALL dbcsr_data_set_pointer(block, data_block_s%p)
END IF
CASE (dbcsr_type_real_8_2d)
CALL btree_find( &
matrix%wms(iw)%mutable%m%btree_d, &
make_coordinate_tuple(stored_row, stored_col), &
data_block_d, found)
IF (found) THEN
CALL dbcsr_data_set_pointer(block, data_block_d%p)
END IF
CASE (dbcsr_type_complex_4_2d)
CALL btree_find( &
matrix%wms(iw)%mutable%m%btree_c, &
make_coordinate_tuple(stored_row, stored_col), &
data_block_c, found)
IF (found) THEN
CALL dbcsr_data_set_pointer(block, data_block_c%p)
END IF
CASE (dbcsr_type_complex_8_2d)
CALL btree_find( &
matrix%wms(iw)%mutable%m%btree_z, &
make_coordinate_tuple(stored_row, stored_col), &
data_block_z, found)
IF (found) THEN
CALL dbcsr_data_set_pointer(block, data_block_z%p)
END IF
CASE default
DBCSR_ABORT("Only 2-D data for block pointers!")
END SELECT
END IF
END IF
IF (careful_mod) CALL timestop(error_handle)
END SUBROUTINE dbcsr_get_block_p_area