Sorts the data in a matrix so that the data blocks follow sequentially.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(inout), | DIMENSION(:) | :: | blk_p |
re-arranged block pointers reflecting the new data order |
|
integer, | intent(in), | DIMENSION(:) | :: | old_blk_p |
current block pointers sizes of the data blocks |
|
integer, | intent(in), | DIMENSION(:) | :: | sizes |
current block pointers sizes of the data blocks |
|
type(dbcsr_data_obj), | intent(inout) | :: | dsts |
sorted data |
||
type(dbcsr_data_obj), | intent(in) | :: | src |
existing unordered data |
||
type(dbcsr_data_obj), | intent(in), | optional, | DIMENSION(:) | :: | srcs |
multiple source areas |
integer, | intent(in), | optional, | DIMENSION(:) | :: | old_blk_d |
SUBROUTINE dbcsr_sort_data(blk_p, old_blk_p, sizes, dsts, src, &
srcs, old_blk_d)
!! Sorts the data in a matrix so that the data blocks follow
!! sequentially.
INTEGER, DIMENSION(:), INTENT(INOUT) :: blk_p
!! re-arranged block pointers reflecting the new data order
INTEGER, DIMENSION(:), INTENT(IN) :: old_blk_p, sizes
!! current block pointers
!! sizes of the data blocks
TYPE(dbcsr_data_obj), INTENT(INOUT) :: dsts
!! sorted data
TYPE(dbcsr_data_obj), INTENT(IN) :: src
!! existing unordered data
TYPE(dbcsr_data_obj), DIMENSION(:), INTENT(IN), &
OPTIONAL :: srcs
!! multiple source areas
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: old_blk_d
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_sort_data'
INTEGER :: handle, i, nblks
LOGICAL :: multidata
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
multidata = PRESENT(srcs) .AND. PRESENT(old_blk_d)
nblks = SIZE(old_blk_p)
IF (nblks .GT. 0) THEN
!$OMP BARRIER
!$OMP MASTER
blk_p(1) = SIGN(1, old_blk_p(1))
DO i = 2, nblks
blk_p(i) = SIGN(ABS(blk_p(i - 1)) + sizes(i - 1), old_blk_p(i))
END DO
CALL dbcsr_data_set_size_referenced(dsts, &
ABS(blk_p(nblks)) + sizes(nblks) - 1)
!$OMP END MASTER
!$OMP BARRIER
!$OMP DO
DO i = 1, nblks
IF (old_blk_p(i) .NE. 0) THEN
IF (.NOT. multidata) THEN
CALL dbcsr_data_set(dsts, &
ABS(blk_p(i)), sizes(i), &
src, source_lb=ABS(old_blk_p(i)))
!dst(ABS(blk_p(i)):ABS(blk_p(i))+sizes(i)-1) =&
! src(ABS(old_blk_p(i)):ABS(old_blk_p(i))+sizes(i)-1)
ELSE
CALL dbcsr_data_set(dsts, &
ABS(blk_p(i)), sizes(i), &
srcs(old_blk_d(i)), source_lb=ABS(old_blk_p(i)))
!dst(ABS(blk_p(i)):ABS(blk_p(i))+sizes(i)-1) =&
! srcs(old_blk_d(i))%d&
! %r_dp(ABS(old_blk_p(i)):ABS(old_blk_p(i))+sizes(i)-1)
END IF
END IF
END DO
!$OMP END DO NOWAIT
END IF
CALL timestop(handle)
END SUBROUTINE dbcsr_sort_data