
#include "f_defs.h"

!-----------------------------------------------------------------------
subroutine input_q(crys,gvec,kg,kgq,syms,xct,indexq,pxct)
!-----------------------------------------------------------------------
!
!     input: crys, gvec, kg,  syms, xct types
!
!     output: kgq type
!             indexq(1:xct%nkpt_fi_fi) : mapping of points in shifted grid
!             INT_VWFNQ_* files
!
  use global_m
  use checkbz_m
  use fullbz_m
  use misc_m
  use wfn_rho_vxc_io_m
  use plotxct_common_m
  use input_common_m
  implicit none

  type (crystal), intent(in) :: crys
  type (gspace), intent(in) :: gvec
  type (grid), intent(in) :: kg
  type (grid), intent(out) :: kgq
  type (symmetry), intent(in) :: syms
  type (xctinfo), intent(inout) :: xct
  integer, intent(out) :: indexq(xct%nkpt_fi)
  type (plotxct_t), intent(in) :: pxct

  type (input_reader_t) :: inp !< the input reader `object`
  type (crystal) :: crysq
  type (kpoints) :: kpq
  type (symmetry) :: symsq
  character :: filenamev*20
  character :: tmpfn*16, errmsg*100
  integer :: iunit_v,dummygvec(1,1)
  logical :: send_any !< = any(send_to)
  integer :: ii,jj,ik,ikq,irkq
  logical :: irkq_match
  real(DP) :: delta,qq(3),tol

  character(len=3) :: sheader
  integer :: iflavor
  type(gspace) :: gvecq

  logical :: skip_checkbz
  
  PUSH_SUB(input_q)

!-----------------------------------------------------------------------
!     Read data in WFNq_fi

  if(peinf%inode.eq.0) call open_file(unit=26,file='WFNq_fi',form='unformatted',status='old')

  sheader = 'WFN'
  iflavor = 0
  call read_binary_header_type(26, sheader, iflavor, kpq, gvecq, symsq, crysq, warn = .false.)

  call check_header('WFN_fi', kpq, gvec, syms, crys, 'WFNq_fi', kpq, gvecq, symsq, crysq, is_wfn = .true.)
  ! there is no kp object in this code??

  kpq%nvband=minval(kpq%ifmax(:,:)-kpq%ifmin(:,:))+1
  if(xct%nvb_fi.gt.kpq%nvband) then
    write(errmsg,'(a,i6,a,i6,a)') 'You requested ', xct%nvb_fi, ' valence bands but WFNq_fi contains only ', kpq%nvband, '.'
    call die(errmsg, only_root_writes = .true.)
  endif
  
  call read_binary_gvectors(26, gvec%ng, gvec%ng, dummygvec, dont_read = .true.)

!
!     Define shifted irreducible BZ, kgq%r, and define the shift vector
!     (if not done before). Make sure it is right!
!
  kgq%nr=kpq%nrk
  SAFE_ALLOCATE(kgq%r, (3,kgq%nr))
  kgq%r(1:3,1:kgq%nr)=kpq%rk(1:3,1:kpq%nrk)
  xct%qshift= sqrt( DOT_PRODUCT(xct%shift(:), &
    MATMUL(crys%bdot,xct%shift(:) )) )
  if (xct%qshift.eq.0.d0) then
    xct%shift(:)=kgq%r(:,1)-kg%r(:,1)
    xct%qshift= sqrt( DOT_PRODUCT(xct%shift(:), &
      MATMUL(crys%bdot,xct%shift(:) )) )
  endif
  if(peinf%inode.eq.0) write(6,90) xct%shift(:),xct%qshift
90 format(/,2x,'Shift vector : ',3f9.5,2x,'Length =',f8.5,/)

!-----------------------------------------------------------------------
!     Generate full brillouin zone from irreducible wedge, rk -> fk

  if (.not.pxct%unfoldq) then
    call fullbz(crys,symsq,kgq,1,skip_checkbz,wigner_seitz=.true.,paranoid=pxct%bz_paranoid)
  else
    call fullbz(crys,symsq,kgq,symsq%ntran,skip_checkbz,wigner_seitz=.true.,paranoid=pxct%bz_paranoid)
  endif
  tmpfn='WFNq_fi'
  if (.not. skip_checkbz) then
    call checkbz(kgq%nf,kgq%f,kpq%kgrid,kpq%shift,crys%bdot, &
      tmpfn,'k',.true.,xct%freplacebz,xct%fwritebz)
  endif
  call logit('input_q:  done unfolding/checking BZ')

