subroutine master_sort_and_group(Array, Array_groups, subgroup_info, tran_group_threshold, &
print_output, wannier_centres_translated, coord, stdout, timer, &
error, comm)
!================================================!
! General sorting and grouping subroutine which takes Array,
! an ordered in conduction direction array of wannier function
! indexes and positions, and returns the ordered (and grouped)
! indexes and positions after considering the other two
! directions. Sub group info is also return for later checks.
!================================================!
use w90_constants, only: dp
use w90_io, only: io_stopwatch_start, io_stopwatch_stop
use w90_types, only: print_output_type, timer_list_type
use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc
implicit none
! arguments
type(print_output_type), intent(in) :: print_output
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), allocatable, intent(out) :: error
type(w90_comm_type), intent(in) :: comm
integer, intent(in) :: stdout !, Array_size => size(Array_groups) so not needed
integer, intent(in) :: Array_groups(:), coord(3)
integer, intent(out), allocatable :: subgroup_info(:, :)
real(kind=dp), intent(inout) :: Array(:, :) !(2, Array_size)
real(kind=dp), intent(in) :: tran_group_threshold, wannier_centres_translated(:, :)
! local variables
integer :: i, j, k, Array_num_groups, increment, ierr, subgroup_increment, group_num_subgroups
integer, allocatable :: group_subgroups(:)
real(kind=dp), allocatable :: group_array(:, :), sorted_group_array(:, :)
real(kind=dp), allocatable :: subgroup_array(:, :), sorted_subgroup_array(:, :)
character(30) :: fmt_2
if (print_output%timing_level > 2) call io_stopwatch_start('tran: lcr_2c2_sort: master_sort', timer)
allocate (subgroup_info(size(Array_groups), maxval(Array_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating subgroup_info in master_sort_and_group', comm)
return
end if
subgroup_info = 0
!Number of groups inside the principal layer
Array_num_groups = size(Array_groups)
!Convenient variable which will be amended later. Used to appropriately extract the group array from the Array
increment = 1
!Loop over groups inside Array
do j = 1, Array_num_groups
allocate (group_array(2, Array_groups(j)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating group_array in master_sort_and_group', comm)
return
end if
allocate (sorted_group_array(2, Array_groups(j)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating sorted_group_array in master_sort_and_group', comm)
return
end if
!Extract the group from the Array
group_array = Array(:, increment:increment + Array_groups(j) - 1)
!Updating group_array to contain coord(2)
do k = 1, Array_groups(j)
group_array(2, k) = wannier_centres_translated(coord(2), int(group_array(1, k)))
end do
call sort(group_array, sorted_group_array)
call group(sorted_group_array, group_subgroups, tran_group_threshold, error, comm)
if (allocated(error)) return
group_num_subgroups = size(group_subgroups)
if (print_output%iprint .ge. 4) then
!Printing subgroup breakdown
write (fmt_2, '(i5)') group_num_subgroups
fmt_2 = adjustl(fmt_2)
fmt_2 = '(a7,i3,a1,i5,a2,'//trim(fmt_2)//'i4,a1)'
write (stdout, fmt_2) ' Group ', j, ' ', group_num_subgroups, ' (', (group_subgroups(i), i=1, group_num_subgroups), ')'
end if
! filling up subgroup_info
do k = 1, group_num_subgroups
subgroup_info(j, k) = group_subgroups(k)
end do
!Convenient variable which will be amended later. Used to appropriately extract the subgroup array from the group_array
subgroup_increment = 1
!Loop over subgroups inside group
do k = 1, group_num_subgroups
allocate (subgroup_array(2, group_subgroups(k)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating subgroup_array in master_sort_and_group', comm)
return
end if
allocate (sorted_subgroup_array(2, group_subgroups(k)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating sorted_subgroup_array in master_sort_and_group', comm)
return
end if
!Extract the subgroup from the group
subgroup_array = sorted_group_array(:, subgroup_increment:subgroup_increment + group_subgroups(k) - 1)
!Updating subgroup_array to contain coord(3)
do i = 1, group_subgroups(k)
subgroup_array(2, i) = wannier_centres_translated(coord(3), int(subgroup_array(1, i)))
end do
call sort(subgroup_array, sorted_subgroup_array)
!Update sorted_group array with the sorted subgroup array
sorted_group_array(:, subgroup_increment:subgroup_increment + group_subgroups(k) - 1) = sorted_subgroup_array
!Update the subgroup_increment
subgroup_increment = subgroup_increment + group_subgroups(k)
deallocate (sorted_subgroup_array, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating sorted_subgroup_array in master_sort_and_group', comm)
return
end if
deallocate (subgroup_array, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating subgroup_array in master_sort_and_group', comm)
return
end if
end do
!Update Array with the sorted group array
Array(:, increment:increment + Array_groups(j) - 1) = sorted_group_array
!Update the group increment
increment = increment + Array_groups(j)
deallocate (group_array, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating group_array in master_sort_and_group', comm)
return
end if
deallocate (sorted_group_array, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating sorted_group_array in master_sort_and_group', comm)
return
end if
deallocate (group_subgroups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating group_subgroups in master_sort_and_group', comm)
return
end if
end do
if (print_output%timing_level > 2) call io_stopwatch_stop('tran: lcr_2c2_sort: master_sort', timer)
return
end subroutine master_sort_and_group
