Creates a sane 1-D distribution
Type | Intent | Optional | 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 |
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