!===============================================================================
!
! Routines:
!
! (1) input()   Originally By ?         Last Modified 10/5/2009 (gsm)
!
! Sets up various data structures. Reads in and distributes wavefunctions.
! Stores wavefunctions on disk in temporary INT_CWFN_* and INT_WFNK_* files
! (comm_disk) or in structures distributed in memory (comm_mpi).
!
!===============================================================================

#include "f_defs.h"

subroutine input(crys,gvec,syms,kp,wpg,sig,wfnk,iunit_c,iunit_k,fnc,fnk,wfnkqmpi,wfnkmpi)

  use global_m
  use checkbz_m
  use createpools_m
  use eqpcor_m
  use fftw_m
  use fullbz_m
  use input_utils_m
  use misc_m
  use read_rho_vxc_m
  use scissors_m
  use sort_m
  use wfn_rho_vxc_io_m
  use io_utils_m
  use epsread_hdf5_m
#ifdef HDF5
  use hdf5
#endif
  implicit none

  type (crystal), intent(out) :: crys
  type (gspace), intent(out) :: gvec
  type (symmetry), intent(out) :: syms
  type (kpoints), intent(out) :: kp
  type (wpgen), intent(out) :: wpg
  type (siginfo), intent(out) :: sig
  type (wfnkstates), intent(out) :: wfnk
  integer, intent(in) :: iunit_c, iunit_k
  character*20, intent(in) :: fnc, fnk
  type (wfnkqmpiinfo), intent(out) :: wfnkqmpi
  type (wfnkmpiinfo), intent(out) :: wfnkmpi

  character :: fncor*32, tmpfn*16
  character :: tmpstr*100,tmpstr1*16,tmpstr2*16
  character :: filenameh5*80
  integer :: i,ierr,ii,j,jj,k,kk
  integer :: ikn,irk
  integer :: istore,nstore,inum,g1,g2,iknstore
  integer :: nq,ndvmax,ndvmax_l
  integer :: ncoul,ncoulb,ncouls,nmtx,nmtx_l,nmtx_col
  integer, allocatable :: isort(:),isrt(:),isrti(:)
  integer :: ipe
  integer :: Nrod,Nplane,Nfft(3),dNfft(3),dkmax(3),nmpinode
  integer :: ntband,npools,ndiag_max,noffdiag_max,ntband_max
  real(DP) :: scalarsize,qk(3),vcell,qtot,omega_plasma,rhog0
  real(DP) :: mem,fmem,rmem,rmem2,scale,dscale
  SCALAR, allocatable :: zc(:,:)
  integer, allocatable :: gvecktmp(:,:)
  logical :: do_ch_sum, dont_read, skip_checkbz
  type(grid) :: gr

  character(len=3) :: sheader
  integer :: iflavor, error
  type(gspace) :: gvec_kpt

  integer :: ngarbage1, ngarbage2, ngarbage4, ngarbage3(3)
  real(DP) :: dgarbage1

  logical :: file_exists
  type(progress_info) :: prog_info !< a user-friendly progress report

  PUSH_SUB(input)

!---------------
! Read sigma.inp

  call inread(sig)

!------------------------
! Initialize HDF5

#ifdef HDF5

  if(sig%use_hdf5) call h5open_f(error)

#endif

  if(sig%nkn .lt. 1) then
    if(peinf%inode.eq.0) write(0,*) 'sig%nkn < 1'
    call die('sig%nkn')
  endif
  
!---------------------------------
! Determine the available memory

  call procmem(mem,nmpinode)

  if(peinf%inode.eq.0) then
    write(6,998) mem/1024.0d0**2
    write(7,998) mem/1024.0d0**2
  endif
998 format(1x,'Memory available:',f10.1,1x,'MB per PE')
  
  fmem=mem/8.0d0

!-------------------------------
! (gsm) Estimate the required memory

  if(peinf%inode.eq.0) then

! determine number of frequencies and number of q-points
    if (sig%freq_dep.eq.-1) then
      nq=sig%nq
      sig%nFreq=1
    endif

    if (sig%freq_dep.eq.0.or.sig%freq_dep.eq.1.or.sig%freq_dep.eq.2.or.sig%freq_dep.eq.3) then

#ifdef HDF5
      if(sig%use_hdf5) then
        filenameh5 = 'eps0mat.h5'
        call read_eps_grid_sizes_hdf5(ngarbage1,ngarbage2,dgarbage1,sig%nFreq,ngarbage4,ngarbage3,filenameh5)  

        ! FIXME: if these values are garbage why tell the user?
        ! or, if they are not garbage, give them a proper name!
        write(6,*) 'Read from eps0mat.h5',ngarbage1,ngarbage2,dgarbage1,sig%nFreq,ngarbage4,ngarbage3

        INQUIRE(FILE="epsmat.h5", EXIST=file_exists)
        if ( file_exists ) then
          filenameh5 = 'epsmat.h5 '
          call read_eps_grid_sizes_hdf5(ngarbage1,nq,dgarbage1,ngarbage2,ngarbage4,ngarbage3,filenameh5)  
          nq = nq + 1
        else
          nq = 1
        endif
      else
#endif

        call open_file(10,file='eps0mat',form='unformatted',status='old')
        read(10)
        read(10)i,sig%nFreq
        call close_file(10)
        call open_file(11,file='epsmat',form='unformatted',status='old',iostat=ierr)
        if (ierr.eq.0) then
          read(11)
          read(11)
          read(11)
          read(11)
          read(11)
          read(11)
          read(11)
          read(11) nq
          nq=nq+1
          call close_file(11)
        else
          nq=1
        endif

#ifdef HDF5
    endif
#endif

    endif

  endif

! read wavefunction parameters
  if(peinf%inode == 0) call open_file(25,file='WFN_inner',form='unformatted',status='old')

  sheader = 'WFN'
  iflavor = 0
  call read_binary_header_type(25, sheader, iflavor, kp, gvec, syms, crys)
  call check_trunc_kpts(sig%icutv, kp)

  if(sig%ntband > kp%mnband) then
    call die("number_bands is larger than are available in WFN_inner", only_root_writes = .true.)
  endif

  kp%el(:,:,:) = kp%el(:,:,:) - sig%avgpot / ryd

  if(peinf%inode == 0) call logit('Reading WFN_inner -- gvec info')
  SAFE_ALLOCATE(gvec%components, (3, gvec%ng))
  call read_binary_gvectors(25, gvec%ng, gvec%ng, gvec%components)

