!==========================================================================
!
! Routines:
!
! (1) genwf_disk()  Originally By (JRD)             Last Modified 11/2009 (JRD)
!
!     On entry:
!     qq  = current q-vector
!     rk  = current k point in irr. zone
!     irk = its index
!
!     On exit:
!     vwfn%ev and vwfn%zv hold eigenvalues and wavefunctions (valence)
!     cwfn%ec and cwfn%zc hold eigenvalues and wavefunctions (conduction)
!
!     with proper phases and ordering for the k-point rk (given the
!     data on disk for irr. zone)
!
!     subroutine generates valence-band wavefunctions for rk(irk)
!     and conduction-band wavefunctions for rk(irk) from the
!     wavefunctions available for rk in the irreducible wedge of the
!     bz
!
!     i   rk                 rk(irk)
!     o c ngv,...,ev       valence-band wavefunctions for rk+q
!     and associated data
!     o c ngc,...,ec       conduction-band wavefunctions for rk
!     and associated data
!
!==========================================================================

#include "f_defs.h"

module genwf_disk_m

  use global_m
  use find_kpt_match_m
  use gmap_m
  use input_utils_m
  use misc_m
  use sort_m

  implicit none

  private

  public :: genwf_disk

contains  

subroutine genwf_disk(syms,gvec,crys,kp,kpq,irk,rk,qq,vwfn,pol,cwfn,use_wfnq,ivin)
  type (symmetry), intent(in) :: syms
  type (gspace), intent(in) :: gvec
  type (crystal), intent(in) :: crys
  type (kpoints), target, intent(in) :: kp
  type (kpoints), target, intent(in) :: kpq
  integer, intent(in) :: irk
  real(DP), intent(in) :: rk(3)
  real(DP), intent(in) :: qq(3)
  type (valence_wfns), intent(inout) :: vwfn
  type (polarizability), intent(in) :: pol
  type (conduction_wfns), intent(inout) :: cwfn
  logical, intent(in) :: use_wfnq
  integer, intent(in) :: ivin

  integer :: ng
  integer, allocatable :: isortc(:)
  real(DP), allocatable :: eig(:,:)
  SCALAR, allocatable :: zin(:,:),zinc(:,:)
  SCALAR, allocatable :: zintemp(:,:)
  type(kpoints), pointer :: kp_point

  character :: filename*20, filenamev*20, filenamevq*20
  character :: tmpstr*120
  integer :: itqq,i,j,k,ng2
  integer :: n,ig,ispin,iunit_c,iunit_v,iband
  integer :: naddc,jj,icount
  integer :: ikrkq,kgq(3),kgqq(3)
  integer, allocatable :: ind(:),isorti(:)
  real(DP), allocatable :: xnorm(:)
  real(DP) :: qk(3),rkq(3)
  real(DP), allocatable :: ekin(:)
  real(DP) :: rkmatch(3)

  SCALAR, allocatable :: ph(:)

  integer, save :: irk_old=0

  PUSH_SUB(genwf_disk)
  
  if(peinf%inode.eq.0) then
    write(filenamev,'(a)') 'INT_VWFN'
    write(filenamevq,'(a)') 'INT_VWFQ'
  endif

  SAFE_ALLOCATE(isortc, (gvec%ng))
  SAFE_ALLOCATE(eig, (cwfn%nband,kp%nspin))
  SAFE_ALLOCATE(xnorm, (kp%nspin))

  if(peinf%inode.eq.0) call timacc(16,1)

! rkq = rk + qq   (i.e. rkq = current kpoint in irr. zone + qq)

  rkq(1:3) = rk(1:3) + qq(1:3)

! Should we look for the valence WFNs in WFNq or WFN?
  if (use_wfnq) then
    kp_point => kpq
  else
    kp_point => kp
  endif

