dbcsr_get_block_p_s Subroutine

private subroutine dbcsr_get_block_p_s(matrix, row, col, block, tr, found, row_size, col_size)

Gets a 1-d block from a dbcsr matrix

Arguments

Type IntentOptional 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_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


Source Code

      SUBROUTINE dbcsr_get_block_p_s (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_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_real_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, 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_s