!-----------------------
! sort G-vectors with respect to their kinetic energy
  SAFE_ALLOCATE(isrt, (gvec%ng))
  SAFE_ALLOCATE(isrti, (gvec%ng))
  SAFE_ALLOCATE(gvec%ekin, (gvec%ng))
  call kinetic_energies(gvec, crys%bdot, gvec%ekin)
  call sortrx(gvec%ng, gvec%ekin, isrt, gvec = gvec%components)
  ! FIXME: the same exact thing is done in sigma_main a second time!
  ncouls = gcutoff(gvec%ng, gvec%ekin, isrt, sig%ecuts)
  ncoulb = gcutoff(gvec%ng, gvec%ekin, isrt, sig%ecutb)
  SAFE_DEALLOCATE_P(gvec%ekin)
    
  SAFE_ALLOCATE(gvecktmp, (3,gvec%ng))
  gvecktmp(:,:)=gvec%components(:,:)
  do i=1,gvec%ng
    gvec%components(:,i)=gvecktmp(:,isrt(i))
    isrti(isrt(i)) = i
  enddo
  SAFE_DEALLOCATE(gvecktmp)
    
  SAFE_ALLOCATE(isort, (gvec%ng))

  call gvec_index(gvec)
    
! estimate for nmtx

  if(peinf%inode == 0) then
    ncoul=max(ncouls,ncoulb)
    nmtx=ncouls

! divide bands over processors (this is repeated below)
    ntband=min(sig%ntband,kp%mnband)
    if (peinf%npools .le. 0 .or. peinf%npools .gt. peinf%npes) then
      call createpools(sig%ndiag,ntband,peinf%npes,npools,ndiag_max,ntband_max)
    else
      npools = peinf%npools
      if (mod(sig%ndiag,npools).eq.0) then
        ndiag_max=sig%ndiag/npools
      else
        ndiag_max=sig%ndiag/npools+1
      endif
      if (mod(ntband,peinf%npes/npools).eq.0) then
        ntband_max=ntband/(peinf%npes/npools)
      else
        ntband_max=ntband/(peinf%npes/npools)+1
      endif
    endif
    if (sig%noffdiag.gt.0) then
      if (mod(sig%noffdiag,npools).eq.0) then
        noffdiag_max=sig%noffdiag/npools
      else
        noffdiag_max=sig%noffdiag/npools+1
      endif
    endif

    nmtx_l=int(sqrt(dble(nmtx)**2/dble(peinf%npes/npools)))
    nmtx_col=int(dble(nmtx)/dble(peinf%npes/npools))+1

    scalarsize = sizeof_scalar()

! required memory
    rmem=0.0d0
! arrays eps and epstemp in program main
    if (sig%freq_dep.eq.0.or.sig%freq_dep.eq.1) then
      rmem=rmem+(dble(nmtx_l)**2+dble(nmtx))*scalarsize
      rmem=rmem+(dble(nmtx_col)*nmtx)*scalarsize
    endif
! wtilde_array, imagloop_ig, imaginary_flag in mtxel_sxch
    if (sig%freq_dep.eq.1) then
      rmem=rmem+(dble(nmtx_col)*nmtx)*16
      rmem=rmem+(dble(nmtx_col)*nmtx)*4
      rmem=rmem+(dble(nmtx_col)*nmtx)*1
    endif
! arrays epsR, epsRtemp, epsA, and epsAtemp in program main
    if (sig%freq_dep.eq.2 .or.sig%freq_dep.eq.3) then
      rmem=rmem+(dble(nmtx_l)**2+dble(nmtx)) &
        *dble(sig%nFreq)*2.0d0*scalarsize
    endif
    if (sig%iwriteint .eq. 1) then
! array epsmpi%eps in subroutine epscopy
      if (sig%freq_dep.eq.0.or.sig%freq_dep.eq.1) then
        rmem=rmem+(dble(nmtx_col)*nmtx)*dble(nq)*scalarsize
      endif
! arrays epsmpi%epsR and epsmpi%epsA in subroutine epscopy
      if (sig%freq_dep.eq.2 .or.sig%freq_dep.eq.3) then
        rmem=rmem+(nmtx_col*nmtx)*dble(nq) &
          *dble(sig%nFreq)*2.0d0*scalarsize
      endif
    endif
! array aqs in program main
    rmem=rmem+dble(ntband_max)*dble(ncoul)*scalarsize
! array aqsaug in program main
    if (sig%noffdiag.gt.0) then
      rmem=rmem+dble(ntband_max)*dble(ncoul) &
        *dble(sig%ndiag)*dble(sig%nspin)*scalarsize
    endif
! array aqsch in program main
    if (sig%exact_ch.eq.1) then
      rmem=rmem+dble(ncoul)*scalarsize
    endif
! arrays aqsaugchd and aqsaugcho in program main
    if (sig%exact_ch.eq.1.and.nq.gt.1) then
      rmem=rmem+dble(ncoul)*dble(ndiag_max) &
        *dble(sig%nspin)*scalarsize
      if (sig%noffdiag.gt.0) then
        rmem=rmem+dble(ncoul)*dble(noffdiag_max)* &
          dble(sig%nspin)*scalarsize
      endif
    endif
! array wfnk%zk in subroutine input
    rmem=rmem+dble(ndiag_max)*dble(kp%ngkmax)* &
      dble(sig%nspin*kp%nspinor)*scalarsize
! array wfnkq%zkq in subroutine genwf
    rmem=rmem+dble(ntband_max)*dble(kp%ngkmax) &
      *dble(sig%nspin*kp%nspinor)*scalarsize
! arrays zc in subroutine input and zin in subroutine genwf
    rmem=rmem+dble(kp%ngkmax)*dble(kp%nspin*kp%nspinor)*scalarsize
