#include "f_defs.h"

!-----------------------------------------------------------------------
subroutine input_q(kp,crys,gvec,kg,kgq,kpq,syms,xct, &
  indexq,eqp,flag,intwfnv)
!-----------------------------------------------------------------------
!
!     Read data from file WFN_fi or WFNq_fi and initialize variables
!     (only called if flag%vm.ne.1.or.flag%dtm.ne.1)
!
!     input: crys, gvec, kg, kp, syms, xct types
!
!     output: kgq type
!             indexq(1:xct%nkpt_fi) - mapping of points in shifted grid
!             INT_VWFNQ_* files
!
  use global_m
  use checkbz_m
  use eqpcor_m
  use fullbz_m
  use input_utils_m
  use misc_m
  use scissors_m
  use wfn_rho_vxc_io_m
  use io_utils_m
  implicit none

  type (crystal), intent(in) :: crys
  type (kpoints), intent(in) :: kp
  type (gspace), intent(in) :: gvec
  type (grid), intent(in) :: kg
  type (grid), intent(out) :: kgq
  type (kpoints), intent(out) :: kpq
  type (symmetry), intent(in) :: syms
  type (xctinfo), intent(inout) :: xct
  type (flags), intent(in) :: flag
  integer, intent(out) :: indexq(xct%nkpt_fi)
  type (eqpinfo), intent(inout) :: eqp
  type (int_wavefunction), intent(out) :: intwfnv      

  type (symmetry) :: symsq
  type (crystal) :: crysq
  type (wavefunction) :: wfnv
  character :: wfnq0*16
  character :: filenamev*20
  character :: tmpfn*16
  character :: fncor*32
  integer :: iunit_v,iwrite
  integer :: ii,jj,kk,ik,ikq,irkq,is,ispinor,ib,ibq, irk
  integer :: dest,tag,dummygvec(1,1)
  integer :: iwritetotal,ijk,minband
  real(DP) :: delta,qq(3),tol
  integer, allocatable :: isend(:),iwriteik(:)
  SCALAR, allocatable :: cg(:,:), cgarray(:)

  character(len=3) :: sheader
  integer :: iflavor
  type(gspace) :: gvecq, gvec_kpt
  logical :: irkq_match
  integer :: last_ng, last_ng_match, last_ikt
  logical :: skip_checkbz, broken_degeneracy
  !> Number of bands that were corrected (via scissors or eqp). We can`t find 
  !! the FE using more bands than this number.
  integer :: bands_cor
  type(progress_info) :: prog_info

  PUSH_SUB(input_q)

  if (flag%opr .eq. 0) then
    wfnq0 = 'WFNq_fi'
    fncor='eqp_q.dat'
  else
    wfnq0 = 'WFN_fi'
    fncor='eqp.dat'
  endif

  if(peinf%inode == 0) call open_file(26,file=wfnq0,form='unformatted',status='old')

  sheader = 'WFN'
  iflavor = 0
  call read_binary_header_type(26, sheader, iflavor, kpq, gvecq, symsq, crysq, &
    warn = .false., dont_warn_kgrid = xct%patched_sampling.or..not.xct%is_absorption)

! When using the velocity operator and q shift in a truncated direction,
! WFNq_fi will have k-points with nonzero coordinates in that direction, so
! we should not issue a warning in that case. --DAS
!  call check_trunc_kpts(xct%icutv, kpq)
    
  call check_header('WFN_fi', kp, gvec, syms, crys, wfnq0, kpq, gvecq, symsq, crysq, is_wfn = .true.)

  if(any(kp%kgrid(1:3) /= kpq%kgrid(1:3))) then
    if(peinf%inode == 0) then
      write(0,*) 'WFN_fi  kgrid = ', kp%kgrid(1:3)
      write(0,*) 'WFNq_fi kgrid = ', kpq%kgrid(1:3)
    endif
    call die('kgrids for WFN_fi and WFNq_fi must be the same', only_root_writes = .true.)
  endif

  SAFE_ALLOCATE(kpq%elda, (kpq%mnband, kpq%nrk, kpq%nspin))
  kpq%elda(1:kpq%mnband, 1:kpq%nrk, 1:kpq%nspin) = kpq%el(1:kpq%mnband, 1:kpq%nrk, 1:kpq%nspin)
  call scissors_shift(kpq, eqp%scis, eqp%spl_tck)

!-----------------------------------------------------------------------
! If quasi-particle correction requested, read the corrected
! qp energies from file (in eV)

  minband = 1
  bands_cor = kpq%mnband
  if(xct%eqp_corrections) then
    if (flag%opr .eq. 0) then !eqp_q.dat
      bands_cor = maxval(kpq%ifmax(:,:))
    else !eqp.dat
      bands_cor = maxval(kpq%ifmax(:,:)) + xct%ncb_fi
    endif
    bands_cor = min(bands_cor, kpq%mnband)
    minband = minval(kpq%ifmax(:,:)-xct%nvb_fi+1)
    ! FIXME: for metals this is asking for a few more bands than actually needed on some k-points
    call eqpcor(fncor,peinf%inode,peinf%npes,kpq, &
      minband,bands_cor,0,0,kpq%el,kpq%el,kpq%el,1,0)
  endif

  call find_efermi(xct%rfermi, xct%efermi, xct%efermi_input, kpq, bands_cor, minband, &
    "shifted fine grid", should_search = .false., should_update = .false., write7 = .false.)
  
  call read_binary_gvectors(26, gvec%ng, gvec%ng, dummygvec, dont_read = .true.)

  if(any(kpq%ifmax(:,:) == 0)) & 
    call die("BSE codes cannot handle a system where some k-points have no occupied bands.", only_root_writes = .true.) 
 
  kpq%nvband=minval(kpq%ifmax(:,:)-kpq%ifmin(:,:))+1
  kpq%ncband=kpq%mnband-maxval(kpq%ifmax(:,:))

!----------------------------------
! Manual override of band numbers
!
  if (xct%vmax.ne.0) then
    kpq%nvband = xct%vmax-xct%vmin+1
    kpq%ncband = kpq%mnband-xct%vmax
    if (peinf%inode.eq.0) then
      write(6,*)
      write(6,*) '*** Overwrite min/max occupied state for fine grid wavefunctions'
      write(6,*) '*** kpq%nvband =',kpq%nvband,' kpq%ncband =',kpq%ncband
      write(6,*)
    endif
  endif

!----------------------------------------------------------------
! (gsm) check whether the requested number of bands
!       is available in the wavefunction file

! we only use the valence bands from WFNq_fi
! if flag%vm.eq.1.and.flag%dtm.eq.1 we don`t need them at all
! subroutine input_q is only called if flag%vm.ne.1.or.flag%dtm.ne.1

  if(xct%nvb_fi .gt. kpq%nvband) then
    call die("The requested number of valence bands is not available in " // TRUNC(wfnq0) // ".")
  endif
!  if(xct%ncb_fi .gt. kpq%ncband) then
!    call die("The requested number of conduction bands is not available in " // TRUNC(wfnq0) // ".")
!  endif

! DAS: degenerate subspace check

  ! degeneracy does not matter for WFNq_fi in inteqp
  if (peinf%inode.eq.0 .and. xct%is_absorption) then
    broken_degeneracy = .false.
    do jj = 1, kpq%nspin
      do ii = 1, kpq%nrk
        if(kpq%ifmax(ii, jj) - xct%nvb_fi > 0) then
          ! no need to compare against band 0 if all valence are included
          if(abs(kpq%elda(kpq%ifmax(ii, jj) - xct%nvb_fi + 1, ii, jj) &
            - kpq%elda(kpq%ifmax(ii, jj) - xct%nvb_fi, ii, jj)) .lt. TOL_Degeneracy) then
            broken_degeneracy = .true.
          endif
        endif
      enddo
    enddo

    if(broken_degeneracy) then
      if(xct%degeneracy_check_override) then
        write(0,'(a)') &
          "WARNING: Selected number of valence bands breaks degenerate subspace in " // TRUNC(wfnq0) // &
          ". Run degeneracy_check.x for allowable numbers."
        write(0,*)
      else
        write(0,'(a)') &
          "Run degeneracy_check.x for allowable numbers, or use keyword " // &
          "degeneracy_check_override to run anyway (at your peril!)."
        call die("Selected number of valence bands breaks degenerate subspace in " // TRUNC(wfnq0) // ".")
      endif
    endif
  endif

!-----------------------------------------------------------------------
!     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 (.not. xct%read_kpoints .and. abs(xct%qshift).lt.TOL_Zero) then
    xct%shift(:)=kgq%r(:,1)-kg%r(:,1)
    xct%qshift= sqrt( DOT_PRODUCT(xct%shift(:), MATMUL(crys%bdot,xct%shift(:) )) )
  endif
  ! We only need q_shift for the velocity operator
  if(flag%opr == 0) then
    if(peinf%inode.eq.0) write(6,90) xct%shift(:),xct%qshift
90 format(1x,'Shift vector : ',3f9.5,2x,'Length =',f8.5,/)
    if(xct%qshift < TOL_Small) call die("q-shift vector may not be zero.", only_root_writes = .true.)
  endif

!-----------------------------------------------------------------------
!     Define the polarization vector (used only with momentum operator and absorption)
!
  xct%lpol=sqrt(DOT_PRODUCT(xct%pol,MATMUL(crys%bdot,xct%pol)))
  if (abs(xct%lpol).lt.TOL_Zero) then
    xct%pol = xct%shift(:)
    xct%lpol=sqrt(DOT_PRODUCT(xct%pol,MATMUL(crys%bdot,xct%pol)))
  endif
  if(flag%opr == 1 .and. xct%is_absorption) then
    if(peinf%inode.eq.0) write(6,92) xct%pol(:),xct%lpol
92 format(1x,'Polarization vector : ',3f9.5,2x,'Length =',f8.5,/)
    if(xct%lpol < TOL_Small) call die("Polarization vector may not be zero.", only_root_writes = .true.)
  endif
  
!-----------------------------------------------------------------------
!     Generate full Brillouin zone from irreducible wedge, rk -> fk
!
  if (flag%bzq.eq.1 .and. .not. xct%is_absorption) then
    ! in the inteqp code, we want to leave the k-points alone, if symmetries are not being used.
    call fullbz(crys,symsq,kgq,1,skip_checkbz,wigner_seitz=.false.,paranoid=.false.,do_nothing=.true.)
  else if (flag%bzq.eq.1) then
    call fullbz(crys,symsq,kgq,1,skip_checkbz,wigner_seitz=.true.,paranoid=.true.)
  else
    call fullbz(crys,symsq,kgq,symsq%ntran,skip_checkbz,wigner_seitz=.true.,paranoid=.true.)
  endif
  xct%nkptq_fi = kgq%nf
  tmpfn=wfnq0
  if (.not. skip_checkbz .and. .not.xct%patched_sampling) then
    call checkbz(kgq%nf,kgq%f,kpq%kgrid,kpq%shift,crys%bdot, &
      tmpfn,'k',.true.,xct%freplacebz,xct%fwritebz)
  endif

  if (flag%bzq.eq.0.and.peinf%inode.eq.0) write(6,801)
  if (flag%bzq.eq.1.and.peinf%inode.eq.0) write(6,802)
801 format(1x,'Using symmetries to expand the shifted-grid sampling',/)
802 format(1x,'No symmetries used in the shifted-grid sampling',/)

  SAFE_ALLOCATE(xct%ifmaxq, (kgq%nf,xct%nspin))
  xct%ifmaxq(:,:)=kpq%ifmax(kgq%indr(:),:)

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

!-----------------------------------------------------------------------
!      For a test by Cheol Hwan (1.26.05)
!          write(6,*) 'kg%nf =', kg%nf, 'kgq%nf =', kgq%nf,
!     >                 xct%shift(1),xct%shift(2),xct%shift(3)

  do ik=1,kg%nf
    ikq=0
    delta=0.1d0
    do while((delta.gt.tol).and.(ikq.lt.kgq%nf))
      ikq=ikq+1
      
!-----------------------------------------------------------------------
!      For a test by Cheol Hwan (1.26.05)
!         write(6,*) kg%f(1,ik),kg%f(2,ik),kg%f(3,ik),
!     >         kgq%f(1,ikq)-xct%shift(1),kgq%f(2,ikq)-xct%shift(2),
!     >         kgq%f(3,ikq)-xct%shift(3)

      qq(:) = kg%f(:,ik)-(kgq%f(:,ikq)-xct%shift(:))
      do kk=1,3
        qq(kk) = qq(kk) - anint( qq(kk) )
      enddo
      delta=sqrt(sum(qq(1:3)**2))
    enddo
    if(delta.gt.tol) then
      if(peinf%inode.eq.0) then
        write(0,*) 'Could not find point equivalent to ', (kg%f(ii,ik),ii=1,3)
      endif
      call die('k-point mismatch between WFN_fi and ' // TRUNC(wfnq0), 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((qq(1))**2+(qq(2))**2+(qq(3))**2)
      if (delta.gt.tol) then
        call die('k-point mismatch between WFN_fi and ' // TRUNC(wfnq0) // '. Wrong shift')
      endif
      indexq(ik)=ikq
    endif
  enddo

  if(kgq%nf /= kg%nf) then
    if(peinf%inode == 0) write(0,'(a,i7,a,i7,a)') 'WFNq_fi unfolds to ', kgq%nf, &
      ' k-points; WFN_fi unfolds to ', kg%nf, ' k-points.'
    call die("WFNq_fi and WFN_fi must have the same number of k-points in the unfolded BZ.", only_root_writes = .true.)
  endif
  ! Each WFN_fi point only needs one WFNq_fi point. In principle it would be ok to have extra unused WFNq_fi points, but in fact
  ! the subsequent code assumes that there are the same number of points, so we will check that here rather than allow mysterious
  ! segfaults or incorrect results later. --DAS

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

! JRD: Debugging
!      if (peinf%inode .eq. 0) then
!         write(6,*) 'Creating INT_VWFNQ_* files'
!      end if

  wfnv%nband=xct%nvb_fi
  wfnv%nspin=kpq%nspin
  wfnv%nspinor=kpq%nspinor
  
  if (xct%iwriteint .eq. 0) then
    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')
  else
    SAFE_ALLOCATE(intwfnv%ng, (peinf%ikt(peinf%inode+1)))
    SAFE_ALLOCATE(intwfnv%isort, (gvec%ng,peinf%ikt(peinf%inode+1)))
    SAFE_ALLOCATE(intwfnv%cgk, (kpq%ngkmax,wfnv%nband,kpq%nspin*kpq%nspinor,peinf%ikt(peinf%inode+1)))
  endif

  SAFE_ALLOCATE(wfnv%isort, (gvec%ng))
  SAFE_ALLOCATE(isend, (peinf%npes))
  wfnv%isort=0
  last_ng=-1
  last_ng_match=-1
  last_ikt=-1
  call progress_init(prog_info, 'reading wavefunctions (WFNq_fi)', 'k-point', kpq%nrk)
  do irkq = 1, kpq%nrk
    call progress_step(prog_info, irkq)
    irkq_match = .false.
    do ii=1,kg%nf
      if (irkq == kgq%indr(indexq(ii))) then
        irkq_match = .true.
        exit
      endif
    enddo

    wfnv%ng = kpq%ngk(irkq)

! FHJ: Realloc arrays. Note that we can`t do something like
!      "if (wfnv%ng>last_ng)"  b/c fortran complains at read_binary_gvectors 
!      if the vectors are not exactly wfnv%ng big.
    if(wfnv%ng/=last_ng) then
      if(last_ng/=-1) then
        SAFE_DEALLOCATE_P(gvec_kpt%components)
        SAFE_DEALLOCATE(cg)
      endif
      SAFE_ALLOCATE(gvec_kpt%components, (3, wfnv%ng))
      SAFE_ALLOCATE(cg, (wfnv%ng, kpq%nspin*kpq%nspinor))
      last_ng = wfnv%ng
    endif

    call read_binary_gvectors(26, wfnv%ng, wfnv%ng, gvec_kpt%components)

!    Skip this k-point if there is no k-point in kg%f that
!    corresponds to it
    if(irkq_match) then
      do ii = 1, kpq%ngk(irkq)
        call findvector(wfnv%isort(ii), gvec_kpt%components(:, ii), gvec)
        if(wfnv%isort(ii) == 0) call die('input_q: could not find gvec')
      enddo

! FHJ: Realloc arrays.
      if(wfnv%ng/=last_ng_match) then
        if(last_ng_match/=-1) then
          SAFE_DEALLOCATE_P(wfnv%cg)
          SAFE_DEALLOCATE(cgarray)
        endif
        SAFE_ALLOCATE(wfnv%cg, (wfnv%ng, wfnv%nband, wfnv%nspin*wfnv%nspinor))
        SAFE_ALLOCATE(cgarray, (wfnv%ng))
        last_ng_match = wfnv%ng
      endif        
      if(peinf%ikt(peinf%inode+1)/=last_ikt) then
        if(last_ikt/=-1) then
          SAFE_DEALLOCATE(iwriteik)
        endif
        SAFE_ALLOCATE(iwriteik,(peinf%ikt(peinf%inode+1)))
        last_ikt = peinf%ikt(peinf%inode+1)
      endif

!       Determine which PEs will write the valence bands for this k-point
      iwrite=0
      iwritetotal=0
      iwriteik=0
      do ii=1, peinf%ikt(peinf%inode+1)
        if(kgq%indr(indexq(peinf%ik(peinf%inode+1,ii))) == irkq) then
          iwritetotal=iwritetotal+1
          iwriteik(iwritetotal)=ii
          iwrite=1
        endif
      enddo

!       Determine to which PEs the valence bands for this k-point
!       need to be sent...
      isend=0
      if(peinf%inode.eq.0) then
        do jj=2,peinf%npes
          do ii=1, peinf%ikt(jj)
            if(kgq%indr(indexq(peinf%ik(jj,ii))) == irkq) then
              isend(jj)=1
              exit
            endif
          enddo
        enddo
      endif
    endif
!
!       Loop over the bands
!
    do ii=1,kpq%mnband
      call read_binary_data(26, kpq%ngk(irkq), kpq%ngk(irkq), kpq%nspin*kpq%nspinor, cg, bcast=.false.)

      if(.not. irkq_match) cycle

      do is=1, kpq%nspin
!         If ii is one of the selected valence bands...
        if((ii.le.kpq%ifmax(irkq,is).and. &
          ii.gt.kpq%ifmax(irkq,is)-xct%nvb_fi)) then

          do ispinor=1, kpq%nspinor
            if (peinf%inode.eq.0) then
              cgarray(1:kpq%ngk(irkq))=cg(1:kpq%ngk(irkq), is*ispinor)
#ifdef VERBOSE
              write(*,'(a, 3i7, 2(f18.13))') 'input_q', irkq, ii, is*ispinor, cgarray(1)
#endif
            end if
#ifdef MPI
            if(peinf%inode.eq.0) then
              do jj=2,peinf%npes
                if(isend(jj).eq.1) then
                  dest=jj-1
                  tag=1000+dest*2-(is-1)
                  call MPI_SEND(cgarray,kpq%ngk(irkq),MPI_SCALAR, &
                    dest,tag,MPI_COMM_WORLD,mpierr)
                endif
              enddo
            else
              if(iwrite.eq.1) then
                tag=1000+peinf%inode*2-(is-1)
                call MPI_RECV(cgarray,kpq%ngk(irkq),MPI_SCALAR,0,tag, &
                  MPI_COMM_WORLD,mpistatus,mpierr)
              endif
            endif
#endif
            if(iwrite.eq.1) then
              wfnv%cg(1:wfnv%ng,kpq%ifmax(irkq,is)-ii+1,is*ispinor) = cgarray
            endif
          enddo
          if(iwrite.eq.1) then
            !FHJ: We only Send/Recv and check one spin at a time
            call checknorm(wfnq0,ii,irkq,kpq%ngk(irkq),is,kpq%nspinor,&
                         wfnv%cg(:,kpq%ifmax(irkq,is)-ii+1,:))
          endif
        end if
      end do
    enddo

    if(.not. irkq_match) cycle
    
    if(iwrite.eq.1) then
      if (xct%iwriteint .eq. 0) then
        write(iunit_v) irkq,wfnv%ng,wfnv%nband,wfnv%nspin,wfnv%nspinor
        write(iunit_v) (wfnv%isort(ii),ii=1,gvec%ng), &
          (((wfnv%cg(ii,jj,kk),ii=1,wfnv%ng),jj=1,wfnv%nband), kk=1,wfnv%nspin*wfnv%nspinor)
      else
        do ijk = 1, iwritetotal
          intwfnv%ng(iwriteik(ijk))=wfnv%ng
          intwfnv%isort(:,iwriteik(ijk))=wfnv%isort(:)
          intwfnv%cgk(1:wfnv%ng,:,:,iwriteik(ijk))=wfnv%cg(1:wfnv%ng,:,:)
        enddo
      endif
    endif
  enddo
  call progress_free(prog_info)

  SAFE_DEALLOCATE(isend)
  SAFE_DEALLOCATE_P(wfnv%isort)

  if(last_ikt/=-1) then
    SAFE_DEALLOCATE(iwriteik)
  endif
  if(last_ng_match/=-1) then
    SAFE_DEALLOCATE_P(wfnv%cg)
    SAFE_DEALLOCATE(cgarray)
  endif
  if(last_ng/=-1) then
    SAFE_DEALLOCATE_P(gvec_kpt%components)
    SAFE_DEALLOCATE(cg)
  endif
      
!
! End loop over k-points
!--------------------------------------------------------------------------------
           
! JRD: For Finite Q we need valence energies
! FHJ: loop thru indices on `eqp` grid, and then find the
!      corresponding labels on the shifted grid
  do is=1,xct%nspin
    do irk=1,xct%nkpt_fi
      !irkq = index of q-pt on shifted grid
      irkq = kgq%indr(indexq(irk))

      !loop thru bands of shifted grid
      do ibq=1, kpq%mnband

        !ib = band index on `eqp` grid
        ib = kpq%ifmax(irkq,is) - ibq + 1

        if ( (ib > 0) .and. (ib <= xct%nvb_fi) ) then
          eqp%evqp (ib, irk, is) = kpq%el(ibq, irkq, is)
          eqp%evlda(ib, irk, is) = kpq%elda(ibq, irkq, is) 
        endif

      enddo
    enddo
  enddo

!-----------------------------
! Deallocate

  SAFE_DEALLOCATE_P(kpq%ifmin)
  SAFE_DEALLOCATE_P(kpq%ifmax)
  SAFE_DEALLOCATE_P(kpq%rk)
  SAFE_DEALLOCATE_P(kpq%el)
  SAFE_DEALLOCATE_P(kpq%elda)


! JRD: Debugging
!      if (peinf%inode .eq. 0) then
!         write(6,*) 'Deallocated arrays'
!      end if

!-----------------------------
! Write out info about xtal

  if(peinf%inode.eq.0) then
    write(6,'(/,1x,a,a)') 'Valence wavefunctions read from file ',TRUNC(wfnq0)
    write(6,'(1x,a,i8)') ' - Number k-points in irreducible BZ: ', kgq%nr
    write(6,'(1x,a,i8)') ' - Number k-points in full BZ: ', kgq%nf
#ifdef VERBOSE
    write(6,'(/,1x,a)') 'Listing all k-points:'
    write(6,'(3x,3f15.9)') ((kgq%r(ii,jj),ii=1,3),jj=1,kgq%nr)
    write(6,'(1x,a,/)') 'Done listing k-points'
#endif
    call close_file(26)
  endif ! node 0

  if (xct%iwriteint .eq. 0) call close_file(iunit_v)

  POP_SUB(input_q)

  return
end subroutine input_q
