dbcsr_get_block_p_area Subroutine

   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