dbcsr_dist_bin Subroutine

public subroutine dbcsr_dist_bin(bin_dist, nelements, nbins, element_sizes)

Creates a sane 1-D distribution

Arguments

Type IntentOptional Attributes Name
integer, intent(out), DIMENSION(:), POINTER :: bin_dist

Distribution of elements to bins

integer, intent(in) :: nelements

Number of elements Number of bins

integer, intent(in) :: nbins

Number of elements Number of bins

integer, intent(in), optional, DIMENSION(:) :: element_sizes

sizes of elements


Source Code

   SUBROUTINE dbcsr_dist_bin(bin_dist, nelements, nbins, element_sizes)
      !! Creates a sane 1-D distribution

      INTEGER, DIMENSION(:), INTENT(OUT), POINTER        :: bin_dist
         !! Distribution of elements to bins
      INTEGER, INTENT(IN)                                :: nelements, nbins
         !! Number of elements
         !! Number of bins
      INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL        :: element_sizes
         !! sizes of elements

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_dist_bin'
      INTEGER                                            :: bin, bin_cnt, error_handle, i
      LOGICAL                                            :: found
      REAL(kind=sp)                                      :: rn
      TYPE(dbcsr_heap_type)                              :: bin_heap

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

      CALL timeset(routineN, error_handle)
      ALLOCATE (bin_dist(nelements))
      IF (PRESENT(element_sizes)) THEN
         IF (SIZE(element_sizes) /= nelements) &
            DBCSR_ABORT("Array of element sizes does not match the number of elements.")
         CALL dbcsr_heap_new(bin_heap, nbins)
         CALL dbcsr_heap_fill(bin_heap, (/(0, bin=0, nbins - 1)/))
         DO i = 1, nelements
            CALL dbcsr_heap_get_first(bin_heap, bin, bin_cnt, found)
            bin_dist(i) = bin - 1
            bin_cnt = bin_cnt + element_sizes(i)
            CALL dbcsr_heap_reset_first(bin_heap, bin_cnt)
         END DO
         CALL dbcsr_heap_release(bin_heap)
      ELSE
         DO i = 1, nelements
            CALL RANDOM_NUMBER(rn)
            bin_dist(i) = MOD(INT(rn*REAL(nbins, kind=sp)), nbins)
         END DO
      END IF
      CALL timestop(error_handle)
   END SUBROUTINE dbcsr_dist_bin