!===============================================================================
!
! Routines:
!
! (1)  inteqp         Originally by JRD       Last Edited: 10/11/2010 (JRD)
!
! Extrapolates Eqp corrections from the coarse grid to the fine grid by
! a wavefunction-based plus linear interpolation scheme that preserves band crossings/character. 
! The code reads eqp_co.dat and writes eqp.dat and
! eqp_q.dat. The DFT wavefunctions for the interpolation are read
! from WFN_co, WFN_fi, and WFNq_fi files.
!
! See absorption.inp for options and keywords.
!
!================================================================================

#include "f_defs.h"

program inteqp

  use global_m
  use fullbz_m
  use inread_m
  use intwfn_m
  use bse_init_m
  implicit none

  type (crystal) :: crys
  type (symmetry) :: syms
  type (gspace) :: gvec
  type (eqpinfo) :: eqp
  type (xctinfo) :: xct
  type (flags) :: flag
  type (grid) :: kg_fi,kgq_fi
  type (kpoints) :: kp_fi,kpq_fi
  type (int_wavefunction) :: intwfnc
  type (int_wavefunction) :: intwfnv

  integer :: ii,ncount
  integer :: iunit_c,iunit_v
  real(DP) :: vol,omega_plasma
  real(DP) :: tsec(2),tmin(2),tmax(2)
  
  character*16, allocatable :: routnam(:)
  integer, allocatable :: routsrt(:)
  integer, allocatable :: fi2co_wfn(:,:),indexq_fi(:)
  real(DP), allocatable :: kco(:,:)
  character :: filename*20
  SCALAR, allocatable :: dcc(:,:,:,:,:),dvv(:,:,:,:,:)
  real(DP), allocatable :: intp_coefs(:,:)

  call peinfo_init()

!----------------------
! Initialize timer

  call timacc(0,0)
  call timacc(1,1)

!---------------------------
! Write header

  call write_program_header('BSE/IntEqp', .false.)

!---------------------------
! Read inteqp.inp
  
  call logit('Calling inread_inteqp')
  call open_file(8,file='inteqp.inp',form='formatted',status='old')
  call inread(eqp,xct,flag)
  call close_file(8)

! FHJ: Initialize xct%nkpt_co and dimentionality of the problem
  call bse_init(xct,flag)

!--------------------------
! Read wavefunctions on the fine grid

  call logit('Calling input')
  call timacc(2,1)
  call input(crys,gvec,kg_fi,kp_fi,syms,eqp,xct,flag,omega_plasma,.false.,intwfnc)

  vol = xct%nktotal*crys%celvol
  if (peinf%inode.eq.0) then
    write(6,*) ' '
    write(6,*) 'More Job Parameters: '
    write(6,'(a,f32.14,a)') ' Crystal volume = ',vol,' a.u.'
    write(6,*) 'Number of valence bands = ',xct%nvb_fi
    write(6,*) 'Number of cond. bands   = ',xct%ncb_fi
    write(6,*) 'Number of spins   = ',xct%nspin
    write(6,*) ' '
  endif
  call timacc(2,2)

  SAFE_ALLOCATE(indexq_fi, (xct%nkpt_fi))
!  if (flag%vm.ne.1.or.flag%dtm.ne.1) then ! both are always 0 in this code --DAS
  call timacc(3,1)
  call logit('Calling input_q')
  call input_q(kp_fi,crys,gvec,kg_fi,kgq_fi,kpq_fi,syms,xct,indexq_fi,eqp,flag,intwfnv)
  call timacc(3,2)

!------------------------------
! Calculate the transformation matrices from coarse grid wavefunctions
! FHJ: These are the final transformation coefs that will be used to interpolate
! the kernel. However, we might use an unrestricted version of dvv/dcc to
! interpolate eqp if xct%unrestricted_transf==.true..
  SAFE_ALLOCATE(dvv, (xct%nvb_fi,xct%n1b_co,xct%nspin,xct%nkpt_fi,xct%npts_intp_kernel))
  SAFE_ALLOCATE(dcc, (xct%ncb_fi,xct%n2b_co,xct%nspin,xct%nkpt_fi,xct%npts_intp_kernel))
  SAFE_ALLOCATE(kco, (3,xct%nkpt_co))
  SAFE_ALLOCATE(fi2co_wfn, (xct%npts_intp_kernel,xct%nkpt_fi))
  SAFE_ALLOCATE(intp_coefs, (xct%npts_intp_kernel, xct%nkpt_fi))

  call logit('Calling intwfn')
  call timacc(4,1)
  call intwfn(kp_fi,crys,syms,xct,flag,gvec,kg_fi,kgq_fi,dcc,dvv,&
    kco,fi2co_wfn,indexq_fi,eqp,intwfnv,intwfnc,intp_coefs)
  call timacc(4,2)

  call dealloc_grid(kg_fi)
  call dealloc_grid(kgq_fi)

