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