!
! SIB: This routine looks the same as input().
! Except it reads from WFNq and
! writes to iunit_v='INT_VWFQ' and only valence bands.
! And k-point information is read into kpq.
!
!     SUBROUTINE READS CRYSTAL DATA AND WAVEFUNCTIONS FROM TAPE26
!     AND PARAMETERS FOR POLARIZABILITY CALCULATION FROM TAPE5
!     TAPE10 (OUTPUT TAPE) IS INITIALIZED

#include "f_defs.h"

module input_q_m

  use global_m
  use eqpcor_m
  use input_utils_m
  use misc_m
  use scissors_m
  use wfn_rho_vxc_io_m
  use io_utils_m
#ifdef HDF5
  use hdf5
#endif
  use wfn_io_hdf5_m

  implicit none

  private
  public :: input_q

contains

subroutine input_q(gvec,kpq,cwfn,vwfn,pol,intwfnvq)
  type (gspace), intent(in) :: gvec
  type (kpoints), intent(out) :: kpq
  type (conduction_wfns), intent(in) :: cwfn
  type (valence_wfns), intent(in) :: vwfn
  type (polarizability), intent(inout) :: pol
  type (int_wavefunction), intent(out) :: intwfnvq

  type (crystal) :: crys
  type (symmetry) :: syms

  real(DP) :: vcell
  integer :: dummygvec(1, 1)
  character :: fncor*32

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

  PUSH_SUB(input_q)

  sheader = 'WFN'
  iflavor = 0
  if(pol%os_hdf5) then
  else
    if(peinf%inode == 0) then
      write(6,'(a)') ' Reading header of WFNq'
      call open_file(26,file='WFNq',form='unformatted',status='old')
    endif
    call read_binary_header_type(26, sheader, iflavor, kpq, gvecq, syms, crys, &
      dont_warn_kgrid=pol%subsample, warn=.false.)
    call read_binary_gvectors(26, gvecq%ng, gvecq%ng, dummygvec, dont_read = .true.)
  endif
  call check_trunc_kpts(pol%icutv, kpq)

  call scissors_shift(kpq, pol%scis)

  if(peinf%inode == 0) then
    call get_volume(vcell,crys%bdot)
    if (abs(crys%celvol-vcell).gt.TOL_Small) then
      call die('volume mismatch')
    endif

!-----------------------------------------------------------------
! If a quasi-particle correction file exists, read the corrected
! quasiparticle energies from file (in eV)

    if(pol%eqp_corrections) then
      fncor='eqp_q.dat'
      call eqpcor(fncor,0,1,kpq,1,vwfn%nband+pol%ncrit,0,0,kpq%el,kpq%el,kpq%el,1,0)
    endif
    
    call find_efermi(pol%rfermi, pol%efermi, pol%efermi_input, kpq, kpq%mnband, 1, &
      "shifted grid", should_search = .false., should_update = .false., write7 = .true.)
    ! note: here ifmax may be updated. We will never use it, so it does not matter that it only happens on proc 0. -DAS

    if(any (kpq%ifmax(:,:) < vwfn%nband .or. kpq%ifmax(:,:) > vwfn%nband + pol%ncrit)) then
      write(0,'(a,i6,a,i6,a)') 'epsilon.inp says there are ', vwfn%nband, ' fully occupied bands and ', &
        pol%ncrit, ' partially occupied.'
      write(0,'(a,2i6)') 'This is inconsistent with highest bands in WFNq file; min, max = ', minval(kpq%ifmax), maxval(kpq%ifmax)
      call die("band_occupation, number_partial_occup, and WFNq inconsistent.")
    endif
    
    if(maxval(kpq%ifmax) - minval(kpq%ifmax) > pol%ncrit) then
      write(0,'(a,i6,a)') 'epsilon.inp says there are ', pol%ncrit, ' partially occupied bands.'
      write(0,'(a,i6)') 'This is less than the number partially occupied in WFNq file: ', maxval(kpq%ifmax) - minval(kpq%ifmax)
      call die("number_partial_occup and WFNq inconsistent.")
    endif

  endif ! of proc 0 reading

!      if (peinf%inode .eq. 0) write(6,*) ""
!      if (peinf%inode .eq. 0) write(6,*) "Q Read Header", kpq%nspin,kpq%nrk,kpq%kgrid,kpq%shift

  if(pol%os_hdf5) then
  else
    call read_wavefunctions(kpq, gvec, pol, cwfn, vwfn, intwfnvq)
    if(peinf%inode.eq.0) then
      call close_file(26)
    endif
  endif
  
! Writes some info about xtal

  if (peinf%inode.eq.0)  then
    
    write(6,100)
    write(7,100)
100 format(/,1x,'Crystal k+q WFs read from WFNq')
    
  endif

  if(pol%iwriteint == 0) then
#ifdef MPI
    call MPI_Barrier(MPI_COMM_WORLD, mpierr)
#endif
  endif

  POP_SUB(input_q)
  
  return
end subroutine input_q


subroutine read_wavefunctions(kpq, gvec, pol, cwfn, vwfn, intwfnvq)
  type (kpoints), intent(in) :: kpq
  type (gspace), intent(in) :: gvec
  type (polarizability), intent(in) :: pol
  type (conduction_wfns), intent(in) :: cwfn
  type (valence_wfns), intent(in) :: vwfn
  type (int_wavefunction), intent(out) :: intwfnvq

  integer, allocatable :: isort(:)
  SCALAR, allocatable :: zc(:,:)

  character :: filenamevq*20
  integer :: i,j,k,ik,iiii,is
  integer :: iunit_v
  real(DP) :: qk(3)
  logical :: dont_read
  
  type(gspace) :: gvec_kpt
  type(progress_info) :: prog_info !< a user-friendly progress report

  PUSH_SUB(read_wavefunctions)