! array wfnkoff%zk in program main and subroutines mtxel_vxc and mtxel_sxch
    if ((sig%exact_ch.eq.1.and.sig%noffdiag.gt.0).or. &
      (.not.sig%use_vxcdat)) then
      rmem=rmem+2.0d0*dble(kp%ngkmax)*scalarsize
    endif
! array gvec%index_vec in input
    rmem=rmem+dble(gvec%nFFTgridpts)*4.0d0
! arrays fftbox1 and fftbox2 in subroutines mtxel and mtxel_ch
    call setup_FFT_sizes(gvec%FFTgrid,Nfft,scale)
    rmem=rmem+dble(Nfft(1)*Nfft(2)*Nfft(3))*32.0d0
    if (sig%iwriteint .eq. 1) then
! arrays wfnkqmpi%isort and wfnkqmpi%cg in subroutine input
      rmem=rmem+dble(kp%ngkmax)*dble(kp%nrk)*4.0d0+ &
        dble(kp%ngkmax)*dble(ntband_max)*dble(sig%nspin*kp%nspinor)* &
        dble(kp%nrk)*dble(scalarsize)
! arrays wfnkmpi%isort and wfnkmpi%cg in subroutine input
      rmem=rmem+dble(kp%ngkmax)*dble(sig%nkn)*4.0d0+ &
        dble((ndiag_max*kp%ngkmax)/(peinf%npes/npools))* &
        dble(sig%nspin*kp%nspinor)*dble(sig%nkn)* &
        dble(scalarsize)
    endif

989 format(1x,'Memory required for execution:',f7.1,1x,'MB per PE')
    write(6,989) rmem/1024.0d0**2
    write(7,989) rmem/1024.0d0**2

! random numbers
    rmem=0.0D0
    if (sig%icutv.ne.5) then
! arrays ran, qran, and qran2
! (ran is deallocated before qran2 is allocated)
      rmem=rmem+6.0D0*dble(nmc)*8.0D0
    endif
! various truncation schemes
    rmem2=0.0d0
! cell wire truncation
    if (sig%icutv.eq.4) then
      dkmax(1) = gvec%FFTgrid(1) * n_in_wire
      dkmax(2) = gvec%FFTgrid(2) * n_in_wire
      dkmax(3) = 1
      call setup_FFT_sizes(dkmax,dNfft,dscale)
! array fftbox_2D
      rmem2=rmem2+dble(dNfft(1))*dble(dNfft(2))*16.0d0
! array inv_indx
      rmem2=rmem2+dble(Nfft(1))*dble(Nfft(2))*dble(Nfft(3))* &
        4.0d0
! array qran
      rmem2=rmem2+3.0D0*dble(nmc)*8.0D0
    endif
! cell box truncation (parallel version only)
    if (sig%icutv.eq.5) then
      dkmax(1) = gvec%FFTgrid(1) * n_in_box
      dkmax(2) = gvec%FFTgrid(2) * n_in_box
      dkmax(3) = gvec%FFTgrid(3) * n_in_box
      call setup_FFT_sizes(dkmax,dNfft,dscale)
      if (mod(dNfft(3),peinf%npes) == 0) then
        Nplane = dNfft(3)/peinf%npes
      else
        Nplane = dNfft(3)/peinf%npes+1
      endif
      if (mod(dNfft(1)*dNfft(2),peinf%npes) == 0) then
        Nrod = (dNfft(1)*dNfft(2))/peinf%npes
      else
        Nrod = (dNfft(1)*dNfft(2))/peinf%npes+1
      endif
! array fftbox_2D
      rmem2=rmem2+dble(dNfft(1))*dble(dNfft(2))*dble(Nplane)* &
        16.0d0
! array fftbox_1D
      rmem2=rmem2+dble(dNfft(3))*dble(Nrod)*16.0d0
! array dummy
!          rmem2=rmem2+dble(dNfft(1))*dble(dNfft(2))*16.0d0
! arrays dummy1 and dummy2
      rmem2=rmem2+dble(Nrod)*dble(peinf%npes+1)*16.0d0
! array inv_indx
      rmem2=rmem2+dble(Nfft(1))*dble(Nfft(2))*dble(Nfft(3))* &
        4.0d0
    endif
    if (rmem2 .gt. rmem) rmem = rmem2
988 format(1x,'Memory required for vcoul:',f7.1,1x,'MB per PE')
    write(6,988) rmem/1024.0d0**2
    write(7,988) rmem/1024.0d0**2
    write(6,*)
    write(7,*)
  endif

  if(peinf%inode == 0) then
    write(7,'(1x,"Cell Volume =",e16.9,/)') crys%celvol

!----------------------------------------------
! Compute cell volume from wave number metric

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

! (gsm) check consistency of spin indices

    do k=1,sig%nspin
      if (sig%spin_index(k).lt.1.or.sig%spin_index(k).gt.kp%nspin) &
        call die('inconsistent spin indices')
    enddo

    if(sig%ntband.gt.kp%mnband) then
      write(tmpstr1,660) sig%ntband
      write(tmpstr2,660) kp%mnband
      write(0,666) TRUNC(tmpstr1), TRUNC(tmpstr2)
      call die('More bands specified in sigma.inp than available in WFN_inner.')
660   format(i16)
666   format(1x,'The total number of bands (',a,') specified in sigma.inp',/, &
        3x,'is larger than the number of bands (',a,') available in WFN_inner.',/)
    endif
    do_ch_sum = .not.((sig%freq_dep == -1) .or. (sig%freq_dep == 0 .and. sig%exact_ch == 1))
    if(sig%ntband.eq.kp%mnband) then
      call die("You must provide one more band in WFN_inner than used in sigma.inp number_bands in order to assess degeneracy.")
    endif

