dbcsr_get_2d_block_p_s Subroutine

      SUBROUTINE dbcsr_get_2d_block_p_s (matrix, row, col, block, tr, found, &
                                                     row_size, col_size)
     !! Gets a 2-d block from a dbcsr matrix

         TYPE(dbcsr_type), INTENT(INOUT)           :: matrix
        !! DBCSR matrix
         INTEGER, INTENT(IN)                      :: row, col
        !! the row
        !! the column
         REAL(kind=real_4), DIMENSION(:, :), POINTER         :: block
        !! the block to get (rank-2 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

         CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_get_2d_block_p_s'

         REAL(kind=real_4), DIMENSION(:), POINTER         :: block_1d
         INTEGER                                  :: rsize, csize, &
                                                     blk, nze, offset, &
                                                     stored_row, &
                                                     stored_col, iw, nwms
         INTEGER                                  :: error_handle
         TYPE(btree_data_sp2d)          :: data_block
         LOGICAL                                  :: stored_tr
         REAL(kind=real_4), DIMENSION(1, 1), TARGET, SAVE    :: block0
!   ---------------------------------------------------------------------------
         IF (careful_mod) CALL timeset(routineN, error_handle)
         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
            IF (nze .eq. 0) THEN
               found = .TRUE.
               block => block0(1:0, 1:0)
            ELSE
               block_1d => pointer_view(dbcsr_get_data_p( &
                                        matrix%data_area, 0.0_real_4), offset, offset + nze - 1)
               CALL dbcsr_set_block_pointer(matrix, block, rsize, csize, offset)
            END IF
         ELSEIF (ASSOCIATED(matrix%wms)) THEN
            nwms = SIZE(matrix%wms)
            iw = 1
!$          IF (nwms < omp_get_num_threads()) &
!$             DBCSR_ABORT("Number of work matrices not equal to number of threads")
!$          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_use_mutable(matrix)) THEN
               IF (.NOT. dbcsr_mutable_instantiated(matrix%wms(iw)%mutable)) THEN
                  CALL dbcsr_mutable_new(matrix%wms(iw)%mutable, &
                                         dbcsr_get_data_type(matrix))
               END IF
               CALL btree_find( &
                  matrix%wms(iw)%mutable%m%btree_s, &
                  make_coordinate_tuple(stored_row, stored_col), &
                  data_block, found)
               IF (found) THEN
                  block => data_block%p
               END IF
            END IF
         END IF
         IF (careful_mod) CALL timestop(error_handle)
      END SUBROUTINE dbcsr_get_2d_block_p_s