!================================================================================
!
! Routines:
!
! (1) epscopy()  Originally By MLT               Last Modified: 5/5/2008 (JRD)
!
!     This routine reads in epsmat/eps0mat and creates temporary files INT_EPS_*
!     if comm_disk option is on.
!
!     Input: crys,gvec,syms types
!            xct%ecute
!            xct%ecutg
!
!     Output: qg type
!             INT_EPS_* files
!
!================================================================================

#include "f_defs.h"

subroutine epscopy(crys,gvec,syms,qg,xct,q0vec)

  use global_m
  use checkbz_m
  use fullbz_m
  use misc_m
  use epsread_hdf5_m
  implicit none

  type (crystal), intent(in) :: crys
  type (gspace), intent(in) :: gvec
  type (symmetry), intent(in) :: syms
  type (grid), intent(out) :: qg
  type (xctinfo), intent(inout) :: xct
  real(DP), intent(out) :: q0vec(3)

!---------------------------
! From units 10 and 11

  integer :: igamma,nrq0,nrq1,nmtx,ng,ngmax,iowner
  real(DP) :: q0(3),q0t(3,1),qk(3)
  real(DP), allocatable :: q1(:,:),eknq(:)
  SCALAR, allocatable :: epscol(:),tempepsdiag(:,:),eps(:,:)

!---------------------------
! Local stuff

  character :: ajname*6,adate*10
  character :: ajname2*6,adate2*10
  character :: filename*20,tmpstr*100
  character :: tmpfn*16
  integer :: ii,jj,kk,ll,nold,gg(3),ngt,nmtxmax0,nmtxmax1,nmtxt,j,i
  integer :: iout,irq,ijk,qgrid(3),idummy,ig
  real(DP) :: gmax_in,emax,qshift(3)

  integer, allocatable :: nmtx_of_q(:),nmtx0_of_q(:)
  integer, allocatable :: isrtold(:),isrtinvdummy(:),oldg(:,:)
  real(DP), allocatable :: ekold(:)
  logical :: skip_checkbz

  character :: filenameh5*80
  character :: filenameh50*80

  logical :: file_exists

  PUSH_SUB(epscopy)

  qgrid(:)=0
  SAFE_ALLOCATE(eknq, (gvec%ng))

!----------------- Read information for inverse dielectric matrix for q->0 unit10 --

  filenameh5 = 'epsmat.h5'
  filenameh50 = 'eps0mat.h5'

  if(peinf%inode.eq.0) then

#ifdef HDF5
    if(xct%use_hdf5) then

      call read_eps_grid_sizes_hdf5(nold,nrq0,gmax_in,idummy,nmtxmax0,qgrid,filenameh50)
      ng=nold
      xct%nmtxmax = nmtxmax0