!--------------------------------------------------------------------
! SIB:  Find the k-points in sig%kpt in the list kp%rk (die if not found).
! sig%indkn holds the index of the k-points in sig%kpt in kp%rk, i.e.
! kp%rk(sig%indkn(ikn))=sig%kpt(ikn)

    SAFE_ALLOCATE(sig%indkn, (sig%nkn))
    do ikn=1,sig%nkn
      sig%indkn(ikn)=0
      qk(:)=sig%kpt(:,ikn)
      do irk=1,kp%nrk
        if(all(abs(kp%rk(1:3,irk)-qk(1:3)) .lt. TOL_Small)) sig%indkn(ikn)=irk
      enddo
      if(sig%indkn(ikn) .eq. 0) then
        write(0,'(a,3f10.5,a)') 'Could not find the k-point ', (qk(i),i=1,3), ' among those read from WFN_inner :'
        write(0,'(3f10.5)') ((kp%rk(i,irk),i=1,3),irk=1,kp%nrk)
        call die('k-point in sigma.inp k_points block not available.')
      endif
    enddo

    if(do_ch_sum) then
      if(any(abs(kp%el(sig%ntband, 1:kp%nrk, 1:kp%nspin) - kp%el(sig%ntband + 1, 1:kp%nrk, 1:kp%nspin)) .lt. sig%tol/RYD)) then
        if(sig%degeneracy_check_override) then
          write(0,'(a)') &
            "WARNING: Selected number of bands for CH sum (number_bands) breaks degenerate subspace. " // &
            "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 bands for CH sum (number_bands) breaks degenerate subspace.")
        endif
      endif
    endif
  endif

!----------------------------------------------------------------
! Check consistency

  if (kp%mnband < maxval(sig%diag) .and. peinf%inode == 0) then
    write(0,*) 'The highest requested band is ', maxval(sig%diag),' but WFN_inner contains only ', kp%mnband,' bands.'
    call die('too few bands')
  endif
  
  SAFE_ALLOCATE(kp%elda, (sig%ntband,kp%nrk,kp%nspin))
  kp%elda(1:sig%ntband, 1:kp%nrk, 1:kp%nspin)=ryd*kp%el(1:sig%ntband, 1:kp%nrk, 1:kp%nspin)
  call scissors_shift(kp, sig%scis, sig%spl_tck)

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

  if(sig%eqp_corrections) then
    fncor='eqp.dat'
    call eqpcor(fncor,peinf%inode,peinf%npes,kp,1,sig%ntband,0,0,kp%el,kp%el,kp%el,1,0)
    ! note: want in Ry since conversion occurs below
  endif

  ! qgridsym has no meaning when there is only one q-point (Gamma)
  ! setting this to false means warnings about its applicability will not be triggered
  if(all(abs(kp%rk(1:3,1:kp%nrk)) < TOL_Zero)) sig%qgridsym = .false.

  if(peinf%inode == 0) then
    call find_efermi(sig%rfermi, sig%efermi, sig%efermi_input, kp, sig%ntband, 1, &
      "unshifted grid", should_search = .true., should_update = .true., write7 = .true.)

    ! kp%el is still in Ry here, but sig%tol is in eV.
    call assess_degeneracies(kp, kp%el(sig%ntband + 1, :, :), sig%ntband, sig%efermi, sig%tol/RYD, sig = sig)

    call calc_qtot(kp, crys%celvol, sig%efermi, qtot, omega_plasma, write7 = .true.)
  endif

  if (peinf%inode.eq.0) call timacc(4,1)
  gr%nr = kp%nrk
  SAFE_ALLOCATE(gr%r, (3, gr%nr))
  gr%r = kp%rk
  call fullbz(crys,syms,gr,syms%ntran,skip_checkbz,wigner_seitz=.false.,paranoid=.true.)
  tmpfn='WFN_inner'
  if (.not. skip_checkbz) then
    call checkbz(gr%nf,gr%f,kp%kgrid,kp%shift,crys%bdot, &
      tmpfn,'k',.false.,sig%freplacebz,sig%fwritebz)
  endif
  call dealloc_grid(gr)
  if (peinf%inode.eq.0) call timacc(4,2)

  ! For discussion of how q-symmetry may (and may not) be used with degenerate states,
  ! see Hybertsen and Louie, Phys. Rev. B 35, 5585 (1987) Appendix A 
  if(sig%qgridsym .and. sig%noffdiag > 0) then
    if(peinf%inode == 0) then
      write(0,'(a)') "WARNING: Cannot calculate offdiagonal elements unless no_symmetries_q_grid is set."
      write(0,'(a)') "This flag is being reset to enable the calculation."
    endif
    sig%qgridsym = .false.
  endif

  if(peinf%inode == 0) then
    if(sig%qgridsym) then
      write(6,'(a)') ' q-grid symmetries are being used'
      write(7,'(a)') ' q-grid symmetries are being used'
    else
      write(6,'(a)') ' q-grid symmetries are not being used'
      write(7,'(a)') ' q-grid symmetries are not being used'
    endif
  endif

  kp%el(:,:,:)=kp%el(:,:,:)*ryd

 !----------------------------------------------------------------
 ! Distribute data

 #ifdef MPI
  call MPI_Bcast(sig%efermi, 1, MPI_REAL_DP,0, MPI_COMM_WORLD,mpierr)
  if(sig%qgridsym .or. sig%noffdiag > 0 .or. sig%ncrit > 0) then
    if(peinf%inode.ne.0) then
      SAFE_ALLOCATE(kp%degeneracy, (sig%ntband, kp%nrk, kp%nspin))
    endif
    call MPI_Bcast(kp%degeneracy(1,1,1), sig%ntband * kp%nrk * kp%nspin, MPI_INTEGER, 0, MPI_COMM_WORLD, mpierr)
  endif
   if(peinf%inode.ne.0) then
     SAFE_ALLOCATE(sig%indkn, (sig%nkn))
   endif
   call MPI_Bcast(sig%indkn, sig%nkn, MPI_INTEGER, 0, MPI_COMM_WORLD, mpierr)
#endif

!----------------------------------------------------------------
! CHP: Set the init_freq_eval relative to the Fermi energy in case
!      of full frequency. This part should NOT be put before the
!      Fermi energy is set.

  if (sig%freq_dep .eq. 2) then
    sig%freqevalmin = sig%freqevalmin + sig%efermi
  endif

