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