! XXX Check sanity below. Make sure nold doesn`t change
! XXX NEED igamma

      INQUIRE(FILE="epsmat.h5", EXIST=file_exists)
      if ( file_exists ) then
        igamma = 0 
      else
        igamma = 1
      endif
      
      if(igamma.eq.0) then
        call read_eps_grid_sizes_hdf5(nold,nrq1,gmax_in,idummy,nmtxmax1,qgrid,filenameh5)
        if (nmtxmax1 .gt. xct%nmtxmax) xct%nmtxmax = nmtxmax1
      else
        nrq1=0
      endif
      
      ngmax=nold

    else
#endif

      call open_file(unit=10,file='eps0mat',form='unformatted',status='old')
      call open_file(unit=11,file='epsmat',form='unformatted',status='old',iostat=igamma)
    
      read(10) 
      read(10) ii
      if (ii.ne.0) call die('epscopy: freq_dep')
      read(10)
      read(10)
      read(10)
      read(10)
      read(10)
      read(10)
      read(10) nold
      read(10) ng, nmtx
      call close_file(10)
      
      xct%nmtxmax = nmtx
      
      if(igamma.eq.0) then
        read(11) 
        read(11) ii
        if (ii.ne.0) call die('epscopy: freq_dep')
        read(11)
        read(11)
        read(11)
        read(11)
        read(11)
        read(11) nrq1
        read(11) nold
        ngmax= 0
        do ii=1,nrq1
          read(11) ngt, nmtxt
          read(11)
          read(11)
          do jj = 1, nmtxt
            read(11)
          enddo
          if (ngt.gt.ngmax) ngmax= ngt
          if (nmtxt.gt.xct%nmtxmax) xct%nmtxmax= nmtxt
        enddo
        call close_file(11)
      else
        nrq1=0
      endif

#ifdef HDF5
    endif
#endif

    if(ng > gvec%ng) then
      write(0,*) 'Read from epsmat ng = ', ng, ' > gvec%ng = ', gvec%ng
      call die("epscopy: read illegal ng from epsmat")
    endif

    SAFE_ALLOCATE(oldg, (3, nold))
    SAFE_ALLOCATE(isrtold, (ng))
    SAFE_ALLOCATE(ekold, (ng))
    
#ifdef HDF5
    if(xct%use_hdf5) then

      ajname='chiGG0'
      adate = 'nodate'

      SAFE_ALLOCATE(nmtx0_of_q,(nrq0))
      call read_eps_qgrid_hdf5(nrq0,q0t,nmtx0_of_q,filenameh50)
      q0(:)=q0t(:,1)

      call read_eps_old_gvecs_hdf5(nold,oldg,filenameh50)

    else
#endif

      call open_file(unit=10,file='eps0mat',form='unformatted',status='old')    
      
      read(10) ajname,adate
      read(10)
      read(10) (qgrid(ii),ii=1,3)
      read(10)
      read(10)
      read(10)
      read(10) gmax_in
      read(10) nrq0,(q0(ii),ii=1,3)
      read(10) nold,(oldg(1:3,ii),ii=1,nold)

#ifdef HDF5
    endif
#endif

    if(nrq0.gt.1) then
      call die("There is more than one q-point in eps0mat.", only_root_writes = .true.)
    endif
    write(6,'(/,1x,a)') 'Epsilon matrix for q->0 read from eps0mat'
    write(6,'(1x,a,i0,2x,a,f12.6)') 'nrq0 = ', nrq0, 'gmax = ', gmax_in
#ifdef VERBOSE
    write(6,*)
    write(6,'(1x,3f10.6)') q0(1:3)
    write(6,*)
#endif
  endif

#ifdef MPI
  call MPI_BCAST(nrq0,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  call MPI_BCAST(nrq1,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  call MPI_BCAST(xct%nmtxmax,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  call MPI_BCAST(igamma,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  call MPI_BCAST(q0,3,MPI_REAL_DP,0,MPI_COMM_WORLD,mpierr)
#endif
  
  xct%maxpet=xct%nmtxmax/peinf%npes
  if (mod(xct%nmtxmax,peinf%npes) .ne. 0) then
    xct%maxpet=xct%maxpet+1
  endif

  SAFE_ALLOCATE(xct%nmtxa, (nrq1+1))
  if (peinf%inode .eq. 0 .or. xct%bLowComm) then
    SAFE_ALLOCATE(xct%isrtqi, (gvec%ng,nrq1+1))
  endif
  if (xct%iwriteint .eq. 1) then
    if (xct%bLowComm) then
      SAFE_ALLOCATE(xct%epscol, (xct%nmtxmax,xct%nmtxmax,nrq1+1))
    else 
      SAFE_ALLOCATE(xct%epscol, (xct%nmtxmax,xct%maxpet,nrq1+1))
    endif
    SAFE_ALLOCATE(xct%epsown, (xct%nmtxmax))
    SAFE_ALLOCATE(xct%epsowni, (xct%maxpet,peinf%npes))
  endif
  SAFE_ALLOCATE(xct%maxpe, (peinf%npes))
  
  xct%maxpe=0
  if (xct%iwriteint .eq. 0) then
    xct%maxpe(1) = xct%nmtxmax
  else
    do jj = 1, xct%nmtxmax
      xct%epsown(jj)=(jj/peinf%npes)
      if (mod(jj,peinf%npes).ne.0) xct%epsown(jj) = xct%epsown(jj) +1
      iowner=mod(jj,peinf%npes)
      xct%epsowni(xct%epsown(jj),iowner+1)=jj
      if (xct%maxpe(iowner+1) .lt. xct%epsown(jj)) xct%maxpe(iowner+1) = xct%epsown(jj)
    enddo
  endif  

  SAFE_ALLOCATE(xct%epsdiag, (xct%nmtxmax,nrq1+1))

! Read q->0 dielectric matrix

  if(peinf%inode.eq.0) then

#ifdef HDF5
    if(xct%use_hdf5) then

      SAFE_ALLOCATE(isrtinvdummy, (ng))
      call read_eps_gvecsofq_hdf5(ng,isrtold,isrtinvdummy,ekold,1,filenameh50)
      SAFE_DEALLOCATE(isrtinvdummy)
      nmtx = nmtx0_of_q(1)
      qk = q0

    else
#endif

      read(10) ng,nmtx,(isrtold(ii),jj,ii=1,ng)
      read(10) (ekold(ii),ii=1,ng)
      read(10) (qk(ii),ii=1,3)

#ifdef HDF5
    endif
#endif

    xct%isrtqi(:,1)= 0

!---------------------
! Sort the eps. matrix elements according to gvec%.
! Emax is some large energy, bigger than xct%ecute (but it does not
! need to be as large as the ekmax used to write epsmat/eps0mat).
! Check if the value of emax is OK.

    emax=xct%ecutg

    do ii=1,ng
      if (ekold(isrtold(ii)).lt.emax) then
        gg(1:3)=oldg(1:3, isrtold(ii))
        call findvector(iout,gg,gvec)
        if (iout.gt.gvec%ng) call die('epscopy: iout > ng')
        if (iout.le.0) call die('epscopy: iout <= 0')

!--------------------------------
! isrtqi has the sorting of G-vectors from eps to gvec%components

        if (peinf%inode .eq. 0) then
          xct%isrtqi(iout,1)=ii
        endif
      endif
    enddo
    SAFE_DEALLOCATE(isrtold)
    SAFE_DEALLOCATE(ekold)
    SAFE_DEALLOCATE(oldg)
  endif

#ifdef VERBOSE
  if (peinf%inode .eq. 0) write(6,*) ' '
  if (peinf%inode .eq. 0) write(6,*) 'Example elements: '
#endif

  q0vec=q0
  q0 = 0.0d0

! JRD: Write header of INT_EPS_*

  irq=0
  
  if (peinf%inode .eq. 0 .and. xct%iwriteint .eq. 0) then
    write(filename,'(a,i4.4)') 'INT_EPS_', irq
    call open_file(17,file=filename,form='unformatted',status='replace')
  endif

#ifdef MPI
  call MPI_BCAST(nmtx,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
#endif

  xct%nmtxa(1)=nmtx

!------------------------------
! JRD: Finally Read In Eps (Proc 0)

#ifdef HDF5
  if(xct%use_hdf5) then

    if (xct%iwriteint .eq. 0) then
      if (peinf%inode .eq. 0) then
        SAFE_ALLOCATE(epscol, (nmtx))
        do j=1,nmtx
          call read_eps_matrix_col_hdf5(epscol,j,nmtx,1,1,filenameh50)
          write(17) (epscol(i),i=1,nmtx)
          xct%epsdiag(j,1) = epscol(j)  
        enddo
        SAFE_DEALLOCATE(epscol)
      endif
    else if (xct%bLowComm) then
! JRD: XXX This is slower than need be. Should use parallel read + MPI_ALL_ALL
      SAFE_ALLOCATE(eps,(nmtx,nmtx))
      if (peinf%inode .eq. 0) then
        call read_eps_matrix_ser_hdf5(eps,nmtx,1,1,filenameh50)
      endif
#ifdef MPI
      call MPI_BCAST(eps(1,1),nmtx*nmtx,MPI_SCALAR,0,MPI_COMM_WORLD,mpierr)
#endif
      xct%epscol(1:nmtx,1:nmtx,1) = eps(1:nmtx,1:nmtx)
      SAFE_DEALLOCATE(eps)
    else
      call read_eps_matrix_par_hdf5(xct%epscol(:,:,1),xct%maxpe(peinf%inode+1),&
        xct%maxpet,xct%epsowni(:,peinf%inode+1),nmtx,1,1,filenameh50)
    endif

! XXX  Print Constant

  else
#endif

    SAFE_ALLOCATE(epscol, (nmtx))
    do jj =1,nmtx
      if (peinf%inode .eq. 0) then
        read(10) (epscol(ii),ii=1,nmtx)

!------------------------------
! SIB: print out a small section of the dielectric matrix for testing purposes

#ifdef VERBOSE
        if (jj .le. 4) then
          do ii=1,4
            do ig = 1, gvec%ng
              if(xct%isrtqi(ig, 1) == ii) kk = ig
              if(xct%isrtqi(ig, 1) == jj) ll = ig
            enddo
            write(tmpstr,'(3i3,1x,3i3,1x,2f10.5)') gvec%components(:,kk),gvec%components(:,ll),epscol(ii)
            call logit(tmpstr)
          enddo
        endif
#endif

! Report on dielectric constant

        if (jj .eq. 1) then
          write(6,'(a)') ''
          write(6,*) 'Head of epsilon inverse : ', epscol(1)
          write(6,'(a)') ''
          
          if(dble(epscol(1)) < 1d-3 .and. xct%iscreen == 0 .and. peinf%inode == 0) then
            write(0,'(a)') 'WARNING: You are using semiconductor screening, but the'
            write(0,'(a)') 'head of epsilon inverse is very small and seems metallic.'
          endif
        endif
      endif

! Write dielectric matrix column for q->0 to unit17 unformatted
      
      if (xct%iwriteint .eq. 0) then
        if (peinf%inode .eq. 0) then
          write(17) epscol(1:nmtx)
        endif
      else
#ifdef MPI
        call MPI_BCAST(epscol,nmtx,MPI_SCALAR,0,MPI_COMM_WORLD,mpierr)
#endif
        xct%epsown(jj)=(jj/peinf%npes)
        if (mod(jj,peinf%npes).ne.0) xct%epsown(jj) = xct%epsown(jj) +1
        iowner=mod(jj,peinf%npes)
        xct%epsowni(xct%epsown(jj),iowner+1)=jj
        if (xct%maxpe(iowner+1) .lt. xct%epsown(jj)) xct%maxpe(iowner+1) = xct%epsown(jj)
        
        if (xct%bLowComm) then
          xct%epscol(1:nmtx,jj,1)=epscol(:)
        else
          if (iowner .eq. peinf%inode) then
            xct%epscol(1:nmtx,xct%epsown(jj),1)=epscol(:)
          endif
        endif
      endif
      if (peinf%inode .eq. 0) then
        xct%epsdiag(jj,1) = epscol(jj)  
      endif
    enddo
    SAFE_DEALLOCATE(epscol)
    
    if (peinf%inode .eq. 0) then
      call close_file(10)
    endif
    
#ifdef HDF5
  endif
#endif

! Close comm_disk file
  if (xct%iwriteint .eq. 0 .and. peinf%inode .eq. 0) then
    call close_file(17)
  endif


!----------------- Read dielectric matrices from unit11 for q<>0 --------------------

  if(igamma.ne.0) then
    nrq1=0
  else

! Have to allocate oldg again...

    if(peinf%inode.eq.0) then
      SAFE_ALLOCATE(oldg, (3, nold))
      SAFE_ALLOCATE(isrtold, (ngmax))
      SAFE_ALLOCATE(ekold, (ngmax))
      SAFE_ALLOCATE(q1, (3,nrq1))
#ifdef HDF5
      if(xct%use_hdf5) then
        SAFE_ALLOCATE(nmtx_of_q,(nrq1))
        call read_eps_qgrid_hdf5(nrq1,q1,nmtx_of_q,filenameh5)
        
        call read_eps_old_gvecs_hdf5(nold,oldg,filenameh5)
      else
#endif
        call open_file(unit=11,file='epsmat',form='unformatted',status='old')
        read(11) ajname2,adate2
        read(11)
        read(11) (qgrid(ii),ii=1,3)
        read(11)
        read(11)
        read(11)
        read(11) gmax_in
        read(11) nrq1,((q1(ii,jj),ii=1,3),jj=1,nrq1)
        read(11) nold,(oldg(1:3,ii),ii=1,nold)
#ifdef HDF5
      endif
#endif

    endif

#ifdef MPI
    if(peinf%inode.ne.0) then
      SAFE_ALLOCATE(q1, (3,nrq1))
    endif
    call MPI_BCAST(q1,3*nrq1,  MPI_REAL_DP,0,MPI_COMM_WORLD,mpierr)
#endif

    if(peinf%inode.eq.0) then
      write(6,'(/,1x,a)') 'Epsilon matrix for q/=0 read from epsmat'
      write(6,'(1x,a,i0,2x,a,f12.6)') 'nrq = ', nrq1, 'gmax = ', gmax_in
#ifdef VERBOSE
      write(6,*)
      write(6,'(1x,3f10.6)') q1(1:3,1:nrq1)
      write(6,*)
#endif
    endif
    
  endif
  qg%nr=nrq1+1
  SAFE_ALLOCATE(qg%r, (3,qg%nr))
  qg%r(1:3,1)=q0
  if(nrq1.ne.0) then
    qg%r(1:3,2:qg%nr)=q1(1:3,1:nrq1)
    SAFE_DEALLOCATE(q1)
  endif

! Read inverse dielectric matrices from unit11 for q<>0

  if(igamma == 0) then

    do irq=1,nrq1
      if(peinf%inode.eq.0) then
        isrtold=0
        ekold=0.d0
        xct%isrtqi(:,irq+1)=0
#ifdef HDF5
        if(xct%use_hdf5) then
          SAFE_ALLOCATE(isrtinvdummy, (nold))
          call read_eps_gvecsofq_hdf5(nold,isrtold,isrtinvdummy,ekold,irq,filenameh5)
          SAFE_DEALLOCATE(isrtinvdummy)
          nmtx = nmtx_of_q(irq)
          qk(:) = qg%r(:,irq+1)
        else
#endif
          read(11) ng,nmtx,(isrtold(ii),jj,ii=1,ng)
          read(11) (ekold(ii),ii=1,ng)
          read(11) (qk(ii),ii=1,3)
#ifdef HDF5
        endif
#endif
        
        do ii=1,ng
          if (ekold(isrtold(ii)).lt.emax) then
            gg(1:3)=oldg(1:3, isrtold(ii))
            call findvector(iout,gg,gvec)
            if (iout.gt.gvec%ng) call die('epscopy: iout > ng')
            if (iout.le.0) call die('epscopy: iout <= 0')
            xct%isrtqi(iout,irq+1)=ii
            eknq(ii)=ekold(isrtold(ii))
          endif
        enddo

!----------------------------
! Copy dielectric matrices to unit17 unformatted

! Actually, the dielectric matrix at each q-point is written
! in a separate INT_EPS_* file. INT_EPS_0000 has the q=0 point.
! q-points in IBZ = qg%nrk < 10001

        if (xct%iwriteint .eq. 0) then
          if (irq.lt.10000) then
            write(filename,'(a,i4.4)') 'INT_EPS_', irq
          else
            call die("irq > 9999")
          endif

          call open_file(17,file=filename,form='unformatted',status='replace')
        endif
      endif
      
#ifdef MPI
      call MPI_BCAST(nmtx,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
#endif
      
      xct%nmtxa(irq+1)=nmtx

#ifdef HDF5
      if(xct%use_hdf5) then

        if (xct%iwriteint .eq. 0) then
          if (peinf%inode .eq. 0) then
            SAFE_ALLOCATE(epscol, (nmtx))
            do j=1,nmtx
              call read_eps_matrix_col_hdf5(epscol,j,nmtx,irq,1,filenameh5)
              write(17) (epscol(i),i=1,nmtx)
              xct%epsdiag(j,irq+1) = epscol(j)  
            enddo
            SAFE_DEALLOCATE(epscol)
          endif
        else if (xct%bLowComm) then
! JRD: XXX This is slower than need be. Should use parallel read + MPI_ALL_ALL
          SAFE_ALLOCATE(eps,(nmtx,nmtx))
          if (peinf%inode .eq. 0) then
            call read_eps_matrix_ser_hdf5(eps,nmtx,irq,1,filenameh5)
          endif
#ifdef MPI
          call MPI_BCAST(eps(1,1),nmtx*nmtx,MPI_SCALAR,0,MPI_COMM_WORLD,mpierr)
#endif
          xct%epscol(1:nmtx,1:nmtx,irq+1) = eps(1:nmtx,1:nmtx)
          SAFE_DEALLOCATE(eps)
        else
          call read_eps_matrix_par_hdf5(xct%epscol(:,:,irq+1),xct%maxpe(peinf%inode+1),&
            xct%maxpet,xct%epsowni(:,peinf%inode+1),nmtx,irq,1,filenameh5)
        endif

      else
#endif
        SAFE_ALLOCATE(epscol, (nmtx))

        do jj=1,nmtx
          if (peinf%inode .eq. 0) then
            read(11) (epscol(ii),ii=1,nmtx)
            xct%epsdiag(jj,irq+1)=epscol(jj)
          endif
          if (xct%iwriteint .eq. 0) then
            if (peinf%inode .eq. 0) write(17) epscol(1:nmtx)
          else
#ifdef MPI
            call MPI_BCAST(epscol,nmtx,MPI_SCALAR,0,MPI_COMM_WORLD,mpierr)
#endif
            xct%epsown(jj)=(jj/peinf%npes)
            if (mod(jj,peinf%npes).ne.0) xct%epsown(jj) = xct%epsown(jj) +1
            iowner=mod(jj,peinf%npes)
            xct%epsowni(xct%epsown(jj),iowner+1)=jj
            if (xct%maxpe(iowner+1) .lt. xct%epsown(jj)) xct%maxpe(iowner+1) = xct%epsown(jj)
            
            if (xct%bLowComm) then
              xct%epscol(1:nmtx,jj,irq+1)=epscol(:)
            else
              if (iowner .eq. peinf%inode) then
                xct%epscol(1:nmtx,xct%epsown(jj),irq+1)=epscol(:)
              endif
            endif

          endif
        
        enddo

        SAFE_DEALLOCATE(epscol)
#ifdef HDF5
      endif
#endif

      if (xct%iwriteint .eq. 0 .and. peinf%inode.eq.0) then
        call close_file(17)
      endif

    enddo
    
    if (peinf%inode .eq. 0) then
      SAFE_DEALLOCATE(isrtold)
      SAFE_DEALLOCATE(ekold)
      SAFE_DEALLOCATE(oldg)
      if(.not. xct%use_hdf5) call close_file(11)
    endif
    
  endif
  
  SAFE_DEALLOCATE(eknq)

!-------------------------
! Generate full brillouin zone from irreducible wedge
! rq -> fq

  call timacc(7,1)
  call fullbz(crys,syms,qg,syms%ntran,skip_checkbz,wigner_seitz=.true.,paranoid=.true.)
  qshift(:)=0.0d0
  if (igamma.ne.0) then
    tmpfn='eps0mat'
  else
    tmpfn='epsmat'
  endif
  if (.not. skip_checkbz) then
    call checkbz(qg%nf,qg%f,qgrid,qshift,crys%bdot,tmpfn,'q',.true.,xct%freplacebz,xct%fwritebz)
  endif
  call timacc(7,2)
  
  if(peinf%inode.eq.0) then
    write(6,'(1x,a,i0,2x,a,f10.6)') 'nfq = ', qg%nf, 'qsz = ', qg%sz
#ifdef VERBOSE
    write(6,*)
    do ii=1,qg%nf
      write(6,'(i6,3f10.6)') ii, qg%f(:,ii)
    enddo
    write(6,*)
#endif
    write(6,*)
  endif
  
#ifdef MPI
  call MPI_Barrier(MPI_COMM_WORLD,mpierr)
  ! Doing the communication once here. Saves us a communication each time mtxel_kernel
  ! is called
  if (xct%bLowComm) then
    call MPI_BCAST(xct%isrtqi,gvec%ng*(nrq1+1),MPI_INTEGER,0,MPI_COMM_WORLD,mpierr)
  endif

  if (xct%use_hdf5 .and. .not. xct%bLowComm .and. xct%iwriteint .ne. 0) then
! XXX This should be ALL to ALL not ALL REDUCE
! XXX IT SHOULD ACTUALLY USE THE NEW matrix_diagonal ROUTINE INSTEAD
    xct%epsdiag=0D0
    SAFE_ALLOCATE(tempepsdiag, (xct%nmtxmax,nrq1+1))
    do ijk=1,xct%maxpe(peinf%inode+1)
      do irq=1,nrq1+1
        tempepsdiag(xct%epsowni(ijk,peinf%inode+1),irq)=xct%epscol(xct%epsowni(ijk,peinf%inode+1),ijk,irq)
      enddo
    enddo
    call MPI_ALLREDUCE(tempepsdiag(1,1),xct%epsdiag(1,1),xct%nmtxmax*(nrq1+1),MPI_SCALAR,MPI_SUM,MPI_COMM_WORLD,mpierr)
    SAFE_DEALLOCATE(tempepsdiag)
  else
    call MPI_BCAST(xct%epsdiag,xct%nmtxmax*(nrq1+1),MPI_SCALAR,0,MPI_COMM_WORLD,mpierr)
  endif
#endif
  
  if (xct%use_hdf5 .and. peinf%inode .eq. 0) then
    SAFE_DEALLOCATE(nmtx0_of_q)
    if (igamma.eq.0) then
      SAFE_DEALLOCATE(nmtx_of_q)
    endif
  endif
  
  POP_SUB(epscopy)
  
  return
end subroutine epscopy

subroutine tddft_bz_gen(crys,syms,qg,xct)

  use global_m
  use checkbz_m
  use fullbz_m
  use misc_m
  implicit none

  type (crystal), intent(in) :: crys
  type (symmetry), intent(in) :: syms
  type (grid), intent(out) :: qg
  type (xctinfo), intent(inout) :: xct

  real(DP) :: qshift(3)
  character :: tmpfn*16
  logical :: skip_checkbz
  integer :: ii
!-------------------------
! Generate full brillouin zone from irreducible wedge
! rq -> fq

  PUSH_SUB(tddft_bz_gen)
  call timacc(7,1)
  call fullbz(crys,syms,qg,syms%ntran,skip_checkbz,wigner_seitz=.true.,paranoid=.true.)
  qshift(:)=0.0d0
  tmpfn='tddft_q'

  if (.not. skip_checkbz) then
    call checkbz(qg%nf,qg%f,xct%qgrid,qshift,crys%bdot,tmpfn,'q',.true.,xct%freplacebz,xct%fwritebz)
  endif
  call timacc(7,2)
  
  if(peinf%inode.eq.0) then
    write(6,'(/,1x,a,i0,2x,a,f10.6)') 'nfq = ', qg%nf, 'qsz = ', qg%sz
#ifdef VERBOSE
    write(6,*)
    do ii=1,qg%nf
      write(6,'(i6,3f10.6)') ii, qg%f(:,ii)
    enddo
    write(6,*)
#endif
  endif
  POP_SUB(tddft_bz_gen)

  return
end subroutine tddft_bz_gen