!--------------------------------------------------------------------
! Read in the exchange-correlation potential and store in array vxc

  if(.not. sig%use_vxcdat) then

    call read_vxc(sig, gvec, kp, syms, crys, isrti, isrt, .false.)

  endif ! not using vxc.dat

  if(.not. sig%use_vxc2dat) then
    ! This is for hybrid functional like calculation (one shot)
    if (sig%freq_dep.eq.-1 .and. ((1.0d0 - sig%coulomb_mod%long_range_frac_fock > TOL_SMALL) .or. &
                  (1.0d0 - sig%coulomb_mod%short_range_frac_fock > TOL_SMALL)))  &
      call read_vxc(sig, gvec, kp, syms, crys, isrti, isrt, .true.)

  endif ! not using vxc2.dat

!--------------------------------------------------------------------
! Read in the charge density and store in array rho (formerly known as CD95)
! CD95 Ref: http://www.nature.com/nature/journal/v471/n7337/full/nature09897.html

  if(sig%freq_dep.eq.1) then
    call timacc(21,1)

    call read_rho(wpg, gvec, kp, syms, crys, isrti, isrt, 'WFN_inner')

    rhog0 = sum(wpg%nelec(1:kp%nspin))
    if(peinf%inode == 0 .and. abs(rhog0 - qtot) > TOL_Small) then
      write(0,'(a,g12.6,a,g12.6)') 'WARNING: RHO has total charge ', rhog0, ' but WFN_inner occupations give charge ', qtot
    endif

    call timacc(21,2)
  endif ! sig%freq_dep

!------------------------------------------------------------------------
! Divide bands over processors
!
! sig%ntband           number of total (valence and conduction) bands
! peinf%npools         number of parallel sigma calculations
! peinf%ndiag_max      maximum number of diag sigma calculations
! peinf%noffdiag_max   maximum number of offdiag sigma calculations
! peinf%ntband_max     maximum number of total bands per node
!
! ntband_node          number of total bands per current node
! nvband_node          number of valence bands per current node
! peinf%indext(itb)    indices of total bands belonging to current node
!
! peinf%index_diag     band index for diag sigma calculation
! peinf%flag_diag      flag for storing diag sigma calculation
! peinf%index_offdiag  band index for offdiag sigma calculation
! peinf%flag_offdiag   flag for storing offdiag sigma calculation
!
! flags are needed in case of uneven distribution, nodes still do the
! calculation because they share epsilon and wavefunctions and need to
! participate in global communications, but the result is not stored

  if (peinf%npools .le. 0 .or. peinf%npools .gt. peinf%npes) then
    call createpools(sig%ndiag,sig%ntband,peinf%npes,npools,ndiag_max,ntband_max)
    peinf%npools = npools
    peinf%ndiag_max = ndiag_max
    peinf%ntband_max = ntband_max
  else
    if (mod(sig%ndiag,peinf%npools).eq.0) then
      peinf%ndiag_max=sig%ndiag/peinf%npools
    else
      peinf%ndiag_max=sig%ndiag/peinf%npools+1
    endif
    
    if (mod(sig%ntband,peinf%npes/peinf%npools).eq.0) then
      peinf%ntband_max=sig%ntband/(peinf%npes/peinf%npools)
    else
      peinf%ntband_max=sig%ntband/(peinf%npes/peinf%npools)+1
    endif
  endif

! JRD Create Separate Comms for Each Pool

  peinf%npes_pool = peinf%npes/peinf%npools
  peinf%my_pool=peinf%inode/peinf%npes_pool
  peinf%pool_rank = mod(peinf%inode,peinf%npes_pool)

#ifdef MPI
!  call MPI_Comm_Group(MPI_COMM_WORLD,orig_group,mpierr)
!
!  SAFE_ALLOCATE(ranks,(peinf%npes))
!  do ii=1,peinf%npes
!    ranks(ii)=ii-1
!  enddo
!
!  if (peinf%my_pool .ne. -1) then
!    call MPI_Group_incl(orig_group, peinf%npes_pool, &
!      ranks(peinf%my_pool*peinf%npes_pool+1:(peinf%my_pool+1)*peinf%npes_pool), peinf%pool_group,mpierr)
!  else
!! We need a group to send comm_create below. If you are not in a legit pool, we just use the first group
!    call MPI_Group_incl(orig_group, peinf%npes_pool, &
!      ranks(0*peinf%npes_pool+1:(0+1)*peinf%npes_pool), peinf%pool_group,mpierr)
!  endif
!
!! All procs in original comm need to do this
!
!  call MPI_Comm_create(MPI_COMM_WORLD,peinf%pool_group,peinf%pool_comm,mpierr)

  call MPI_Comm_split(MPI_COMM_WORLD, peinf%my_pool, peinf%pool_rank, peinf%pool_comm, mpierr)

  if (peinf%my_pool .gt. (peinf%npools-1)) then
    peinf%my_pool = -1
  endif

!  !write(6,*) peinf%inode,"Created groups comms"

!  SAFE_DEALLOCATE(ranks)
#endif

  if (sig%noffdiag.gt.0) then
    if (mod(sig%noffdiag,peinf%npools).eq.0) then
      peinf%noffdiag_max=sig%noffdiag/peinf%npools
    else
      peinf%noffdiag_max=sig%noffdiag/peinf%npools+1
    endif
  endif

  SAFE_ALLOCATE(peinf%index_diag, (peinf%ndiag_max))
  SAFE_ALLOCATE(peinf%flag_diag, (peinf%ndiag_max))
  peinf%index_diag=1
  peinf%flag_diag=.false.
  do ii=1,peinf%ndiag_max*peinf%npools
    jj=(ii-1)/peinf%npools+1 ! which number in the pool it is
    kk=mod(ii-1,peinf%npools) ! which pool it is in
    if (peinf%inode/(peinf%npes/peinf%npools).eq.kk) then
      if (ii.le.sig%ndiag) then
        peinf%index_diag(jj)=ii
        peinf%flag_diag(jj)=.true.
      else
        peinf%index_diag(jj)=1
        peinf%flag_diag(jj)=.false.
      endif
    endif
  enddo

  if (sig%noffdiag.gt.0) then
    SAFE_ALLOCATE(peinf%index_offdiag, (peinf%noffdiag_max))
    SAFE_ALLOCATE(peinf%flag_offdiag, (peinf%noffdiag_max))
    peinf%index_offdiag=1
    peinf%flag_offdiag=.false.
    do ii=1,peinf%noffdiag_max*peinf%npools
      jj=(ii-1)/peinf%npools+1
      kk=mod(ii-1,peinf%npools)
      if (peinf%inode/(peinf%npes/peinf%npools).eq.kk) then
        if (ii.le.sig%noffdiag) then
          peinf%index_offdiag(jj)=ii
          peinf%flag_offdiag(jj)=.true.
        else
          peinf%index_offdiag(jj)=1
          peinf%flag_offdiag(jj)=.false.
        endif
      endif
    enddo
  endif
  
  SAFE_ALLOCATE(peinf%indext, (peinf%ntband_max))

