dbcsr_make_random_block_sizes Subroutine

public subroutine dbcsr_make_random_block_sizes(block_sizes, size_sum, size_mix)

Arguments

Type IntentOptional Attributes Name
integer, intent(out), DIMENSION(:), POINTER :: block_sizes
integer, intent(in) :: size_sum
integer, intent(in), DIMENSION(:) :: size_mix

Source Code

   SUBROUTINE dbcsr_make_random_block_sizes(block_sizes, size_sum, size_mix)
      INTEGER, DIMENSION(:), INTENT(out), POINTER        :: block_sizes
      INTEGER, INTENT(in)                                :: size_sum
      INTEGER, DIMENSION(:), INTENT(in)                  :: size_mix

      INTEGER                                            :: block_size, current_sum, nblocks, &
                                                            nsize_mix, selector
      INTEGER, ALLOCATABLE, DIMENSION(:, :)              :: mixer
      INTEGER, DIMENSION(:), POINTER, CONTIGUOUS         :: sizes

!

      NULLIFY (sizes)
      nsize_mix = SIZE(size_mix)/2
      ALLOCATE (mixer(3, nsize_mix))
      mixer(1, :) = size_mix(1:nsize_mix*2 - 1:2)
      mixer(2, :) = size_mix(2:nsize_mix*2:2)
      mixer(3, :) = 1
      nblocks = 0
      current_sum = 0
      CALL ensure_array_size(sizes, lb=1, ub=1)

      selector = 1
      !
      DO WHILE (current_sum .LT. size_sum)
         nblocks = nblocks + 1
         !CALL RANDOM_NUMBER(value)
         !block_size = MIN (INT (value(1) * size_max),&
         !                  size_sum - current_sum)
         block_size = MIN(mixer(2, selector), &
                          size_sum - current_sum)
         sizes(nblocks) = block_size
         current_sum = current_sum + block_size
         CALL ensure_array_size(sizes, ub=nblocks + 1, factor=2.0_dp)
         mixer(3, selector) = mixer(3, selector) + 1
         IF (mixer(3, selector) .GT. mixer(1, selector)) THEN
            mixer(3, selector) = 1
            selector = MOD(selector, nsize_mix) + 1
         END IF
      END DO
      ALLOCATE (block_sizes(nblocks))
      block_sizes = sizes(1:nblocks)
      current_sum = SUM(block_sizes)
      IF (current_sum /= size_sum) &
         DBCSR_ABORT("Incorrect block sizes")
      DEALLOCATE (mixer, sizes)

   END SUBROUTINE dbcsr_make_random_block_sizes