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