!JRD Now is over procs per pool

  SAFE_ALLOCATE(peinf%indext_dist, (peinf%ntband_max,peinf%npes_pool))
  SAFE_ALLOCATE(peinf%ntband_dist, (peinf%npes_pool))
  
  peinf%ntband_node=0
  peinf%ntband_dist=0
  peinf%nvband_node=0
  peinf%indext=0
  peinf%indext_dist=0
  
  do ii=1,sig%ntband
      ! FHJ: The bands are assigned to the processors in a sequential fashion.
      ! This is more efficient for the parallel IO. Eg: for 2  bands/processor,
      ! v1->PE0, v2->PE0, v3->PE1, etc.
      ipe = (sig%band_index(ii)-1)/peinf%ntband_max
      if (peinf%pool_rank.eq.ipe) then
        peinf%ntband_node=peinf%ntband_node+1
        if(sig%band_index(ii).le.(sig%nvband+sig%ncrit)) then
          peinf%nvband_node=peinf%nvband_node+1
        endif
        peinf%indext(peinf%ntband_node)=sig%band_index(ii)
      endif
      peinf%ntband_dist(ipe+1)=peinf%ntband_dist(ipe+1)+1
      peinf%indext_dist(peinf%ntband_dist(ipe+1),ipe+1)=sig%band_index(ii)
  enddo
  
!------------------------------------------------------------------------
! Report distribution of bands over processors

  if (peinf%inode.eq.0) then
701 format(1x,i4,1x,'processor(s),',1x,i4,1x,'pool(s),',1x,i4,1x,'processor(s) per pool')
    write(6,701) peinf%npes, peinf%npools, &
      peinf%npes/peinf%npools
702 format(1x,'WARNING: distribution is not ideal,',1x,i4,1x,'processor(s) is/are idle')
    if (mod(peinf%npes,peinf%npools).ne.0) &
      write(0,702) peinf%npes-(peinf%npes/peinf%npools)* &
      peinf%npools
    if (mod(sig%ndiag,peinf%npools).eq.0) then
703 format(1x,'each pool is computing',1x,i4,1x,'diagonal sigma matrix element(s)')
      write(6,703) peinf%ndiag_max
    else
704 format(1x,'each pool is computing',1x,i4,1x,'to',1x,i4,1x,'diagonal sigma matrix element(s)')
      write(6,704) peinf%ndiag_max-1, peinf%ndiag_max
705 format(1x,'WARNING: distribution is not ideal, number of diagonal sigma',/,&
      1x,'matrix elements',1x,i4,1x,'should be divisible by number of pools',1x,i4)
      write(0,705) sig%ndiag, peinf%npools
    endif
    if (mod(sig%noffdiag,peinf%npools).eq.0) then
706 format(1x,'each pool is computing',1x,i4,1x,'off-diagonal sigma matrix element(s)')
      write(6,706) peinf%noffdiag_max
    else
707 format(1x,'each pool is computing',1x,i4,1x,'to',1x,i4,1x,'off-diagonal sigma matrix element(s)')
      write(6,707) peinf%noffdiag_max-1, peinf%noffdiag_max
708 format(1x,'WARNING: distribution is not ideal, number of off-diagonal sigma',/,&
      1x,'matrix elements',1x,i4,1x,'should be divisible by number of pools',1x,i4)
      write(0,708) sig%noffdiag, peinf%npools
    endif
    if (mod(sig%ntband,peinf%npes/peinf%npools).eq.0) then
709 format(1x,'each processor is holding',1x,i4,1x,'valence and conduction band(s)')
      write(6,709) peinf%ntband_max
    else
710 format(1x,'each pool is holding',1x,i4,1x,'to',1x,i4,1x,'valence and conduction band(s)')
      write(6,710) minval(peinf%ntband_dist), maxval(peinf%ntband_dist)
711 format(1x,'WARNING: distribution is not ideal, number of valence and conduction bands',/,&
      1x,i4,1x,'should be divisible by number of processors per pool',1x,i4)
      write(0,711) sig%ntband, peinf%npes/peinf%npools
    endif
    write(6,*)
  endif

!-----------------------------------------------------------
!
!     LOOP OVER K-POINT GRID AND READ IN WAVEFUNCTIONS
!
!-----------------------------------------------------------

!----------------------------------------
! Open temporary wavefunction files iunit_c and iunit_k

  if (sig%iwriteint .eq. 0) then
    call open_file(iunit_c,file=fnc,form='unformatted',status='replace')
    if (mod(peinf%inode,peinf%npes/peinf%npools).eq.0) then
      call open_file(iunit_k,file=fnk,form='unformatted',status='replace')
    endif
  else
    SAFE_ALLOCATE(wfnkqmpi%nkptotal, (kp%nrk))
    SAFE_ALLOCATE(wfnkqmpi%isort, (kp%ngkmax,kp%nrk))
    SAFE_ALLOCATE(wfnkqmpi%band_index, (peinf%ntband_max,kp%nrk))
    SAFE_ALLOCATE(wfnkqmpi%qk, (3,kp%nrk))
    SAFE_ALLOCATE(wfnkqmpi%el, (sig%ntband,sig%nspin,kp%nrk))
    SAFE_ALLOCATE(wfnkqmpi%cg, (kp%ngkmax,peinf%ntband_max,sig%nspin*kp%nspinor,kp%nrk))
    if (sig%nkn.gt.1) then
      ndvmax=peinf%ndiag_max*kp%ngkmax
      if (mod(ndvmax,peinf%npes/peinf%npools).eq.0) then
        ndvmax_l=ndvmax/(peinf%npes/peinf%npools)
      else
        ndvmax_l=ndvmax/(peinf%npes/peinf%npools)+1
      endif
      SAFE_ALLOCATE(wfnkmpi%nkptotal, (sig%nkn))
      SAFE_ALLOCATE(wfnkmpi%isort, (kp%ngkmax,sig%nkn))
      SAFE_ALLOCATE(wfnkmpi%qk, (3,sig%nkn))
      SAFE_ALLOCATE(wfnkmpi%el, (sig%ntband,sig%nspin,sig%nkn))
      SAFE_ALLOCATE(wfnkmpi%elda, (sig%ntband,sig%nspin,sig%nkn))
      SAFE_ALLOCATE(wfnkmpi%cg, (ndvmax_l,sig%nspin*kp%nspinor,sig%nkn))
    endif
  endif

