dbcsr_merge_single_wm Subroutine

   SUBROUTINE dbcsr_merge_single_wm(matrix)
      !! Sort data from the WM into the final matrix, based closely on dbcsr_merge_all

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! matrix to work on

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_merge_single_wm'
      LOGICAL, PARAMETER                                 :: dbg = .FALSE.

      INTEGER                                            :: handle, nblks, nrows
      INTEGER, ALLOCATABLE, DIMENSION(:), SAVE           :: new_blk_p_sorted, new_blk_sizes, &
                                                            new_row_p
      INTEGER, ALLOCATABLE, DIMENSION(:), SAVE, TARGET   :: blk_d
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS, SAVE   :: cbs, rbs
      TYPE(dbcsr_work_type), POINTER                     :: wm

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)

      ! Outline:
      ! There is a single work matrix.  Data blocks are sorted and copied
      ! into the matrix data area (which is empty).  The index is made consistent

      nrows = matrix%nblkrows_total
      wm => matrix%wms(1)
      nblks = wm%lastblk
      IF (dbcsr_wm_use_mutable(wm)) &
         DBCSR_ABORT("Number of threads does not match number of work matrices.")
      !
      ! The following is valid because the data actually referenced
      ! by blocks is explicitly calculated in dbcsr_finalize.
!$OMP     MASTER
      rbs => array_data(matrix%row_blk_size)
      cbs => array_data(matrix%col_blk_size)
      !
      ! Initializations
      !
      ALLOCATE (new_row_p(nrows + 1))
      ALLOCATE (blk_d(nblks))
      ALLOCATE (new_blk_p_sorted(nblks))
      ALLOCATE (new_blk_sizes(nblks))
      !
      ! Master thread creates a row_p index for the (sorted) blocks.
      CALL dbcsr_sort_indices(nblks, wm%row_i, wm%col_i, wm%blk_p)
      CALL dbcsr_make_dbcsr_index(new_row_p, wm%row_i, nrows, nblks)
      !
      !
      ! The matrix data area is resized.  Blocks from the work
      ! matrices will be copied into it in order.
      !
      CALL dbcsr_data_ensure_size(matrix%data_area, wm%datasize, nocopy=.TRUE.)
!$OMP     END MASTER
!$OMP     BARRIER
      CALL dbcsr_calc_block_sizes(new_blk_sizes, &
                                  new_row_p, wm%col_i, rbs, cbs)
      CALL dbcsr_sort_data(new_blk_p_sorted, wm%blk_p, &
                           new_blk_sizes, dsts=matrix%data_area, &
                           src=wm%data_area)
      !
      ! Creates a new index array.
      !
!$OMP     BARRIER
!$OMP     MASTER
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_row_p)
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_col_i)
      CALL dbcsr_clearfrom_index_array(matrix, dbcsr_slot_blk_p)
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_row_p, &
                                   DATA=new_row_p(1:nrows + 1), extra=nblks*2)
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_col_i, &
                                   DATA=wm%col_i(1:nblks))
      CALL dbcsr_addto_index_array(matrix, dbcsr_slot_blk_p, &
                                   DATA=new_blk_p_sorted)
      matrix%nblks = nblks
      matrix%nze = wm%datasize
      matrix%index(dbcsr_slot_nblks) = matrix%nblks
      matrix%index(dbcsr_slot_nze) = matrix%nze
      CALL dbcsr_repoint_index(matrix)
      DEALLOCATE (new_row_p)
      DEALLOCATE (new_blk_sizes)
      DEALLOCATE (new_blk_p_sorted)
      DEALLOCATE (blk_d)
!$OMP     END MASTER
      IF (dbg) WRITE (*, *) routineN//" stopped"
      CALL timestop(handle)
   END SUBROUTINE dbcsr_merge_single_wm