! We used to assume WFNq contained the needed q->0 point,
! but it is better to unfold the shifted grid for more flexibility.

  call find_kpt_match(kp_point, syms, rkq, ikrkq, itqq, kgqq)

  if(ikrkq == 0) then
    if(peinf%inode == 0) write(0,'(a,3f12.6,/,a,3f12.6)') 'rk = ', rk(:), 'qq = ', qq(:)
    write(tmpstr,'(a,3f8.3,a)') 'genwf_disk: No match for rkq point:',rkq,' in file'
    if(use_wfnq) then
      write(tmpstr,'(a,a)') TRUNC(tmpstr), ' WFNq'
    else
      write(tmpstr,'(a,a)') TRUNC(tmpstr), ' WFN'
    endif
    call die(tmpstr, only_root_writes = .true.)
  endif

  rkmatch(1:3) = kp_point%rk(1:3, ikrkq)
  vwfn%idx_kp = ikrkq

!
! SIB:  proc 0 will read from unit iunit_v and
! skip as many records as needed until it reads all the ikrkq`th valence
! wavefunctions. It then broadcasts the valence data (if MPI).
!

  if(peinf%inode.eq.0) then
    if (use_wfnq) then
      iunit_v=300028
      call open_file(iunit_v,file=filenamevq,form='unformatted',status='old')
    else
      iunit_v=200028
      call open_file(iunit_v,file=filenamev,form='unformatted',status='old')
    endif
    if(ikrkq.gt.1) then
      do i=1,ikrkq-1
        read(iunit_v)
        do j=1,(vwfn%nband+pol%ncrit)
          read(iunit_v)
        enddo
      enddo
    endif

! SIB: isortc(j) from disk tells us what the index of the j`th g-vector
! is in the array of g-vectors in gvec

    read(iunit_v) ng,(isortc(j),j=1,ng), &
      ((eig(j,k),j=1,(vwfn%nband+pol%ncrit)),k=1,kp%nspin),(qk(i),i=1,3)
  endif