!-----------------------------------
! Read in wavefunction information

  SAFE_ALLOCATE(wfnk%isrtk, (gvec%ng))
  SAFE_ALLOCATE(wfnk%ek, (sig%ntband,sig%nspin))
  SAFE_ALLOCATE(wfnk%elda, (sig%ntband,sig%nspin))
  
  call progress_init(prog_info, 'reading wavefunctions (WFN_inner)', 'state', kp%nrk*sig%ntband)
  do irk=1,kp%nrk
    write(tmpstr,*) 'Reading WFN_inner -> cond/val wfns irk=',irk
    call logit(tmpstr)
    qk(:)=kp%rk(:,irk)

!----------------------------
! Read in and sort gvectors

    SAFE_ALLOCATE(gvec_kpt%components, (3, kp%ngk(irk)))

    if (peinf%inode.eq.0) call timacc(21,1)
    call read_binary_gvectors(25, kp%ngk(irk), kp%ngk(irk), gvec_kpt%components)
    if (peinf%inode.eq.0) call timacc(21,2)

    do i = 1, kp%ngk(irk)
      call findvector(isort(i), gvec_kpt%components(:, i), gvec)
      if (isort(i) .eq. 0) then
        write(0,*) 'could not find gvec', kp%ngk(irk), i, gvec_kpt%components(1:3, i)
        call die('findvector')
      endif
    enddo
    SAFE_DEALLOCATE_P(gvec_kpt%components)
    
!--------------------------------------------------------
! Determine if Sigma must be computed for this k-point.
! If so, store the bands and wavefunctions on file iunit_k.
! If there is only one k-point, store directly in wfnk.

    istore=0
    do ikn=1,sig%nkn
      if(sig%indkn(ikn).eq.irk) then
        istore=1
        iknstore=ikn
        wfnk%nkpt=kp%ngk(irk)
        wfnk%ndv=peinf%ndiag_max*kp%ngk(irk)
        wfnk%k(:)=qk(:)
        wfnk%isrtk(:)=isort(:)
        do k=1,sig%nspin
          wfnk%ek(1:sig%ntband,k)= &
            kp%el(1:sig%ntband,irk,sig%spin_index(k))
          wfnk%elda(1:sig%ntband,k)= &
            kp%elda(1:sig%ntband,irk,sig%spin_index(k))
        enddo
        SAFE_ALLOCATE(wfnk%zk, (wfnk%ndv,sig%nspin*kp%nspinor))
        wfnk%zk=ZERO
      endif
    enddo ! ikn

    if (sig%iwriteint .eq. 0) then
      write(iunit_c) kp%ngk(irk),sig%ntband,(isort(j),j=1,gvec%ng), &
        ((kp%el(j,irk,sig%spin_index(k)),j=1,sig%ntband), &
        k=1,sig%nspin),(qk(i),i=1,3)
    else
      wfnkqmpi%nkptotal(irk) = kp%ngk(irk)
      wfnkqmpi%isort(1:kp%ngk(irk),irk) = isort(1:kp%ngk(irk))
      do k = 1, sig%nspin
        wfnkqmpi%el(1:sig%ntband,k,irk) = &
          kp%el(1:sig%ntband,irk,sig%spin_index(k))
      enddo
      wfnkqmpi%qk(1:3,irk) = qk(1:3)
    endif