!  if(peinf%inode.eq.0 .and. xct%iwriteint.eq.0) then
!    call close_file(126, delete = .true.) ! delete INT_CWFN_CO
!    call close_file(127, delete = .true.) ! delete INT_VWFN_CO
!    if (xct%qflag .eq. 0) then
!      call close_file(123, delete = .true.) ! delete INT_CWFN_CO_Q
!      call close_file(124, delete = .true.) ! delete INT_VWFN_CO_Q
!    endif
!  endif

  SAFE_DEALLOCATE_P(xct%ifmax)
  SAFE_DEALLOCATE_P(xct%ifmaxq)

  if (xct%iwriteint.eq.1) then
    SAFE_DEALLOCATE_P(intwfnc%cgk)
    SAFE_DEALLOCATE_P(intwfnv%cgk)
    SAFE_DEALLOCATE_P(intwfnc%isort)
    SAFE_DEALLOCATE_P(intwfnv%isort)
  endif

! JRD: Now close the no-longer-needed wavefunction files

  ! intwfn deletes INT_CWFN_CO, INT_CWFN_CO_Q, INT_VWFN_CO, INT_VWFN_CO_Q itself
  if (xct%iwriteint.eq.0) then
    write(filename,'(a,i4.4)') 'INT_VWFNQ_', peinf%inode
    iunit_v = 128+(2*peinf%inode)+2
    call open_file(iunit_v, filename, status = 'old')
    call close_file(iunit_v, delete = .true.) ! files INT_VWFNQ_*
    
    write(filename,'(a,i4.4)') 'INT_CWFN_', peinf%inode
    iunit_c = 128+(2*peinf%inode)+1
    call open_file(iunit_c, filename, status = 'old')
    call close_file(iunit_c, delete = .true.) ! files INT_CWFN_*
  endif

  SAFE_DEALLOCATE_P(eqp%ecqp)
  SAFE_DEALLOCATE_P(eqp%evqp)
  
#ifdef MPI
  call MPI_BARRIER(MPI_COMM_WORLD,mpierr)
#endif

!--------------------------------
! Time accounting

  SAFE_ALLOCATE(routnam, (60))
  routnam(1)='TOTAL:'
  routnam(2)='INPUT:'
  routnam(3)='INPUT_Q:'
  routnam(4)='INTWFN:'
  routnam(5)='INTKERNEL:'
  routnam(6)='PEIG_INTER:'
  routnam(41)='IW Input_co:'
  routnam(42)='IW Interp:'
  routnam(43)='IW Genwf:'
  routnam(44)='IW Gwnwf_Co:'
  routnam(45)='IW Mtxel_t:'
  routnam(46)='IW Write:'
  routnam(47)='IW Reduce:'
  SAFE_ALLOCATE(routsrt, (13))
  routsrt=(/ (ii,ii=2,6), (ii,ii=41,47), 1 /)
  
  call timacc(1,2)
  if(peinf%inode.eq.0) then
    write(6,*)
    write(6,9000) 'CPU [s]','WALL [s]','#'
    write(6,*)
  endif
 
  do ii=1,ubound(routsrt, 1)
    call timacc(routsrt(ii),3,tsec,ncount)
#ifdef MPI
    call MPI_ALLREDUCE(tsec,tmin,2,MPI_REAL_DP,MPI_MIN,MPI_COMM_WORLD,mpierr)
    call MPI_ALLREDUCE(tsec,tmax,2,MPI_REAL_DP,MPI_MAX,MPI_COMM_WORLD,mpierr)
#else
    tmin = tsec
    tmax = tsec
#endif
    if(peinf%inode==0) then
      if (ii>1) then
        if (routsrt(ii)-routsrt(ii-1)/=1) write(6,*)
      endif
      write(6,9001) routnam(routsrt(ii)),tmin(1),tmin(2),ncount
      write(6,9002) tsec(1),tsec(2)
      write(6,9003) tmax(1),tmax(2)
    endif
  enddo
  
9000 format(17x,a13,  3x,a13,  3x,a8)
9001 format(1x,a11,'(min.)',f13.3,3x,f13.3,3x,i8)
9002 format(  12x,'(PE 0)',f13.3,3x,f13.3)
9003 format(  12x,'(max.)',f13.3,3x,f13.3)

  call write_memory_usage()

#ifdef MPI
  call MPI_FINALIZE(mpierr)
#endif
  
end program inteqp