#ifdef MPI
  call MPI_Bcast(ng, 1, MPI_INTEGER,0, MPI_COMM_WORLD,mpierr)
  call MPI_Bcast(isortc,ng,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  call MPI_Bcast(eig,cwfn%nband*kp%nspin,MPI_REAL_DP,0,MPI_COMM_WORLD,mpierr)
  call MPI_Bcast(qk, 3, MPI_REAL_DP, 0, MPI_COMM_WORLD, mpierr)
#endif

  SAFE_ALLOCATE(zintemp, (ng,kp%nspin*kp%nspinor))
  SAFE_ALLOCATE(zin, (ng,kp%nspin*kp%nspinor))
  
  do i=1,(vwfn%nband+pol%ncrit)
    zintemp=0D0
    if (peinf%inode .eq. 0) then
      read(iunit_v) ((zintemp(j,k),j=1,ng),k=1,kp%nspin*kp%nspinor)
    endif

#ifdef MPI
    call MPI_Bcast(zintemp, ng*kp%nspin, MPI_SCALAR, 0, MPI_COMM_WORLD, mpierr)
#endif

!        if (peinf%nvownmax(i) .eq. 1) then
    if (i .eq. ivin) then
!          zin(((peinf%nvindex(i)-1)*ng+1):((peinf%nvindex(i)) &
!          *ng),:)=zintemp(:,:)
      zin(:,:)=zintemp(:,:)
    endif
  enddo

  if(peinf%inode == 0) call close_file(iunit_v)

  SAFE_DEALLOCATE(zintemp)
  
  if (ivin .eq. -1) then 
    SAFE_DEALLOCATE(zin)
    SAFE_DEALLOCATE(xnorm)
    SAFE_DEALLOCATE(eig)
    SAFE_DEALLOCATE(isortc)
    irk_old=irk
    POP_SUB(genwf_disk)
    return
  endif

! Check kpoint

  if(any(abs(rkmatch(1:3) - qk(1:3)) .gt. TOL_Small)) call die('genwf_disk: rkmatch')

! Compute kinetic energies for rkq+g

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

! sort array ekin to ascending order, store indices in array vwfn%isort
! WARNING: one should not assume that in the case of
! q-->0 the orders as provided below and as read in from
! WFNq file is the same (sorting may change....)
! ===> need to call gmap also for q-->0 (see below)
! EKC: We initialize vwfn%isort to the appropriate array
! before reading in. this way we do not get zeroes in the array
! these are the valence wave-functions that do not need
! to be changed

  call sortrx(gvec%ng,ekin,vwfn%isort,gvec=gvec%components)

  SAFE_ALLOCATE(isorti, (gvec%ng))
  do i=1,gvec%ng
    isorti(vwfn%isort(i))=i
  enddo
  do i=1,ng
    isorti(isortc(i))=i
  enddo
  
  vwfn%ngv=ng

! SIB: put read eigenvalues into vwfn%ev(band,spin).
! Set xnorm(1:(vwfn%nband+pol%ncrit),1:nspin)=0

  if (irk .ne. irk_old) then
    SAFE_ALLOCATE(vwfn%ev, ((vwfn%nband+pol%ncrit),kp%nspin))
    vwfn%ev(1:(vwfn%nband+pol%ncrit),:) = eig(1:(vwfn%nband+pol%ncrit),:)
  endif
  SAFE_DEALLOCATE(eig)

! JRD: Map planewave components for rk+q, to those of rk
! (even for q--> 0)
!
! SIB: get phases (ph) and indices (ind) for g-vectors
! gvec%components(:,vwfn%isort(1:vwfn%ngv))+kgqq

  SAFE_ALLOCATE(ind, (vwfn%ngv))
  SAFE_ALLOCATE(ph, (vwfn%ngv))
  call gmap(gvec,syms,vwfn%ngv,itqq,kgqq,vwfn%isort,isorti,ind,ph,.true.)

  SAFE_ALLOCATE(vwfn%zv, (vwfn%ngv,kp%nspin*kp%nspinor))

! XAV: vwfn%zv(ig) corresponds really to the
! vwfn%isort(ig) G-vector (between 1 and ng)
! The subroutine gmap assumes that, as read from WFNq or WFN,
! zin(ig) corresponds really to isortc(ig) G-vector !!!
!
! SIB:  checks that zin vectors have norm greater than 1e-6, and then
! normalizes them to have unit square modulus.
!
! BAB:  we check if the norm differs appreciably from unity.
! there is no longer a need to further normalize the vector

  do ispin=1,kp%nspin*kp%nspinor
    vwfn%zv(:,ispin)=zin(ind(:),ispin)*ph(:)
  enddo

! In spinor case, we must rotate spinors according to spinor rotation matrix umtrx


  do ispin=1,kp%nspin
    call compute_norm(xnorm(ispin),ispin,vwfn%ngv,kp%nspinor,vwfn%zv(:,:))
    if(abs(xnorm(ispin) - 1d0) > TOL_Small) then
      write(0,*) 'Bad norm: sym op=',itqq,'ik=',ikrkq,'ispin=',ispin,'norm=',xnorm(ispin)
      call die('genwf_disk: Bad norm')
    endif
  enddo

! End calculation of valence-band wavefunctions

  SAFE_DEALLOCATE(zin)
  SAFE_DEALLOCATE(ind)
  SAFE_DEALLOCATE(ph)
  SAFE_DEALLOCATE(xnorm)
  if(peinf%inode.eq.0) call timacc(16,2)

  if(irk .ne. irk_old) then

!------------------------------------------------------------------------
! Generate conduction-band wavefunctions for rk
! find rk, r, g0 such that rk=r(rk)+g0

! SIB: This seems redundant, but find a k-point and symmetry so that
! rk = sym%mtrx(:,:,itqq)*kp%rk(irk_,:) + kgq, where kgq is integer 3-vec

    if(peinf%inode.eq.0) call timacc(17,1)

    call find_kpt_match(kp, syms, rk, ikrkq, itqq, kgq)
    cwfn%idx_kp = ikrkq

    if(ikrkq == 0) call die('genwf_disk: kgq mismatch')

! Write out rk, it and kgq

#ifdef VERBOSE
    if(peinf%inode.eq.0) then
      write(6,7000) (rk(i),i=1,3),ikrkq,(kp%rk(i,ikrkq),i=1,3),itqq,(kgq(i),i=1,3)
7000  format(1x,'rk=',3f7.3,1x,'irk_=',i5,1x,' rk=',3f7.3,1x,'it=',i5,1x,'kg0=',3i3)
    endif
#endif

! SIB: if we already found this k-point last time, get its qk, ng,
! and isortc(:).  Otherwise, open from unit iunit_c=128+peinf%inode,
! skip ikrkq-1 records, and read in information (qk,cwfn%ec,ng,isortc),
! JRD: Now need open
  
    if(peinf%inode.lt.10000) then
      write(filename,'(a,i4.4)') 'INT_CWFN_', peinf%inode
    else
      call die('too many nodes required')
    endif
  
    iunit_c=100028+peinf%inode
    call open_file(iunit_c,file=filename,form='unformatted',status='old')
    
    if(ikrkq.gt.1) then
      icount=0
      do i=1,ikrkq-1
        icount=icount+peinf%ncownactual+1
      enddo
      do i=1,icount
        read(iunit_c)
      enddo
    endif
    
    SAFE_ALLOCATE(cwfn%ec, (cwfn%nband,kp%nspin))
    read(iunit_c) (qk(i),i=1,3),((cwfn%ec(j,k),j=1,cwfn%nband),k=1,kp%nspin),ng,(isortc(j),j=1,ng)
  
! Check kpoint (again ...  boring...)
! Check that kp%rk(:,ikrkq) = qk  (why it wouldn`t is a mystery!)

    if(any(abs(kp%rk(1:3, ikrkq) - qk(1:3)) .gt. TOL_Small)) &
      call die('genwf_disk: qk mismatch')

    cwfn%ngc=ng

! Compute inverse to isort
! NOTE: isortc orders   |kp%rk+G|^2
! It is not necessarily the same order than |rk+G|^2
! (particularly if umklapp, ie kgq non zero)

    if(peinf%inode.eq.0) call timacc(28,1)

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

    if(peinf%inode.eq.0) call timacc(28,2)

! Sort array ekin to ascending order
! store indices in array isort

    if(peinf%inode.eq.0) call timacc(29,1)

    call sortrx(gvec%ng,ekin,cwfn%isort,gvec=gvec%components)

    if(peinf%inode.eq.0) call timacc(29,2)

    do i=1,gvec%ng
      isorti(cwfn%isort(i))=i !to initialize
    enddo
    do i=1,ng
      isorti(isortc(i))=i
    enddo
    SAFE_DEALLOCATE(isortc)
    SAFE_DEALLOCATE(ekin)

! map planewave components for rk to those of rk
! compute phases
! We do not the isorti related to kp%rk BUT the cwfn%isort related to rk

    SAFE_ALLOCATE(ind, (cwfn%ngc))
    SAFE_ALLOCATE(ph, (cwfn%ngc))
    call gmap(gvec,syms,cwfn%ngc,itqq,kgq,cwfn%isort,isorti,ind,ph,.true.)
    SAFE_DEALLOCATE(isorti)

! generate conduction-band wavefunctions
! loop over wavefunctions
! read conduction-band from file one by one

    SAFE_ALLOCATE(cwfn%zc, (peinf%ncownactual*cwfn%ngc,kp%nspin*kp%nspinor))
    SAFE_ALLOCATE(zinc, (cwfn%ngc,kp%nspin*kp%nspinor))

    do n=1,peinf%ncownactual
      
      read(iunit_c) iband,ng2,((zinc(jj,k),jj=1,ng2),k=1,kp%nspin*kp%nspinor)
      
      if(ng2 .ne. cwfn%ngc) call die('genwf_disk: ngc mismatch')
      if(iband .ne. peinf%invindexc(n)) call die('genwf_disk: invindexc mismatch')

      naddc=(n-1)*cwfn%ngc

!
! Loop over components of wfns
! note that only conduction-band wfns are stored-
! they start in the 1st position with the state nvband+1
!
      do ig=1,cwfn%ngc
        cwfn%zc(naddc+ig,:)=ph(ig)*zinc(ind(ig),:)
      enddo

! In spinor case, we must rotate spinors according to spinor rotation matrix umtrx


    enddo  ! n (cond-bands per node [ncownactual] loop)

    call close_file(iunit_c)

    SAFE_DEALLOCATE(zinc)
    SAFE_DEALLOCATE(ind)
    SAFE_DEALLOCATE(ph)

!     end generation of conduction-band wavefunctions for rk

    if(peinf%inode.eq.0) call timacc(17,2)

  endif ! (irk .ne. irk_old)

  irk_old = irk

  POP_SUB(genwf_disk)

  return
end subroutine genwf_disk

end module genwf_disk_m
