!==============================================================================
!
! Module:
!
! (1) vcoul_generator()     Originally by JRD   Last Modified: 06/21/2013 (FHJ)
!
!     Generates the (Truncated) Coulomb Interaction for all G at a particular
!     q.  Outputs what would be 8Pi/q^2 if not for truncation.
!
!==============================================================================

#include "f_defs.h"

module vcoul_generator_m

  use global_m
  use minibzaverage_m
  use random_m
  use trunc_cell_box_m
  use trunc_cell_box_d_m

  implicit none

  private

  public ::          &
    vcoul_generator, &
    destroy_qran

  real(DP), allocatable, private :: qran(:,:)
  integer, private :: ifirst = 1

contains

  !> FHJ: Calculates the (average) bare Coulomb interaction v(q+G) in Rydberg.
  !! This function uses different forms of v(q+G) (see below) depending on the
  !! dimensionality of the system and whether the potential is truncated. The
  !! Coulomb interaction is optionally averaged on the mini-BZ around the q
  !! vector, and the average screened interaction wcoul0 is also calculated for
  !! q->0 and G=0.
  !!
  !! Note: we use a special flag, peinf%jobtypeeval, to determine whether
  !! vcoul_generator should be a "dumb generator" (if jobtypeeval=0) or 
  !! "smart consumer" (if 1). The main reasons for this division are the following:
  !! 1) For sigma and absorption, the idea is that we are evaluating the
  !! "best estimate" for W(q=0) and v(q=0) for a given k-grid, using the known
  !! analytical limits for epsinv and performing a Monte Carlo integration to
  !! evaluate quantities such as <1/q^2>. Epsilon is always calculated with a
  !! finite but non-averaged v(q), and each program that calculates W determines
  !! if it`s necessary to performing such an averaging.
  !! 2) In sigma, we divide SX into (SX-X) + X, so we have to be consistent with
  !! the way we average the quantities v=<1/q^2> and w=<epsinv/q^2>. In particular,
  !! we "hack" v to make it consistent with W, otherwise the partition (SX-X) + X
  !! would not be correct for metals. We never perform these "hacks" on v(q) 
  !! if peinf%jobtypeeval=0.
  subroutine vcoul_generator(itruncflag, truncval, gvec, bdot, nfk, ncoul, &
    isrtq, iscreen, qvec, q0vec, vcoul, iwritecoul, iparallel, avgcut, &
    oneoverq, qgrid, epshead, work_scell, averagew, wcoul0, coulomb_mod)
    !> Truncation flag. The current supported options are:
    !! 0: No truncation (for 3D systems)
    !! 4: Wire truncation (for 1D systems)
    !! 5: Box truncation (for 0D systems)
    !! 6: Slab truncation (for 2D systems)
    integer, intent(in) :: itruncflag
    !> Used for spherical truncation only. 
    real(DP), intent(in) :: truncval(3) 
    !> G space containing the G-vectors used to calculate v(q+G)
    type (gspace), intent(in) :: gvec
    !> Metric of the reciprocal lattice
    real(DP), intent(in) :: bdot(3,3)
    !> FIXME This is used in 1D minibz average, and I`m not sure why!
    integer, intent(in) :: nfk
    !> Number of G vectors to calculate v(q+G)
    integer, intent(in) :: ncoul
    !> (ncoul) Indices of the G vectors from gvec which we are using to build v(q+G)
    integer, intent(in) :: isrtq(:)
    !> Screening type. 0 for semiconductor, 1 for graphene, 2 for metal
    integer, intent(in) :: iscreen
    !> The q vector that we use to calculate v(q+G).
    !! The null vector q=(/0,0,0/) is perfectly valid here.
    real(DP), intent(in) :: qvec(3)
    !> The q0 vector that was used in eps0mat, which can never be the null vector.
    real(DP), intent(in) :: q0vec(3)
    !> (ncoul) The output, 8*pi*<1/(q+G)^2> if there`s no truncation.
    real(DP), intent(out) :: vcoul(:)
    !> Write vcoul to a file?
    integer, intent(in) :: iwritecoul
    !> FIXME Not sure what 0 really means if you use MPI!
    integer, intent(in) :: iparallel
    !> If |q+G|^2 < avgcut, calculate <1/(q+G)^2>. Otherwise, calculate 1/(q+G)^2.
    !! The default value for avgcut is TOL_SMALL, i.e., average only done if G=0.
    real(DP), intent(in) :: avgcut
    !> Returns <1/q> or 1/q0
    real(DP), intent(out) :: oneoverq
    !> The q/k-grid being used, which determined the mini-BZ used to construct
    !! averages such as <1/(q+G)^2>
    integer, intent(in) :: qgrid(3)
    !> Head of epsilon^{-1}. Used to construct wcoul0.
    SCALAR, intent(in) :: epshead 
    !> FIXME A mysterious working buffer for "supercell box truncation"
    type (twork_scell), intent(inout) :: work_scell
    !! If .true., calculate W as <eps*v(q)>
    logical, intent(in) :: averagew
    !> If averagew==.true., wcoul0 is <epsinv*v(q)>. We use the analytical limit of
    !! epsinv(q->0) to perform the proper average. Examples:
    !! - For 3D semiconductors, epsinv(q->0)~const => wcoul0 = epsinv*vcoul(0)
    !! - For 3D metals, epsinv(q->0)~q^2 => wcoul0 = epsinv*8*pi/q0^2, where q0 is
    !! the same q used to evaluate epsinv(q->0).
    SCALAR, intent(inout) :: wcoul0
    !> Optional coulomb modifier parameters. Used in TDDFT and hybrid functional calculations
    !! they allow one to change the bare coulomb interaction. Can only 
    !! be used with no truncation 
    type(coulomb_modifier_t), optional, intent(in) :: coulomb_mod

    integer :: i1, i2, i3, ii, jj, nn, ig, nint, iCommFlag, iCommFlagGlobal
    integer :: gk(3), seed
    real(DP), allocatable :: vcoul2(:)
    real(DP) :: dvalue, temp_exp, screeninv
    real(DP) :: qk(3), qkxy(3), qlen, q0len, ekinx, kxy
    real(DP) :: kz, zc, qkz(3), dummy, qvec_mod(3)
    real(DP) :: dd(3),fq(3),vlength, lmin, qpp(3) 
    real(DP), allocatable :: ran(:,:)
    real(DP), allocatable :: qran2(:,:)

    real(DP), save :: oneoverq0
    real(DP), save :: vcoul0
    !> Depending on avg_cut, the code needs to average the potential in the
    !! miniBZ. The following flag is set to true after we calculated <v(q)> for
    !! q->0, so we can reuse that integral later for q=0.
    logical, save :: minibz_done = .false.
    !> It there`s no truncation, we also need to calculate the average <1/q>
    !! for the wings. The following flag is set to true after we calculated
    !! <1/q> for q->0.
    logical, save :: oneoverq0_done = .false.
    !> Depending on avg_cut, the code needs to average the modified potential in the
    !! miniBZ. The following flag is set to true after we calculated <v(q)> for
    !! q->0 for the modified potential, so we can reuse that integral later for q=0.
    !! This is separate from minibz_done because you may need to recalculate vcoul 
    !! without the modifier for the exchange part of the kernel etc.
    logical, save :: minibz_mod_done = .false.
    logical :: verbose

    PUSH_SUB(vcoul_generator)

