subroutine group(array, array_groups)
!========================================!
use w90_constants, only: dp
use w90_io, only: io_error
use w90_parameters, only: tran_group_threshold
implicit none
real(dp), intent(in), dimension(:, :) :: array
integer, intent(out), allocatable, dimension(:) :: array_groups
integer, allocatable, dimension(:) :: dummy_array
logical, allocatable, dimension(:) :: logic
integer :: array_idx, i, j, group_number, array_size, ierr
array_size = size(array, 2)
allocate (dummy_array(array_size), stat=ierr)
if (ierr /= 0) call io_error('Error in allocating dummy_array in group')
allocate (logic(array_size), stat=ierr)
if (ierr /= 0) call io_error('Error in allocating logic in group')
!
!Initialise dummy array
!
dummy_array = 0
!
!Initialise logic to false
!
logic = .false.
!
!Define counter of number of groups
!
array_idx = 1
!
!Loop over columns of array (ie array_size)
!
do i = 1, array_size
!
!If an element of logic is true then it means the wannier function has already been grouped
!
if (logic(i) .eqv. .false.) then
!
!Create a group for the wannier function
!
logic(i) = .true.
!
!Initialise the number of wannier functions in this group to be 1
!
group_number = 1
!
!Loop over the rest of wannier functions in array
!
do j = min(i + 1, array_size), array_size
!
!Special termination cases
!
if ((j .eq. 1) .or. (i .eq. array_size)) then
dummy_array(array_idx) = group_number
exit
endif
if (j .eq. array_size .and. (abs(array(2, j) - array(2, i)) .le. tran_group_threshold)) then
group_number = group_number + 1
dummy_array(array_idx) = group_number
logic(j) = .true.
exit
endif
!
!Check distance between wannier function_i and wannier function_j
!
if (abs(array(2, j) - array(2, i)) .le. tran_group_threshold) then
!
!Increment number of wannier functions in group
!
group_number = group_number + 1
!
!Assigns wannier function to the group
!
logic(j) = .true.
else
!
!Group is finished and store number of wanniers in the group to dummy_array
!
dummy_array(array_idx) = group_number
!
!Increment number of groups
!
array_idx = array_idx + 1
exit
endif
enddo
endif
enddo
!
!Copy elements of dummy_array to array_groups
!
allocate (array_groups(array_idx), stat=ierr)
if (ierr /= 0) call io_error('Error in allocating array_groups in group')
array_groups = dummy_array(:array_idx)
deallocate (dummy_array, stat=ierr)
if (ierr /= 0) call io_error('Error deallocating dummy_array in group')
deallocate (logic, stat=ierr)
if (ierr /= 0) call io_error('Error deallocating logic in group')
return
end subroutine group