dbcsr_sort_data Subroutine

public 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.

Arguments

Type IntentOptional 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

Source Code

   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