subroutine w90_wannier90_readwrite_read_projections(settings, proj, proj_input, &
use_bloch_phases, lhasproj, &
guiding_centres, select_proj, num_proj, &
atom_data, recip_lattice, num_wann, &
gamma_only, spinors, bohr, stdout, error, &
comm)
!================================================!
! Obtain projector definitions
use w90_error, only: w90_error_type
implicit none
! arguments
integer, intent(in) :: num_wann
integer, intent(inout) :: num_proj
integer, intent(in) :: stdout
logical, intent(in) :: gamma_only
logical, intent(in) :: spinors
logical, intent(in) :: use_bloch_phases, guiding_centres
logical, intent(out) :: lhasproj
real(kind=dp), intent(in) :: bohr
real(kind=dp), intent(in) :: recip_lattice(3, 3)
type(atom_data_type), intent(in) :: atom_data
type(proj_type), allocatable, intent(inout) :: proj(:), proj_input(:)
type(select_projection_type), intent(inout) :: select_proj
type(settings_type), intent(inout) :: settings
type(w90_comm_type), intent(in) :: comm
type(w90_error_type), allocatable, intent(out) :: error
! local variables
integer :: i, j, i_temp, loop, ierr
logical :: found
! projections selection
integer :: num_select_projections
integer, allocatable :: select_projections(:)
integer :: imap
lhasproj = .false.
! Projections
call w90_readwrite_get_keyword(settings, 'auto_projections', found, error, comm, &
l_value=select_proj%auto_projections)
if (allocated(error)) return
call w90_readwrite_get_block_length(settings, 'projections', found, i_temp, error, comm)
if (allocated(error)) return
if (found) then
if (select_proj%auto_projections) then
call set_error_input(error, 'Error: Cannot specify both auto_projections and projections block', comm)
return
end if
lhasproj = .true.
call w90_readwrite_get_projections(settings, num_proj, atom_data, num_wann, proj_input, &
recip_lattice, .true., spinors, bohr, stdout, error, comm)
if (allocated(error)) return
! num_proj is assigned in get_projections() call
else
if (guiding_centres .and. .not. (gamma_only .and. use_bloch_phases)) then
call set_error_input(error, 'w90_wannier90_readwrite_read: Guiding centres requested, but no projection block found', comm)
return
end if
lhasproj = .false.
num_proj = num_wann
end if
! attempt to read projections from library interface
if (allocated(settings%entries)) then
if (found) then
call set_error_input(error, 'w90_wannier90_readwrite_read: attempting to read .win file with unspent lib options', comm)
return
end if
if (atom_data%num_species > 0) then
! only read projections if atom positions are known
! Count pass first: num_proj may exceed num_wann when there are more initial
! projections than target Wannier functions (valid for disentanglement).
! Without this, input_proj is allocated at size num_wann and overflows.
call w90_readwrite_get_projections(settings, num_proj, atom_data, num_wann, proj_input, &
recip_lattice, .true., spinors, bohr, stdout, error, comm)
if (allocated(error)) return
call w90_readwrite_get_projections(settings, num_proj, atom_data, num_wann, proj_input, &
recip_lattice, .false., spinors, bohr, stdout, error, comm)
if (allocated(error)) return
lhasproj = .true.
end if
end if
num_select_projections = num_proj !num proj is the size of proj_input
call w90_readwrite_get_range_vector(settings, 'select_projections', found, num_select_projections, &
.true., error, comm)
if (allocated(error)) return
if (found) then
if (num_select_projections < 1) then
call set_error_input(error, 'Error: problem reading select_projections', comm)
return
end if
if (allocated(select_projections)) then
deallocate (select_projections, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating select_projections &
& in w90_wannier90_readwrite_read_projections', comm)
return
end if
end if
allocate (select_projections(num_select_projections), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error allocating select_projections in w90_wannier90_readwrite_read_projections', comm)
return
end if
call w90_readwrite_get_range_vector(settings, 'select_projections', found, num_select_projections, &
.false., error, comm, select_projections)
if (allocated(error)) return
if (any(select_projections < 1)) then
call set_error_input(error, 'Error: select_projections must contain positive numbers', comm)
return
end if
if (num_select_projections < num_wann) then
call set_error_input(error, 'Error: too few projections selected', comm)
return
end if
if (num_select_projections > num_wann) then
call set_error_input(error, 'Error: too many projections selected', comm)
return
end if
if (.not. lhasproj) then
call set_error_input(error, 'Error: select_projections cannot be used without defining the projections', comm)
return
end if
if (maxval(select_projections(:)) > num_proj) then
call set_error_input(error, 'Error: select_projections contains a number greater than num_proj', comm)
return
end if
select_proj%lselproj = .true.
end if ! found 'select_projections'
if (allocated(select_proj%proj2wann_map)) then
deallocate (select_proj%proj2wann_map, stat=ierr)
if (ierr /= 0) then
call set_error_dealloc(error, 'Error deallocating proj2wann_map in w90_wannier90_readwrite_read_projections', comm)
return
end if
end if
allocate (select_proj%proj2wann_map(num_proj), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error allocating proj2wann_map in w90_wannier90_readwrite_read_projections', comm)
return
end if
select_proj%proj2wann_map = -1
if (select_proj%lselproj) then
do i = 1, num_proj
do j = 1, num_select_projections
if (select_projections(j) == i) select_proj%proj2wann_map(i) = j
end do
end do
else
do i = 1, num_wann
select_proj%proj2wann_map(i) = i
end do
end if
if (lhasproj) then
call w90_readwrite_get_projections(settings, num_proj, atom_data, num_wann, proj_input, &
recip_lattice, .false., spinors, bohr, stdout, error, comm)
if (allocated(error)) return
allocate (proj(num_proj), stat=ierr)
if (ierr /= 0) then
call set_error_alloc(error, 'Error allocating proj in w90_wannier90_readwrite_read_projections', comm)
return
end if
do loop = 1, num_proj
imap = select_proj%proj2wann_map(loop)
if (imap < 0) cycle
if (imap > num_proj) then
write (*, *) "logic error, imapping"
stop
end if
proj(imap) = proj_input(loop)
end do
end if !lhasproj
end subroutine w90_wannier90_readwrite_read_projections