#ifdef VERBOSE
    verbose = .true.
#else
    verbose = .false.
#endif

    if(size(isrtq) < ncoul) call die("vcoul_generator: isrtq not allocated to size ncoul")
    if(size(vcoul) < ncoul) call die("vcoul_generator: vcoul not allocated to size ncoul")

    if(ifirst == 2) call die("you destroyed qran already!")
    if(nfk == 0) call die("Illegal value nfk = 0 in vcoul_generator")

    iCommFlag = 0
    iCommFlagGlobal = 0

    vcoul = 0d0

    nint=100

    qlen  = sqrt(DOT_PRODUCT(qvec,MATMUL(bdot,qvec)))
    q0len = sqrt(DOT_PRODUCT(q0vec,MATMUL(bdot,q0vec)))
    
! JRD: If we have a metal then the divergent components of W cancel
!      and you get a constant.  Epsilon was calculated at q ~ q0vec
! MJ:  Not quite. We while W goes to a constant, V does not. See the
!      comment below about metals. Here we set the q to be qvec (i.e.
!      0 0 0) but later make sure we change W to be evaluated at this
!      q. We change epsiloninv such that epsinv*V(q0vec) = epsnewinv*V(q)
!      where V(q) is the averaged quantity.

    if (abs(qlen) .lt. TOL_Zero .and. iscreen .eq. 2 .and. peinf%jobtypeeval .eq. 1 .and. itruncflag .ne. 0) then
      qvec_mod = q0vec
    else
      qvec_mod = qvec
    endif
    
