!===============================================================================
!
! Routines:
!
! (1) genwf_disk()   Originally By ?                 Last Modified 9/23/2009
!
! Generates valence and conduction wavefunctions at k-point rkq = rkn - rq
! from wavefunctions at k-point rkn read from temporary INT_CWFN_* files.
!
!===============================================================================

#include "f_defs.h"

subroutine genwf_disk(rkq,syms,gvec,crys,kp,sig,wfnkq,iunit_c,fnc)

  use global_m
  use gmap_m
  use input_utils_m
  use sort_m
  use misc_m

  implicit none

  real(DP), intent(in) :: rkq(3)
  type (symmetry), intent(in) :: syms
  type (gspace), intent(in) :: gvec
  type (crystal), intent(in) :: crys
  type (kpoints), intent(in) :: kp
  type (siginfo), intent(in) :: sig
  type (wfnkqstates), intent(inout) :: wfnkq !< pointers are allocated outside
  integer, intent(in) :: iunit_c
  character*20, intent(in) :: fnc

  integer :: nkpti
  integer :: nbandi
  integer, allocatable :: isrtk(:)
  SCALAR, allocatable :: zin(:,:)

  integer :: ii,ij,jj,ik,iin,irk,ikn1,it,iband,icount,ispin
  integer :: naddv
  integer :: nkpt2,kg0(3)
  integer, allocatable :: isorti(:),ind(:)
  real(DP) :: del,qk(3)
  real(DP), allocatable :: xnorm(:,:)
  real(DP), allocatable :: ekin(:)
  SCALAR, allocatable :: ph(:)
  logical :: found

!---------------------------------------
! find rotation (R), translation (g0), and reduced k-point (rk)
! such that krq = rkn - rq = R(rk) + g0
! it = rotation, kg0 = translation, irk = reduced k-point

  PUSH_SUB(genwf_disk)

  found = .false.
  irk_loop: do irk=1,kp%nrk
    it_loop: do it=1,syms%ntran
      do ii=1,3
        qk(ii) = DOT_PRODUCT(dble(syms%mtrx(ii,:,it)),kp%rk(:,irk))
        del = rkq(ii) - qk(ii)
        if (del .ge. 0.0d0) kg0(ii) = del + TOL_Small
        if (del .lt. 0.0d0) kg0(ii) = del - TOL_Small
        if (abs(del-kg0(ii)) .gt. TOL_Small) cycle it_loop
      enddo
      found = .true.
      exit irk_loop
    enddo it_loop
  enddo irk_loop
  if(.not. found) call die('genwf: rkq mismatch')
  ikn1 = irk

!---------------------------------------
! Read in (rk-q) wavefunction

  call open_file(iunit_c,file=fnc,form='unformatted',status='old')
  
  if (ikn1.gt.1) then
    icount=0
    do ii=1,ikn1-1
      icount=icount+peinf%ntband_node+1
    enddo
    do ii=1,icount
      read(iunit_c)
    enddo
  endif
  SAFE_ALLOCATE(ekin, (gvec%ng))
  SAFE_ALLOCATE(isrtk, (gvec%ng))
  SAFE_ALLOCATE(isorti, (gvec%ng))
  SAFE_ALLOCATE(ind, (gvec%ng))
  SAFE_ALLOCATE(ph, (gvec%ng))
  read(iunit_c) nkpti,nbandi,(isrtk(ij),ij=1,gvec%ng), &
    ((wfnkq%ekq(ij,ik),ij=1,nbandi),ik=1,sig%nspin),(qk(ii),ii=1,3)
  wfnkq%nkpt=nkpti
  if (any(abs(kp%rk(1:3,ikn1)-qk(1:3)) .gt. TOL_Small)) then
    call die('genwf: kp mismatch')
  endif

!---------------------------------------
! Compute inverse to array isort
! isrtk orders |rk + G|^2
! isrtkq  orders |rkn - rq + G|^2
! with krq = rkn - rq = R(rk) + g0

  isorti(:)=0
  do ii=1,nkpti
    isorti(isrtk(ii))=ii
  enddo
  SAFE_DEALLOCATE(isrtk)

!---------------------------------------
! compute kinetic energy for rkq = rk-q

  call kinetic_energies(gvec, crys%bdot, ekin, qvec = rkq)

!---------------------------------------
! sort array ekin to ascending order
! store indices in array isort

  call sortrx(gvec%ng, ekin, wfnkq%isrtkq, gvec = gvec%components)

!---------------------------------------
! map indices for rk(ikn1) to those for rkq

  call gmap(gvec,syms,nkpti,it,kg0, &
    wfnkq%isrtkq,isorti,ind,ph,.true.)

!---------------------------------------
! loop over wfnkq%zkq wavefunctions
! map zin wfns onto wfnkq%zkq

  SAFE_ALLOCATE(xnorm, (sig%ntband,sig%nspin))
  SAFE_ALLOCATE(zin, (wfnkq%nkpt,sig%nspin*kp%nspinor))
  SAFE_ALLOCATE(wfnkq%zkq, (peinf%ntband_node*wfnkq%nkpt,sig%nspin*kp%nspinor))
  do iin=1,peinf%ntband_node
    read(iunit_c) iband,nkpt2,((zin(jj,ik),jj=1,nkpt2),ik=1,sig%nspin*kp%nspinor)
    if (iband.ne.peinf%indext(iin)) then
      if(peinf%inode.eq.0) then
        write(0,*) 'iband=',iband,' <> ',peinf%indext(iin)
      endif
      call die('genwf: iband error')
    endif
    
    naddv = (iin-1)*wfnkq%nkpt

!---------------------------------------
! loop over components of zv

    do ispin=1,sig%nspin*kp%nspinor
      wfnkq%zkq(1+naddv:wfnkq%nkpt+naddv,ispin) = &
        zin(ind(1:wfnkq%nkpt),ispin)*ph(1:wfnkq%nkpt)
    enddo


! BAB: We check if the norm differs appreciably from unity.
! There is no longer a need to further normalize the vector.

    do ispin=1,sig%nspin
      call compute_norm(xnorm(iin,ispin),ispin,wfnkq%nkpt,kp%nspinor,wfnkq%zkq(:,:))
      if(abs(xnorm(iin,ispin) - 1d0) > TOL_Small) then
        write(0,*) 'Bad norm: irk=',irk,'ispin=',ispin,'norm=',xnorm(iin,ispin)
        call die('genwf_mpi: Bad norm')
      endif
    enddo
  enddo
  SAFE_DEALLOCATE(ekin)
  SAFE_DEALLOCATE(isorti)
  SAFE_DEALLOCATE(ind)
  SAFE_DEALLOCATE(ph)

  call close_file(iunit_c)

!---------------------------------------
! end of loop over wavefunctions

  POP_SUB(genwf_disk)
  
  return
end subroutine genwf_disk