! JRD:  proc 0 opens unit (iunit_v) with name 'INT_VWFQ'
      
  if (pol%iwriteint .eq. 0) then
    if(peinf%inode.eq.0) then
      write(filenamevq,'(a)') 'INT_VWFQ'
      iunit_v=300028
      call open_file(iunit_v,file=filenamevq,form='unformatted',status='replace')
    endif
  else
    SAFE_ALLOCATE(intwfnvq%ng, (kpq%nrk))
    SAFE_ALLOCATE(intwfnvq%isort, (kpq%ngkmax,kpq%nrk))
    SAFE_ALLOCATE(intwfnvq%cg, (kpq%ngkmax,kpq%nrk*peinf%nvownactual,kpq%nspin*kpq%nspinor))
    SAFE_ALLOCATE(intwfnvq%qk, (3,kpq%nrk))
  endif
  
  call progress_init(prog_info, 'reading wavefunctions (WFNq)', 'state', kpq%nrk*(vwfn%nband+pol%ncrit))
  do ik=1,kpq%nrk
    qk(1:3) = kpq%rk(1:3, ik)
    SAFE_ALLOCATE(gvec_kpt%components, (3, kpq%ngk(ik)))

    call read_binary_gvectors(26, kpq%ngk(ik), kpq%ngk(ik), gvec_kpt%components)

    SAFE_ALLOCATE(isort, (kpq%ngk(ik)))
    do i = 1, kpq%ngk(ik)
      call findvector(isort(i), gvec_kpt%components(:, i), gvec)
      if (isort(i) == 0) then
        if(peinf%inode == 0) write(0,*) 'ik = ', ik, 'ig = ', i, 'gvec = ', gvec_kpt%components(:, i)
        call die('input_q: could not find gvec')
      endif
    enddo
    SAFE_DEALLOCATE_P(gvec_kpt%components)

! JRD: 0 proc write kpq%ngk(ik), isort(), and other stuff to iunit_v

    if (pol%iwriteint .eq. 0) then
      if (peinf%inode.eq.0)  then
        write(iunit_v) kpq%ngk(ik),(isort(j),j=1,kpq%ngk(ik)), &
          ((kpq%el(j,ik,k),j=1,(vwfn%nband+pol%ncrit)), & 
          k=1,kpq%nspin),(qk(i),i=1,3)
      endif
    else
      intwfnvq%ng(ik)=kpq%ngk(ik)
      intwfnvq%isort(1:kpq%ngk(ik),ik)=isort(1:kpq%ngk(ik))
      intwfnvq%qk(:,ik)=qk(:)
    endif
!
! SIB:  loop on max number of bands, and proc 0 reads the wave function
! from unit 26, checks normalization, and if the band is less than
! cwfn%nband (# of bands in total) **AND** is a valence band (so
! its index is <= vwfn%nband), then it is written to iunit_v.
!
    SAFE_ALLOCATE(zc, (kpq%ngk(ik), kpq%nspinor*kpq%nspin))

    do i=1,kpq%mnband

      dont_read = i > cwfn%nband
      if(.not. dont_read) dont_read = cwfn%band_index(i) > vwfn%nband+pol%ncrit
      call read_binary_data(26, kpq%ngk(ik), kpq%ngk(ik), kpq%nspin*kpq%nspinor, zc, dont_read = dont_read)

      ! FHJ: the following lines were introduced in r6294 and are supposed to
      ! be a shortcut if we are past the last band of the last k-point. However,
      ! in light of a previous bug (#223), this feature is commented out for now.
      !! FHJ: shortcut if this is past the last band of the last k-point
      !if (dont_read .and. ik==kpq%nrk) exit
      if (.not.dont_read) then

        call progress_step(prog_info, (ik-1)*(vwfn%nband+pol%ncrit) + i)
        if (peinf%inode == 0) then
          do is = 1, kpq%nspin
            call checknorm('WFNq',i,ik,kpq%ngk(ik),is,kpq%nspinor,zc(:,:))
          enddo
        endif

        if (pol%iwriteint .eq. 0) then
          if (peinf%inode .eq. 0) then
            write(iunit_v) ((zc(j,k),j=1,kpq%ngk(ik)),k=1,kpq%nspinor*kpq%nspin)
          endif
        else
          if (peinf%doiownv(cwfn%band_index(i))) then
            iiii=peinf%indexv(cwfn%band_index(i))+(ik-1)*peinf%nvownactual
            intwfnvq%cg(1:kpq%ngk(ik),iiii,1:kpq%nspin*kpq%nspinor)=zc(1:kpq%ngk(ik),1:kpq%nspinor*kpq%nspin)
          endif
        endif
      endif
    enddo
    SAFE_DEALLOCATE(isort)
    SAFE_DEALLOCATE(zc)
  enddo                     ! end loop over k+q points
  call progress_free(prog_info)

  if(peinf%inode.eq.0) then
    if (pol%iwriteint .eq. 0) call close_file(iunit_v)
  endif

  POP_SUB(read_wavefunctions)
  return

end subroutine read_wavefunctions

end module input_q_m