!------------------------------------------------------------------
! Generate random numbers for minibz averaging

    nn = nmc

    if (peinf%jobtypeeval .eq. 1 .and. ifirst .eq. 1 .and. &
     (itruncflag .eq. 0 .or. itruncflag .eq. 6)) then

      if (any(qgrid(1:3) .eq. 0)) then
        if(peinf%inode == 0) then
          write(0,*) 'Error qgrid', qgrid
          write(0,*) 'You must specify qgrid in .inp file'
        endif
        call die ('Zero qgrid. Cannot determine minibz', only_root_writes = .true.)
      endif

      SAFE_ALLOCATE(ran, (3,nn))

      if (peinf%inode .eq. 0) then
!     We require a fixed seed for reproducibility of our 'random' numbers.
!     call date_and_time(VALUES=values)
!     seed=((values(3)*24+values(5))*60+values(6))*60+values(7)
        seed = 5000
        call genrand_init(put=seed)
        do jj = 1, 3*nn
          call genrand_real4(dummy)
        enddo
        do jj = 1, nn
          do ii = 1, 3
            call genrand_real4(ran(ii, jj))
          enddo
        enddo
      endif
      
#ifdef MPI
!   Our 'random' numbers must be the same on all processors.
      call MPI_Bcast(ran, 3*nn, MPI_REAL_DP, 0, MPI_COMM_WORLD,mpierr)
#endif
      
      dd(1:3) = 1D0 / dble(qgrid(1:3))

      SAFE_ALLOCATE(qran, (3,nn))
      
      qran = 0D0
      
      do jj = 1, nn
        
        if (iparallel .eq. 1) then
          if (mod(jj,peinf%npes).ne.peinf%inode) cycle
!            write(12000+peinf%inode,*) jj, ran(:,jj)
        endif
        
        lmin = INF
        qpp(:) = ran(:,jj)

        do i1 = -ncell+1, ncell
          fq(1) = qpp(1) - dble(i1)
          do i2 = -ncell+1, ncell
            fq(2) = qpp(2) - dble(i2)
            do i3 = -ncell+1, ncell
              fq(3) = qpp(3) - dble(i3)
              vlength = DOT_PRODUCT(fq,MATMUL(bdot,fq))
              if (vlength .lt. lmin) then
                lmin = vlength
                qran(:,jj) = fq(:)
              endif
            enddo
          enddo
        enddo

        qran(1:3,jj)=dd(1:3)*qran(1:3,jj)

      enddo ! jj

      SAFE_DEALLOCATE(ran)

#ifdef MPI
      if (iparallel .eq. 1) then
        SAFE_ALLOCATE(qran2, (3,nn))
        qran2(:,:)=0D0
        call MPI_ALLREDUCE(qran(1,1),qran2(1,1),3*nn,MPI_REAL_DP, MPI_SUM, MPI_COMM_WORLD,mpierr)
        qran(:,:)=qran2(:,:)
        SAFE_DEALLOCATE(qran2)
      endif
#endif

    endif

!-------------------------------------------------------------------
! No Truncation

    if (itruncflag .eq. 0 .and. (.not. present(coulomb_mod))) then

