Roughly order stacks with a cheaper Binning-scheme by Peter Messmer
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in), | DIMENSION(dbcsr_ps_width, stack_size) | :: | params_in | ||
integer, | intent(out), | DIMENSION(dbcsr_ps_acc_width, stack_size) | :: | params_out | ||
integer, | intent(in) | :: | stack_size |
SUBROUTINE stack_binning(params_in, params_out, stack_size)
!! Roughly order stacks with a cheaper Binning-scheme by Peter Messmer
INTEGER, INTENT(IN) :: stack_size
INTEGER, &
DIMENSION(dbcsr_ps_acc_width, stack_size), &
INTENT(OUT) :: params_out
INTEGER, DIMENSION(dbcsr_ps_width, stack_size), &
INTENT(IN) :: params_in
INTEGER :: bin_id, i, top
INTEGER, DIMENSION(dbcsr_cfg%accdrv_binning_nbins%val) :: bin_top
INTEGER, DIMENSION(dbcsr_ps_acc_width) :: val
INTEGER, DIMENSION(dbcsr_ps_acc_width, dbcsr_cfg% &
accdrv_binning_binsize%val, dbcsr_cfg% &
accdrv_binning_nbins%val) :: bin_arr
bin_top = 1
top = 1
DO i = 1, stack_size
val(1:3) = params_in(4:6, i)
bin_id = 1 + INT(MODULO(INT(val(3)*(val(3) + 3), KIND=int_8), &
INT(dbcsr_cfg%accdrv_binning_nbins%val, KIND=int_8)))
IF (bin_top(bin_id) > dbcsr_cfg%accdrv_binning_binsize%val) THEN
params_out(1:3, top:top + bin_top(bin_id) - 2) = bin_arr(1:3, 1:bin_top(bin_id) - 1, bin_id)
top = top + bin_top(bin_id) - 1
bin_top(bin_id) = 1
END IF
bin_arr(1:3, bin_top(bin_id), bin_id) = val(1:3)
bin_top(bin_id) = bin_top(bin_id) + 1
END DO
DO i = 1, dbcsr_cfg%accdrv_binning_nbins%val
IF (bin_top(i) > 1) THEN
params_out(1:3, top:top + bin_top(i) - 2) = bin_arr(1:3, 1:bin_top(i) - 1, i)
top = top + bin_top(i) - 1
END IF
END DO
END SUBROUTINE stack_binning