dbcsr_reblocking_targets Subroutine

   SUBROUTINE dbcsr_reblocking_targets(ints, numints, n_src_dsts, &
                                       src_sizes, dst_sizes)
      !! Calculates the intersections of blocks
      !!
      !! ints output format
      !! The ints array should be up to twice as large as the number of
      !! intersecting blocks. Each entry is comprised of the target
      !! block and the common length along with the offsets of the
      !! intersection in the old and new blocks.
      !!
      !! n_src_dsts format
      !! This arrays stored the number of intersecting blocks in common
      !! (position 2) and the offset of the first common intersecting
      !! block (position 1).
      !!
      !! Interpretation (Mapping old blocks into new blocks)
      !! The old element belongs to block B. Lookup row B in
      !! n_src_dsts.  The first element F tells you which is the first
      !! new block to map into and the second element tells you into
      !! how many new blocks N you have to map.  You then look up rows
      !! F to F+N-1 in ints. The first block tells you into which block
      !! it is mapped and the second element tells you how many
      !! elements they have in common. The third element specifies the
      !! offset of the intersection in the old block while the fourth
      !! specifies the offset of the intersection in the new block.
      !! @note This routine is used in the counting and sending loops in
      !! dbcsr_complete_redistribute

      INTEGER, INTENT(INOUT)                             :: numints
         !! maximum number of expected intersections
      INTEGER, DIMENSION(4, numints), INTENT(OUT)        :: ints
         !! intersections of blocks
      INTEGER, DIMENSION(:, :), INTENT(OUT)              :: n_src_dsts
         !! offset and number intersections belonging to source blocks
      INTEGER, DIMENSION(:), INTENT(IN)                  :: src_sizes, dst_sizes
         !! sizes of source blocks
         !! sizes of target blocks

      INTEGER                                            :: common_extent, current_dst, current_int, &
                                                            current_src, dst_off, n_dst, n_src, &
                                                            s_dst, s_src, src_off

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

      n_src = SIZE(src_sizes)
      n_dst = SIZE(dst_sizes)
      current_int = 0
      current_src = 0
      s_src = 0 ! HUGE(0)
      DO WHILE (s_src .EQ. 0 .AND. current_src .LE. n_src)
         current_src = current_src + 1
         src_off = 1
         IF (current_src .LE. n_src) THEN
            s_src = src_sizes(current_src)
            n_src_dsts(:, current_src) = (/current_int + 1, 0/)
         END IF
      END DO
      current_dst = 0
      s_dst = 0 ! HUGE(0)
      DO WHILE (s_dst .EQ. 0 .AND. current_dst .LE. n_dst)
         current_dst = current_dst + 1
         dst_off = 1
         IF (current_dst .LE. n_dst) s_dst = dst_sizes(current_dst)
      END DO
      current_int = current_int + 1
      DO WHILE (current_src .LE. n_src .AND. current_dst .LE. n_dst)
         IF (current_int > numints) &
            DBCSR_ABORT("Ran out of space.")
         ! Calculate how many elements do the current blocks have in
         ! common and record these as going to the current target block.
         common_extent = MIN(s_src, s_dst)
         ints(1, current_int) = current_dst ! target block
         ints(2, current_int) = common_extent
         ints(3, current_int) = src_off
         ints(4, current_int) = dst_off
         ! We've used up the common extents.
         s_src = s_src - common_extent
         s_dst = s_dst - common_extent
         src_off = src_off + common_extent
         dst_off = dst_off + common_extent
         ! We've used up another block.
         n_src_dsts(2, current_src) = n_src_dsts(2, current_src) + 1
         ! Check if we've used up the whole source block.
         DO WHILE (s_src .EQ. 0 .AND. current_src .LE. n_src)
            current_src = current_src + 1
            src_off = 1
            IF (current_src .LE. n_src) THEN
               s_src = src_sizes(current_src)
               n_src_dsts(:, current_src) = (/current_int + 1, 0/)
            END IF
         END DO
         DO WHILE (s_dst .EQ. 0 .AND. current_dst .LE. n_dst)
            current_dst = current_dst + 1
            dst_off = 1
            IF (current_dst .LE. n_dst) s_dst = dst_sizes(current_dst)
         END DO
         current_int = current_int + 1
      END DO
      IF (current_src .LT. n_src) &
         n_src_dsts(:, current_src + 1:n_src) = -7
      numints = current_int - 1
   END SUBROUTINE dbcsr_reblocking_targets