subroutine tran_lcr_2c2_sort(signatures, num_G, pl_warning, transport, atom_data, wannier_data, &
real_space_ham, print_output, real_lattice, num_wann, mp_grid, &
ham_r, irvec, nrpts, wannier_centres_translated, one_dim_vec, &
nrpts_one_dim, num_pl, coord, tran_sorted_idx, hr_one_dim, &
irvec_max, write_xyz, stdout, seedname, timer, error, comm)
!================================================!
! This is the main subroutine controling the sorting
! for the 2c2 geometry. We first sort in the conduction
! direction, group, sort in 2nd direction, group and
! sort in 3rd direction. Rigourous checks are performed
! to ensure group and subgroup structure is consistent
! between principal layers (PLs), and unit cells. Once
! checks are passed we consider the possibility of
! multiple wannier functions are of similar centre, and
! sort those
!================================================!
use w90_constants, only: dp
use w90_io, only: io_stopwatch_start, io_stopwatch_stop
use w90_types, only: wannier_data_type, atom_data_type, print_output_type, timer_list_type
use w90_wannier90_types, only: transport_type, real_space_ham_type
use w90_error, only: w90_error_type, set_error_alloc, set_error_dealloc, set_error_fatal
implicit none
! arguments
integer, intent(in) :: irvec(:, :)
integer, intent(inout) :: irvec_max ! maybe modified
integer, intent(in) :: mp_grid(3)
integer, intent(in) :: num_G
integer, intent(in) :: num_wann
integer, intent(inout), allocatable :: tran_sorted_idx(:)
integer, intent(inout) :: coord(3)
integer, intent(inout) :: nrpts
integer, intent(inout) :: nrpts_one_dim
integer, intent(inout) :: num_pl
integer, intent(inout) :: one_dim_vec
integer, intent(in) :: stdout
real(kind=dp), intent(in) :: signatures(:, :)
real(kind=dp), allocatable, intent(inout) :: hr_one_dim(:, :, :)
real(kind=dp), intent(inout) :: wannier_centres_translated(:, :)
real(kind=dp), intent(in) :: real_lattice(3, 3)
complex(kind=dp), intent(in) :: ham_r(:, :, :)
type(atom_data_type), intent(in) :: atom_data
type(real_space_ham_type), intent(inout) :: real_space_ham
type(print_output_type), intent(in) :: print_output
type(transport_type), intent(inout) :: transport
type(wannier_data_type), intent(in) :: wannier_data
type(timer_list_type), intent(inout) :: timer
type(w90_error_type), allocatable, intent(out) :: error
type(w90_comm_type), intent(in) :: comm
character(len=50), intent(in) :: seedname
logical, intent(in) :: write_xyz
logical, intent(out) :: pl_warning
! local variables
real(kind=dp), dimension(2, num_wann) :: centres_non_sorted, centres_initial_sorted
real(kind=dp), dimension(2, transport%num_ll) :: PL1, PL2, PL3, PL4, PL
real(kind=dp), dimension(2, num_wann - (4*transport%num_ll)) :: central_region
real(kind=dp) :: reference_position, cell_length, distance, PL_max_val, PL_min_val
integer :: i, j, k, PL_selector, sort_iterator, sort_iterator2
integer :: ierr, temp_coord_2, temp_coord_3, n
integer :: num_wann_cell_ll, num_wf_group1, num_wf_last_group
integer, allocatable :: PL_groups(:), PL1_groups(:), PL2_groups(:), PL3_groups(:), &
PL4_groups(:), central_region_groups(:)
integer, allocatable :: PL_subgroup_info(:, :), PL1_subgroup_info(:, :), &
PL2_subgroup_info(:, :), PL3_subgroup_info(:, :), PL4_subgroup_info(:, :), &
central_subgroup_info(:, :), temp_subgroup(:, :)
character(30) :: fmt_1
allocate (tran_sorted_idx(num_wann), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating tran_sorted_idx in tran_lcr_2c2_sort', comm)
return
end if
num_wann_cell_ll = transport%num_ll/transport%num_cell_ll
if (print_output%timing_level > 1) call io_stopwatch_start('tran: lcr_2c2_sort', timer)
sort_iterator = 0
!Check translated centres have been found
if (size(wannier_centres_translated) .eq. 0) then
call set_error_fatal(error, 'Translated centres not known : required perform lcr transport, &
&try restart=plot', comm)
return
end if
!read one_dim_dir and creates an array (coord) that correspond to the
!conduction direction (coord(1)) and the two perpendicular directions
!(coord(2),coord(3)), such that a right-handed set is formed
if (real_space_ham%one_dim_dir .eq. 1) then
coord(1) = 1
coord(2) = 2
coord(3) = 3
elseif (real_space_ham%one_dim_dir .eq. 2) then
coord(1) = 2
coord(2) = 3
coord(3) = 1
elseif (real_space_ham%one_dim_dir .eq. 3) then
coord(1) = 3
coord(2) = 1
coord(3) = 2
end if
!Check
if (((real_lattice(coord(1), coord(2)) .ne. 0) .or. (real_lattice(coord(1), coord(3)) .ne. 0)) .or. &
((real_lattice(coord(2), coord(1)) .ne. 0) .or. (real_lattice(coord(3), coord(1)) .ne. 0))) then
call set_error_fatal(error, &
'Lattice vector in conduction direction must point along x,y or z &
& direction and be orthogonal to the remaining lattice vectors.', comm)
return
end if
!Check
if (num_wann .le. 4*transport%num_ll) then
call set_error_fatal(error, 'Principle layers are too big.', comm)
return
end if
100 continue
!Extract a 2d array of the wannier_indices and their coord(1) from wannier_centers_translated
do i = 1, num_wann
centres_non_sorted(1, i) = i
centres_non_sorted(2, i) = wannier_centres_translated(coord(1), i)
end do
write (stdout, '(/a)') ' Sorting WFs into principal layers'
!Initial sorting according to coord(1).
call sort(centres_non_sorted, centres_initial_sorted)
!Extract principal layers. WARNING: This extraction implies the structure of the supercell is
!2 principal layers of lead on the left and on the right of a central conductor.
PL1 = centres_initial_sorted(:, 1:transport%num_ll)
PL2 = centres_initial_sorted(:, transport%num_ll + 1:2*transport%num_ll)
PL3 = centres_initial_sorted(:, num_wann - (2*transport%num_ll - 1):num_wann - (transport%num_ll))
PL4 = centres_initial_sorted(:, num_wann - (transport%num_ll - 1):)
if (sort_iterator .eq. 1) then
temp_coord_2 = coord(2)
temp_coord_3 = coord(3)
coord(2) = temp_coord_3
coord(3) = temp_coord_2
end if
if (print_output%iprint .ge. 4) then
write (stdout, *) ' Group Breakdown of each principal layer'
end if
!Loop over principal layers
do i = 1, 4
!Creating a variable PL_selector which choose the appropriate PL
PL_selector = i
select case (PL_selector)
case (1)
PL = PL1
case (2)
PL = PL2
case (3)
PL = PL3
case (4)
PL = PL4
end select
!Grouping wannier functions with similar coord(1)
call group(PL, PL_groups, transport%group_threshold, error, comm)
if (allocated(error)) return
if (print_output%iprint .ge. 4) then
!Print group breakdown
write (fmt_1, '(i5)') size(PL_groups)
fmt_1 = adjustl(fmt_1)
fmt_1 = '(a3,i1,a1,i5,a2,'//trim(fmt_1)//'i4,a1)'
write (stdout, fmt_1) ' PL', i, ' ', size(PL_groups), ' (', (PL_groups(j), j=1, &
size(PL_groups)), ')'
end if
!Returns the sorted PL and informations on this PL
allocate (PL_subgroup_info(size(PL_groups), maxval(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
call master_sort_and_group(PL, PL_groups, PL_subgroup_info, transport%group_threshold, &
print_output, wannier_centres_translated, coord, stdout, timer, &
error, comm)
if (allocated(error)) return
select case (PL_selector)
case (1)
allocate (PL1_groups(size(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL1_groups in tran_lcr_2c2_sort', comm)
return
end if
allocate (PL1_subgroup_info(size(PL_groups), maxval(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
PL1 = PL
PL1_groups = PL_groups
PL1_subgroup_info = PL_subgroup_info
deallocate (PL_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
case (2)
allocate (PL2_groups(size(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL2_groups in tran_lcr_2c2_sort', comm)
return
end if
allocate (PL2_subgroup_info(size(PL_groups), maxval(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
PL2 = PL
PL2_groups = PL_groups
PL2_subgroup_info = PL_subgroup_info
deallocate (PL_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
case (3)
allocate (PL3_groups(size(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL3_groups in tran_lcr_2c2_sort', comm)
return
end if
allocate (PL3_subgroup_info(size(PL_groups), maxval(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
PL3 = PL
PL3_groups = PL_groups
PL3_subgroup_info = PL_subgroup_info
deallocate (PL_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
case (4)
allocate (PL4_groups(size(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL4_groups in tran_lcr_2c2_sort', comm)
return
end if
allocate (PL4_subgroup_info(size(PL_groups), maxval(PL_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
PL4 = PL
PL4_groups = PL_groups
PL4_subgroup_info = PL_subgroup_info
deallocate (PL_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
end select
deallocate (PL_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL_groups in tran_lcr_2c2_sort', comm)
return
end if
end do ! Principal layer loop
!Grouping and sorting of central conductor region
!Define central region
central_region = centres_initial_sorted(:, 2*transport%num_ll + 1:num_wann - (2*transport%num_ll))
!Group central region
call group(central_region, central_region_groups, transport%group_threshold, error, comm)
if (allocated(error)) return
!Print central region group breakdown
if (print_output%iprint .ge. 4) then
write (stdout, *) ' Group Breakdown of central region'
write (fmt_1, '(i5)') size(central_region_groups)
fmt_1 = adjustl(fmt_1)
fmt_1 = '(a5,i5,a2,'//trim(fmt_1)//'i4,a1)'
write (stdout, fmt_1) ' ', size(central_region_groups), ' (', &
(central_region_groups(j), j=1, size(central_region_groups)), ')'
end if
!Returns sorted central group region
allocate (central_subgroup_info(size(central_region_groups), maxval(central_region_groups)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating central_group_info in tran_lcr_2c2_sort', comm)
return
end if
call master_sort_and_group(central_region, central_region_groups, central_subgroup_info, &
transport%group_threshold, print_output, &
wannier_centres_translated, coord, stdout, timer, error, comm)
if (allocated(error)) return
deallocate (central_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating central_group_info in tran_lcr_2c2_sort', comm)
return
end if
write (stdout, *) ' '
!Build the sorted index array
tran_sorted_idx = nint(centres_initial_sorted(1, :))
tran_sorted_idx(1:transport%num_ll) = nint(PL1(1, :))
tran_sorted_idx(transport%num_ll + 1:2*transport%num_ll) = nint(PL2(1, :))
tran_sorted_idx(2*transport%num_ll + 1:num_wann - (2*transport%num_ll)) = nint(central_region(1, :))
tran_sorted_idx(num_wann - (2*transport%num_ll - 1):num_wann - (transport%num_ll)) = nint(PL3(1, :))
tran_sorted_idx(num_wann - (transport%num_ll - 1):) = nint(PL4(1, :))
sort_iterator = sort_iterator + 1
!Checks:
if ((size(PL1_groups) .ne. size(PL2_groups)) .or. &
(size(PL2_groups) .ne. size(PL3_groups)) .or. &
(size(PL3_groups) .ne. size(PL4_groups))) then
if (sort_iterator .ge. 2) then
if (write_xyz) call tran_write_xyz(atom_data, transport, wannier_centres_translated, &
tran_sorted_idx, num_wann, seedname, stdout)
call set_error_fatal(error, 'Sorting techniques exhausted:&
& Inconsistent number of groups among principal layers', comm)
return
end if
if (print_output%iprint > 0) write (stdout, *) 'Inconsistent number of groups among principal layers: restarting sorting...'
deallocate (PL1_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL1_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
goto 100
end if
do i = 1, size(PL1_groups)
if ((PL1_groups(i) .ne. PL2_groups(i)) .or. &
(PL2_groups(i) .ne. PL3_groups(i)) .or. &
(PL3_groups(i) .ne. PL4_groups(i))) then
if (sort_iterator .ge. 2) then
if (write_xyz) call tran_write_xyz(atom_data, transport, wannier_centres_translated, &
tran_sorted_idx, num_wann, seedname, stdout)
call set_error_fatal(error, &
'Sorting techniques exhausted: Inconsitent number of wannier function among &
& similar groups within principal layers', comm)
return
end if
write (stdout, *) 'Inconsitent number of wannier function among &
&similar groups within& principal layers: restarting sorting...'
deallocate (PL1_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL1_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
goto 100
end if
end do
!Now we check that the leftmost group and the rightmost group aren't
!supposed to be the same group
reference_position = wannier_centres_translated(coord(1), tran_sorted_idx(1))
cell_length = real_lattice(coord(1), coord(1))
sort_iterator2 = 1
do i = 1, transport%num_ll
distance = abs(abs(reference_position - wannier_centres_translated(coord(1), tran_sorted_idx(num_wann - i + 1))) &
- cell_length)
if (distance .lt. transport%group_threshold) then
wannier_centres_translated(coord(1), tran_sorted_idx(num_wann - i + 1)) = &
wannier_centres_translated(coord(1), tran_sorted_idx(num_wann - i + 1)) - cell_length
sort_iterator2 = sort_iterator2 + 1
end if
end do
if (sort_iterator2 .gt. 1) then
write (stdout, *) ' Grouping inconsistency found between first and last unit cells: '
write (stdout, *) ' suspect Wannier functions have been translated. '
write (stdout, *) ' '
write (stdout, *) ' Rebuilding Hamiltonian...'
write (stdout, *) ' '
deallocate (hr_one_dim, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating hr_one_dim in tran_lcr_2c2_sort', comm)
return
end if
call tran_reduce_hr(real_space_ham, ham_r, hr_one_dim, real_lattice, irvec, mp_grid, &
irvec_max, nrpts, nrpts_one_dim, num_wann, one_dim_vec, &
print_output%timing_level, stdout, timer, error, comm)
if (allocated(error)) return
call tran_cut_hr_one_dim(real_space_ham, transport, print_output, hr_one_dim, real_lattice, &
wannier_centres_translated, mp_grid, irvec_max, num_pl, num_wann, &
one_dim_vec, stdout, timer)
write (stdout, *) ' '
write (stdout, *) ' Restarting sorting...'
write (stdout, *) ' '
sort_iterator = sort_iterator - 1
deallocate (PL1_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL1_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
goto 100
end if
! if we reach this point, we don't have any left/right problems anymore. So we now
! check for inconsistencies in subgroups
allocate (temp_subgroup(size(PL1_subgroup_info, 1), size(PL1_subgroup_info, 2)), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error in allocating tmp_subgroup in tran_lcr_2c2_sort', comm)
return
end if
do i = 2, 4
select case (i)
case (2)
temp_subgroup = PL1_subgroup_info - PL2_subgroup_info
case (3)
temp_subgroup = PL1_subgroup_info - PL3_subgroup_info
case (4)
temp_subgroup = PL1_subgroup_info - PL4_subgroup_info
end select
do j = 1, size(temp_subgroup, 1)
do k = 1, size(temp_subgroup, 2)
if (temp_subgroup(j, k) .ne. 0) then
if (sort_iterator .ge. 2) then
if (write_xyz) call tran_write_xyz(atom_data, transport, &
wannier_centres_translated, &
tran_sorted_idx, num_wann, seedname, &
stdout)
call set_error_fatal(error, &
'Sorting techniques exhausted: Inconsitent subgroup structures among principal layers', comm)
return
end if
if (print_output%iprint > 0) &
write (stdout, *) 'Inconsistent subgroup structure among principal layers: restarting sorting...'
deallocate (temp_subgroup, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating tmp_subgroup in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL1_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_groups, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_groups in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL1_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL1_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL2_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL2_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL3_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL3_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
deallocate (PL4_subgroup_info, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating PL4_subgroup_info in tran_lcr_2c2_sort', comm)
return
end if
goto 100
end if
end do
end do
end do
! At this point, every check has been cleared, and we need to use
! the parity signatures of the WFs for the possibility of equal centres
call check_and_sort_similar_centres(signatures, num_G, atom_data, transport, print_output, &
num_wann, wannier_centres_translated, coord, &
tran_sorted_idx, write_xyz, stdout, seedname, timer, error, comm)
if (allocated(error)) return
write (stdout, *) ' '
write (stdout, *) '------------------------- Sorted Wannier Centres -----------------------------'
write (stdout, *) 'Sorted index Unsorted index x y z Spread '
write (stdout, *) '==================================PL1========================================='
n = 0
do k = 1, 4
if (k .eq. 2) write (stdout, *) '==================================PL2========================================='
if (k .eq. 3) then
write (stdout, *) '===========================Central Region==================================='
do i = 1, num_wann - 4*transport%num_ll
n = n + 1
write (stdout, FMT='(2x,i6,10x,i6,6x,4F12.6)') n, tran_sorted_idx(n), &
wannier_centres_translated(1, tran_sorted_idx(n)), &
wannier_centres_translated(2, tran_sorted_idx(n)), &
wannier_centres_translated(3, tran_sorted_idx(n)), &
wannier_data%spreads(tran_sorted_idx(n))*print_output%lenconfac**2
end do
write (stdout, *) '==================================PL3========================================='
end if
if (k .eq. 4) write (stdout, *) '==================================PL4========================================='
do i = 1, transport%num_cell_ll
do j = 1, num_wann_cell_ll
n = n + 1
write (stdout, FMT='(2x,i6,10x,i6,6x,4F12.6)') n, tran_sorted_idx(n), &
wannier_centres_translated(1, tran_sorted_idx(n)), &
wannier_centres_translated(2, tran_sorted_idx(n)), &
wannier_centres_translated(3, tran_sorted_idx(n)), &
wannier_data%spreads(tran_sorted_idx(n))*print_output%lenconfac**2
end do
if (i .ne. transport%num_cell_ll) write (stdout, *) '---------------------&
&---------------------------------------------------------'
end do
end do
write (stdout, *) '=============================================================================='
write (stdout, *) ' '
! MS: Use sorting to assess whether dist_cutoff is suitable for correct PL cut
! by using limits of coord(1) values in 1st and last groups of PL1, & 1st group of PL2
pl_warning = .false.
num_wf_group1 = size(PL1_subgroup_info(1, :))
if (size(PL1_groups) .ge. 1) then
num_wf_last_group = size(PL1_subgroup_info(size(PL1_groups), :))
else
!Exception for 1 group in unit cell.
num_wf_last_group = num_wann_cell_ll
end if
PL_min_val = maxval(wannier_centres_translated(coord(1), tran_sorted_idx(transport%num_ll &
- num_wf_last_group + 1:transport%num_ll))) &
- minval(wannier_centres_translated(coord(1), tran_sorted_idx(1:num_wf_group1)))
PL_max_val = minval(wannier_centres_translated(coord(1), tran_sorted_idx(transport%num_ll + &
1:transport%num_ll + num_wf_group1))) &
- minval(wannier_centres_translated(coord(1), tran_sorted_idx(1:num_wf_group1)))
if ((real_space_ham%dist_cutoff .lt. PL_min_val) .or. (real_space_ham%dist_cutoff .gt. PL_max_val)) then
write (stdout, '(a)') ' WARNING: Expected dist_cutoff to be a PL length, I think this'
write (stdout, '(2(a,f10.6),a)') ' WARNING: is somewhere between ', PL_min_val, ' and ', PL_max_val, ' Ang'
pl_warning = .true.
end if
! End MS.
if (print_output%timing_level > 1) call io_stopwatch_stop('tran: lcr_2c2_sort', timer)
return
end subroutine tran_lcr_2c2_sort