! Calculate Wing Correction Factor - this is not done for Epsilon and Kernel
! since avgcut is zero and qvec_mod is not

      if (peinf%inode .eq. 0 .and. qlen**2 .lt. avgcut .and. peinf%jobtypeeval .eq. 1) then
        if (qlen**2 .gt. TOL_Zero .or. .not.oneoverq0_done) then
          call minibzaverage_3d_oneoverq(nn,bdot,dvalue,qran,qvec_mod)
          oneoverq=dvalue
          if (qlen**2 .le. TOL_Zero) then
            oneoverq0=dvalue
            oneoverq0_done = .true.
          endif
        else
          oneoverq=oneoverq0
        endif
      endif
      ! otherwise we set oneoverq a little later

      do ig=1,ncoul
        if (iparallel .eq. 1) then
          if(mod(ig-1,peinf%npes).ne.peinf%inode) cycle
        endif
        
        gk(:)=gvec%components(:,isrtq(ig))
        qk(:)=gk+qvec_mod(:)
        ekinx=DOT_PRODUCT(qk,MATMUL(bdot,qk))

! We Do 3D Mini Brillouin Zone Average if q is exactly 0
! and G = 0. This should be the case when constructing W,
! but don`t want this in Epsilon code for example, where you
! have to use a finite Q.

        if ( ekinx .lt. avgcut .and. peinf%jobtypeeval .eq. 1 ) then
          if (iscreen .eq. 0) then ! semiconductor
            if (ekinx .gt. TOL_Zero .or. .not.minibz_done) then
              call minibzaverage_3d_oneoverq2(nn,bdot,dvalue,qran,qk,averagew,epshead,wcoul0)
              vcoul(ig)=dvalue
              if (ekinx .le. TOL_Zero) then
                vcoul0=dvalue
                iCommFlag = peinf%inode+1
                minibz_done = .true.
              endif
            else
              vcoul(ig)=vcoul0
            endif

          elseif (iscreen .eq. 1) then ! graphene
            
            if (ekinx .gt. TOL_Zero .or. .not.minibz_done) then
              call minibzaverage_3d_oneoverq2(nn,bdot,dvalue,qran,qk,averagew,epshead,wcoul0)

              if (ekinx .lt. TOL_ZERO) then
                vcoul0=dvalue
                call minibzaverage_3d_oneoverq(nn,bdot,dvalue,qran,qk)
                if (q0len .lt. TOL_ZERO) then
                  write(0,'(a)') 'You have q0vec=0 but a graphene-type system!!'
                  call die('Bad q0vec', only_root_writes = .true.)
                endif
                wcoul0=epshead*dvalue/q0len
                iCommFlag = peinf%inode+1
                minibz_done = .true.
                vcoul(ig)=vcoul0
              else
! JRD: This seems wrong. We now use correct vcoul average.
!              vcoul(ig)=dvalue/sqrt(ekinx)
              endif
            else
              vcoul(ig)=vcoul0
            endif

          elseif (iscreen .eq. 2) then
! MJ : W(q->0) goes to a constant. But the COH term (as well as the
!      Fock term) also require V(q->0). It is simpler to see this in the 
!      context of the COH term in COHSEX which is 0.5*(W-V). Setting V(q->0)
!      based on the q0vec is dangerous because it just adds a constant to all
!      the quasiparticle levels. So we keep both of these quantities
!      at hand. This is only needed in the Sigma code.
             ! write(0,'(a)') 'You want cell averaging on a metal!!'
             ! write(0,'(a)') 'Specify q0vec and cell averaging will automatically'
             ! write(0,'(a)') 'be done for vcoul. Wcoul will use the q0vec that you'
             ! write(0,'(a)') 'specify!!'
             ! call die('Bad Screening Options', only_root_writes = .true.)
            if (ekinx .gt. TOL_Zero .or. .not.minibz_done) then
              call minibzaverage_3d_oneoverq2(nn,bdot,dvalue,qran,qk,averagew,epshead,wcoul0)

!      Keep in mind that while the vcoul average out of minibzaverage_3d_oneoverq2
!      is correct, wcoul0 is not. wcoul0 is just modified so that when multiplied
!      by vcoul it gives the correct result.
              !if (abs(ekinx-q0len) .lt. TOL_Zero) then
              if (ekinx .lt. TOL_Zero) then
                vcoul0=dvalue
                !wcoul0=epshead*(q0len*q0len)/(dvalue/8.0/PI_D)
                wcoul0=epshead*8.0*PI_D/(q0len*q0len)
                iCommFlag = peinf%inode+1
                minibz_done = .true.
                vcoul(ig)=vcoul0
              endif
            else
              vcoul(ig)=vcoul0
            endif

          endif

        else if (ekinx .lt. Tol_zero) then

! We are not in an evaluation job and were sent q=0, we don`t average. We just zero. The outside code should
! do something about this value.

          vcoul(ig) = 0D0

        else

