Sort data from the WM into the final matrix, based closely on dbcsr_merge_all
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
matrix to work on |
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