!-----------------------------------------------------------------------
!     Find correspondence with fk from WFNq_fi
!
!     indexq : correspondence between a k-point in the full BZ, kg%f, and
!       its shifted vector, in kgq%f
!     tol : tolerance

  tol = 1.d-6
  do ik=1,kg%nf
    ikq=0
    delta=0.1d0
    do while((delta.gt.tol).and.(ikq.lt.kgq%nf))
      ikq=ikq+1
      qq(:) = kg%f(:,ik)-(kgq%f(:,ikq)-xct%shift(:))
      qq(:) = qq(:) - anint( qq(:) )
      delta=sqrt(sum(qq(:)**2))
    enddo
    if(delta.gt.tol) then
      if(peinf%inode.eq.0) then
        write(0,'(a,3f12.6)') 'Could not find point equivalent to ', (kg%f(ii,ik),ii=1,3)
      endif
      call die('k-point mismatch between WFN_fi and WFNq_fi.', only_root_writes = .true.)
    else
!
!     make sure that kgq%f(:,ikq)-kg%f(:,ik) = shift vector
!     Near the zone edge, they may differ by a lattice vector
!
      do jj=1,3
        ii = nint( kgq%f(jj,ikq)-kg%f(jj,ik) )
        kgq%f(jj,ikq) = kgq%f(jj,ikq) - dble(ii)
        kgq%kg0(jj,ikq) = kgq%kg0(jj,ikq) - ii
      enddo
      qq(:) = kg%f(:,ik)-(kgq%f(:,ikq)-xct%shift(:))
      delta=sqrt(sum(qq(:)**2))
      if (delta.gt.tol) then
        call die('k-point mismatch between WFN_fi and WFNq_fi. Wrong shift', only_root_writes = .true.)
      endif
      indexq(ik)=ikq
    endif
  enddo
  call logit('input_q:  done mapping kpts (1)')

!-----------------------------------------------------------------------
!     Read the wavefunctions and create INT_VWFNQ_*

  call logit('input_q:  reading WFNq_fi')

  if(peinf%inode.lt.10000) then
    write(filenamev,'(a,i4.4)') 'INT_VWFNQ_', peinf%inode
  else
    call die('input_q: cannot use more than 10000 nodes')
  endif
  iunit_v=128+(2*peinf%inode)+2
  call open_file(iunit_v,file=filenamev,form='unformatted',status='replace')

  !FHJ : set up input reader `object`
  call init_reader(inp, 26, iunit_v, 'WFNq_fi', kpq, xct, gvec)

  do irkq = 1, kpq%nrk

    inp%ng = kpq%ngk(irkq)

    ! FHJ: this scales as nk^2, but could scale as nk*log(nk)
    irkq_match = .false.
    do ii=1,kg%nf
      if (irkq == kgq%indr(indexq(ii))) then
        irkq_match = .true.
        exit
      endif
    enddo

    ! FHJ: Determine to which PE the wavefunctions for this k-point need to be sent.
    send_any = .false.
    inp%send_to(:) = .false.
    do jj=1,peinf%npes
      do ii=1, peinf%ikt(jj)
        if(kgq%indr(indexq(peinf%ik(jj,ii))).eq.irkq) then
          inp%send_to(jj) = .true.
          send_any = .true.
          exit
        endif
      enddo
    enddo

    ! FHJ: Don`t bother reading data if we don`t need the kpt
    if((.not. send_any) .or. (.not. irkq_match)) then
      call skip_kpt(inp)
      cycle
    endif

    ! FHJ: Read gvectors` indices, store in inp%isort
    call read_gvecs(inp, irkq, gvec)

    ! FHJ: Read all bands and distribute
    call read_bands(inp, irkq)

  enddo !end loop over k-points

  call free_reader(inp)
  
  if (peinf%inode.eq.0) then
    SAFE_DEALLOCATE_P(kpq%rk)
    SAFE_DEALLOCATE_P(kpq%ifmin)
    SAFE_DEALLOCATE_P(kpq%ifmax)
    SAFE_DEALLOCATE_P(kpq%el)
  endif
  
!-------------------------------
! Write out info about xtal

  if(peinf%inode.eq.0) then
    write(6,4004)
4004 format(/,2x,'crystal wavefunctions read from unit WFNq_fi')
    write(6,3007) kgq%nr
3007 format(/,6x,'nrk= ',i6,26x)
    write(6,3070) kgq%nf,kgq%sz
3070 format(/,6x,'  fine grid     nfk= ',i6,4x,'ksz=',f10.5)
    
    call close_file(26)
  endif !end if(inode.eq.0)
  
  call close_file(iunit_v)

  ! only needed for comm_disk
#ifdef MPI
  call MPI_Barrier(MPI_COMM_WORLD, mpierr)
#endif
  call logit('input_q:  done reading WFNq_fi')

  POP_SUB(input_q)

  return
end subroutine input_q