! For metal - we already changed qvec_mod to q0vec above

          vcoul(ig) = 8.0d0*PI_D/ekinx
        endif
      enddo

      if (qlen**2 .ge. avgcut) then
        oneoverq=vcoul(1)*qlen
      endif

#ifdef MPI
      if (iparallel .eq. 1) then
        call MPI_Bcast(oneoverq, 1, MPI_REAL_DP, 0, MPI_COMM_WORLD, mpierr)

        SAFE_ALLOCATE(vcoul2, (ncoul))
        vcoul2(:)=0.0d0
        call MPI_ALLREDUCE(vcoul,vcoul2,ncoul, &
          MPI_REAL_DP, MPI_SUM, MPI_COMM_WORLD,mpierr)
        call MPI_ALLREDUCE(iCommFlag,iCommFlagGlobal,1, &
          MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD,mpierr)
        if (iCommFlagGlobal .ne. 0) then
          minibz_done = .true.
          call MPI_BCAST(vcoul0,1,MPI_DOUBLE_PRECISION,iCommFlagGlobal-1, MPI_COMM_WORLD, mpierr)
          call MPI_BCAST(wcoul0,1,MPI_SCALAR,iCommFlagGlobal-1, MPI_COMM_WORLD, mpierr)
        endif
        vcoul(:)=vcoul2(:)
        SAFE_DEALLOCATE(vcoul2)
      endif
#endif

!--------------------------------------------------------------------
! Rectangular Box Truncation

    elseif (itruncflag .eq. 1) then
    
      call die('Rectangular Truncation is No Longer Supported', only_root_writes = .true.)
    
!------------------------------------------------------------------
! Spherical Truncation

    elseif (itruncflag .eq. 2 .and. (.not. present(coulomb_mod))) then
      
      do ig=1,ncoul
        qk(:)=gvec%components(:,isrtq(ig))+qvec_mod(:)
        ekinx=DOT_PRODUCT(qk,MATMUL(bdot,qk))
        if ( ekinx.lt.TOL_ZERO .and. peinf%jobtypeeval .eq. 1 ) then
          vcoul(ig)=8.0D0*PI_D*((truncval(1))**2)/2D0
        else if ( ekinx.lt.TOL_ZERO ) then
          vcoul(ig) = 0D0
        else
          vcoul(ig)=8.0d0*PI_D/ekinx* &
            (1.0d0-cos(truncval(1)*sqrt(ekinx)))
        endif
      enddo
      
      oneoverq=vcoul(1)*qlen
      wcoul0 = vcoul(1)


!------------------------------------------------------------------
! Cylindrical Box Truncation

    elseif (itruncflag .eq. 3) then

      call die('Cylindrical Truncation is No Longer Supported', only_root_writes = .true.)
      
!-----------------------------------------------------------------
! Cell Wire Truncation

    elseif (itruncflag .eq. 4) then
      
!    if (peinf%inode .eq. 0) then
!      write(6,*) 'Generating Vcoul_cell_wire with FFT'
!    endif