!-------------------------------------------------------------------------
! SIB:  Read wave functions from file WFN_inner (unit=25) and have
! the appropriate processor write it to iunit_c after checking norm.
! The wavefunctions for bands where Sigma matrix elements are
! requested are stored in wfnk%zk for later writing to unit iunit_k.
! If band index is greater than sig%ntband, we will actually
! not do anything with this band (see code below).
!  We still have to read it though, in order
! to advance the file to get to the data for the next k-point.

    SAFE_ALLOCATE(zc, (kp%ngk(irk), kp%nspin*kp%nspinor))

    inum=0
    do i=1,kp%mnband

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

      dont_read = (i > sig%ntband)
      call read_binary_data(25, kp%ngk(irk), kp%ngk(irk), kp%nspin*kp%nspinor, zc, dont_read = dont_read)
      if (peinf%inode.eq.0) call timacc(21,2)

      if (.not.dont_read) then
        call progress_step(prog_info, sig%ntband*(irk-1) + i)
        if(peinf%inode.eq.0) then
          do k=1,sig%nspin
            call checknorm('WFN_inner',i,irk,kp%ngk(irk),k,kp%nspinor,zc(:,:))
          enddo
        endif

        nstore=0
        do j=1,peinf%ndiag_max
          if (.not.peinf%flag_diag(j)) cycle
          if (sig%band_index(i).eq. &
            sig%diag(peinf%index_diag(j))) nstore=j
        enddo
        if((istore.eq.1).and.(nstore.ne.0)) then
          do k=1,sig%nspin*kp%nspinor
            do j=1,kp%ngk(irk)
              wfnk%zk((nstore-1)*kp%ngk(irk)+j,k) = zc(j,sig%spin_index(k))
            enddo
          enddo
        endif
        j=0
        do ii=1,peinf%ntband_node
          if (peinf%indext(ii).eq.sig%band_index(i)) j=1
        enddo

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

        if (j.eq.1) then
          if (sig%iwriteint .eq. 0) then
            write(iunit_c) sig%band_index(i),kp%ngk(irk), &
              ((zc(j,sig%spin_index(k)),j=1,kp%ngk(irk)), &
              k=1,sig%nspin*kp%nspinor)
          else
            inum=inum+1
            wfnkqmpi%band_index(inum,irk)=sig%band_index(i)
            do k=1,sig%nspin*kp%nspinor
              wfnkqmpi%cg(1:kp%ngk(irk),inum,k,irk)= &
                zc(1:kp%ngk(irk),sig%spin_index(k))
            enddo
          endif
        endif

        if (peinf%inode.eq.0) call timacc(22,2)
      else
        ! 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 (irk==kp%nrk) exit
      endif
      
    enddo ! i (loop over bands)
    SAFE_DEALLOCATE(zc)
    
    if((istore.eq.1).and.(sig%nkn.gt.1)) then

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

      if (sig%iwriteint .eq. 0) then
        if (mod(peinf%inode,peinf%npes/peinf%npools).eq.0) then
          write(iunit_k) kp%ngk(irk),wfnk%ndv,sig%ntband, &
            (wfnk%isrtk(j),j=1,gvec%ng),(qk(i),i=1,3), &
            ((wfnk%ek(j,k),j=1,sig%ntband),k=1,sig%nspin), &
            ((wfnk%elda(j,k),j=1,sig%ntband),k=1,sig%nspin), &
            ((wfnk%zk(j,k),j=1,wfnk%ndv),k=1,sig%nspin*kp%nspinor)
        endif
      else
        ikn=iknstore
        wfnkmpi%nkptotal(ikn)=kp%ngk(irk)
        wfnkmpi%isort(1:kp%ngk(irk),ikn)=wfnk%isrtk(1:kp%ngk(irk))
        wfnkmpi%qk(1:3,ikn)=qk(1:3)
        wfnkmpi%el(1:sig%ntband,1:sig%nspin,ikn)= &
          wfnk%ek(1:sig%ntband,1:sig%nspin)
        wfnkmpi%elda(1:sig%ntband,1:sig%nspin,ikn)= &
          wfnk%elda(1:sig%ntband,1:sig%nspin)
        do k=1,sig%nspin*kp%nspinor
#ifdef MPI
          i=mod(peinf%inode,peinf%npes/peinf%npools)
          if (mod(wfnk%ndv,peinf%npes/peinf%npools).eq.0) then
            j=wfnk%ndv/(peinf%npes/peinf%npools)
          else
            j=wfnk%ndv/(peinf%npes/peinf%npools)+1
          endif
          g1=1+i*j
          g2=min(j+i*j,wfnk%ndv)
          if (g2.ge.g1) then
            wfnkmpi%cg(1:g2-g1+1,k,ikn)=wfnk%zk(g1:g2,k)
          endif ! g2.ge.g1
#else
          wfnkmpi%cg(1:wfnk%ndv,k,ikn)=wfnk%zk(1:wfnk%ndv,k)
#endif
        enddo
      endif

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

      SAFE_DEALLOCATE_P(wfnk%zk)
    endif
    
  enddo ! irk (loop over k-points)
  call progress_free(prog_info)

!------------------------------------------
! Close files and write out information about the crystal

  if(sig%iwriteint .eq. 0) then
    call close_file(iunit_c)
    if(mod(peinf%inode,peinf%npes/peinf%npools).eq.0) call close_file(iunit_k)
  endif

  if(peinf%inode.eq.0) then
    call close_file(25) ! WFN_inner
    write(6,111)
111 format(/,1x,'Read WFN_inner successfully.',/)
    write(7,111)    

!------------------------------------------------------
! Write out information about self-energy calculation

    write(6,120) sig%ntband,sig%nvband,sig%ncrit, &
      sig%ecutb,sig%ecuts,sig%sexcut,sig%gamma, &
      sig%fdf,sig%dw
    write(7,120) sig%ntband,sig%nvband,sig%ncrit, &
      sig%ecutb,sig%ecuts,sig%sexcut,sig%gamma, &
      sig%fdf,sig%dw
120 format(/,5x,'ntband =',i6,2x,'nvband =',i6,2x,'ncrit =',i3,/, &
      5x,'ecutb =',f10.4,2x,'ecuts =',f10.4,2x,'sexcut =',f10.4,/, &
      5x,'gamma =',f10.4,2x,'fdf =',i3,2x,'de =',f10.4,1x,'eV')

    call scissors_write(6, sig%scis)
    call scissors_write(6, sig%scis_outer, "outer")
    write(6,'(a)')
    call scissors_write(7, sig%scis)
    call scissors_write(7, sig%scis_outer, "outer")
    write(7,'(a)')

    if(sig%freq_dep.eq.1) then
      do k=1,sig%nspin
        write(6,160) sig%spin_index(k),wpg%nelec &
          (sig%spin_index(k)),sqrt(wpg%wpsq(sig%spin_index(k)))
        write(7,160) sig%spin_index(k),wpg%nelec &
          (sig%spin_index(k)),sqrt(wpg%wpsq(sig%spin_index(k)))
160     format(/,5x,'data for sum rule',3x,'rho(0,',i1,')=',f8.4, &
          3x,'wp =',f8.4,1x,'eV')
      enddo
      write(6,*)
      write(7,*)
    endif ! sig%freq_dep
171 format(/,1x,'ndiag    =',i4)
    write(6,171) sig%ndiag
172 format(1x,'diag(:)  =',999i4)
    write(6,172) sig%diag(:)
173 format(1x,'noffdiag =',i4)
    write(6,173) sig%noffdiag
    if (sig%noffdiag>0) then
      do k=1,sig%noffdiag
174 format(1x,'offmap(:, ',i4,') =',3i4)
        write(6,174) k, (sig%offmap(k,ii), ii = 1, 3)
      enddo
    endif
    write(6,*)
    
  endif ! node 0
  
  SAFE_DEALLOCATE(isort)
  SAFE_DEALLOCATE(isrt)
  SAFE_DEALLOCATE(isrti)
  SAFE_DEALLOCATE_P(kp%w)
  SAFE_DEALLOCATE_P(kp%el)
  SAFE_DEALLOCATE_P(kp%elda)

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

  POP_SUB(input)
  
  return
  
end subroutine input