! JRD: This is hopefully temporary.  q=0 gives NaN
! because the log diverges in Eq. 5 of Ismail-Beigi paper.  
! For all G =/ 0, using the q0vec (small shifted vector) is 
! probably good enough.  
!
! JRD: This is now fixed in trunc_cell_wire where we use the scheme
! of Ismail-Beigi

      if (iparallel .eq. 1) then
        call trunc_cell_wire(gvec,verbose,peinf%inode, &
          peinf%npes,bdot,qvec_mod(3),ncoul,isrtq,vcoul)
      else
        call trunc_cell_wire(gvec,verbose,0, &
          1,bdot,qvec_mod(3),ncoul,isrtq,vcoul)
      endif

! We Do 1D Mini Brillouin Zone Average if q=0, G=0 or less than avgcut
! May not be implemented correctly for graphene-type system... I`m not even sure there is a system with linear DOS in 1D...

      if (iscreen .eq. 0) then ! semiconductor
        do ig=1,ncoul
          qk(:)=gvec%components(:,isrtq(ig))+qvec_mod(:)
          ekinx=DOT_PRODUCT(qk,MATMUL(bdot,qk))
          if ( ekinx .lt. avgcut .and. peinf%jobtypeeval .eq. 1) then 

            if (ekinx .gt. TOL_Zero .or. .not.minibz_done) then
              if (peinf%inode .eq. 0) then
                write(6,'(" minibz wire averaging for q =",3f8.3)') qk(1:3)
              endif
              call minibzaverage_1d(gvec,nfk,bdot,dvalue,iparallel,qk,epshead,q0len,averagew,wcoul0)
              vcoul(ig)=dvalue
              if (ekinx .lt. TOL_Zero) then
                vcoul0=dvalue
                minibz_done = .true.
              endif
            else
              vcoul(ig)=vcoul0
            endif
          else if (ekinx .lt. Tol_Zero) then
            vcoul(ig) = 0
          endif
        enddo
      endif

      if (peinf%inode .eq. 0) then
        write(6,*)
      endif

      oneoverq=vcoul(1)*qlen

!----------------------------------------------------------------
! Cell Box Truncation

    elseif (itruncflag .eq. 5) then
      
      if (qlen .gt. Tol_ZERO) then
        write(0,'(a)') 'You asked for cell box truncation but have more q-points than q=0!!'
        call die('Bad Truncation', only_root_writes = .true.)
      endif
      
      if (iparallel .eq. 1) then
        if (.not. present(coulomb_mod)) then
          call trunc_cell_box_d(gvec,verbose,peinf%inode, &
            peinf%npes,bdot,ncoul,isrtq,vcoul)
        endif
      else
        if (.not. present(coulomb_mod)) then
          call trunc_cell_box(gvec,verbose,bdot,ncoul,isrtq,vcoul)
        endif
      endif
      
      oneoverq=vcoul(1)*qlen
      wcoul0 = vcoul(1)

!----------------------------------------------------------------
! Cell Slab Truncation

! JRD: This is easy because an analytic expression exists.  See Sohrab.

    elseif (itruncflag .eq. 6) then
      
      if (abs(qvec_mod(3)) .gt. Tol_ZERO) then
        write(0,'(a)') 'You asked for cell slab truncation but have more q-points in z direction than qz=0!!'
        call die('Bad Truncation', only_root_writes = .true.)
      endif
      
      do ig=1,ncoul
        
        if (iparallel .eq. 1) then
          if(mod(ig,peinf%npes).ne.peinf%inode) cycle
        endif
        
        qk(:)=gvec%components(:,isrtq(ig))+qvec_mod(:)
        ekinx=DOT_PRODUCT(qk,MATMUL(bdot,qk))
        qkxy(1:2)=qk(1:2)
        qkxy(3)=0D0
        kxy=sqrt(DOT_PRODUCT(qkxy,MATMUL(bdot,qkxy)))
        qkz(1:2)=0D0
        qkz(3)=qk(3)
        kz=sqrt(DOT_PRODUCT(qkz,MATMUL(bdot,qkz)))
        zc=2D0*PI_D/(sqrt(bdot(3,3))*2D0)
        
!          write(6,*) "zc", zc

        if ( ekinx .lt. avgcut .and. peinf%jobtypeeval .eq. 1 ) then
          if (iscreen .ne. 2) then ! semiconductor or graphene
            if (ekinx .gt. TOL_Zero .or. .not.minibz_done) then
              call minibzaverage_2d_oneoverq2(nn,bdot, &
                dvalue,qran,qk,kz,zc,epshead,q0len,averagew,wcoul0)
              vcoul(ig)=dvalue
              if (ekinx .lt. TOL_Zero) then
                vcoul0=dvalue
                if (iscreen .eq. 1) then
                  wcoul0=vcoul0*epshead
                endif
                minibz_done = .true.
                iCommFlag=peinf%inode+1
              endif
            else
              vcoul(ig)=vcoul0
            endif
          else
            write(0,'(a)') 'You have q0vec=0 but a metal!!'
            call die('Bad Screening Options', only_root_writes = .true.)
          endif
        else if (ekinx .lt. Tol_Zero) then
          vcoul(ig) = 0D0
        else
          vcoul(ig) = 8.0d0*PI_D/ekinx
          vcoul(ig) = vcoul(ig)*(1.0d0-exp(-kxy*zc)*cos(kz*zc))
        endif
      enddo
      
#ifdef MPI
      if (iparallel .eq. 1) then
        SAFE_ALLOCATE(vcoul2, (ncoul))
        vcoul2(:)=0.d0
        call MPI_ALLREDUCE(vcoul,vcoul2,ncoul, &
          MPI_REAL_DP, MPI_SUM, MPI_COMM_WORLD,mpierr)
        vcoul(:)=vcoul2(:)
        SAFE_DEALLOCATE(vcoul2)
        call MPI_ALLREDUCE(iCommFlag,iCommFlagGlobal,1, &
          MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD,mpierr)
        if (iCommFlagGlobal .ne. 0) then
          minibz_done = .true.
          call MPI_BCAST(vcoul0,1,MPI_DOUBLE_PRECISION,iCommFlagGlobal-1, MPI_COMM_WORLD, mpierr)
          call MPI_BCAST(wcoul0,1,MPI_SCALAR,iCommFlagGlobal-1, MPI_COMM_WORLD, mpierr)
        endif
      endif
#endif
      
! This is wrong too?

      oneoverq=vcoul(1)*qlen

!----------------------------------------------------------------
! Supercell Box Truncation

    elseif (itruncflag .eq. 7) then
      
      if (iparallel .eq. 1) then
        call trunc_scell_box_d(gvec,.true.,peinf%inode,peinf%npes, &
          bdot,qvec_mod,qgrid,ncoul,isrtq,vcoul,work_scell)
      else
        call trunc_scell_box_d(gvec,.true.,0,1, &
          bdot,qvec_mod,qgrid,ncoul,isrtq,vcoul,work_scell)
      endif
      
      oneoverq=vcoul(1)*qlen
      wcoul0 = vcoul(1)
      
    endif

! Saving qran between calls
!      deallocate(qran)

!-----------------------------------------------------------------
! Print vcoul to file

    if (iwritecoul .eq. 1) then
      if (peinf%inode.eq.0) then
        do ig=1,ncoul
          write(19,'(3f12.8,1x,3i7,1x,e20.8)') &
            qvec_mod(:),gvec%components(:,isrtq(ig)),vcoul(ig)
        enddo
      endif
    endif

    ifirst = 0
    
    POP_SUB(vcoul_generator)
    
    return
  end subroutine vcoul_generator

!-----------------------------------------------------------------
  subroutine destroy_qran()

    PUSH_SUB(destroy_qran)

    ifirst = 2
    SAFE_DEALLOCATE(qran)

#ifdef VERBOSE
    if(peinf%inode == 0) write(6,'(a)') ' *** VERBOSE: Deallocated random numbers.'
#endif

    POP_SUB(destroy_qran)
    return
  end subroutine destroy_qran

end module vcoul_generator_m
