!===========================================================================
!
! Routines()
!
! (1) shiftenergy()     Originally by ?         Last Edited: 5/12/2008 (JRD)
!
!     Computes and symmetrizes the quasiparticle spectrum
!
!===========================================================================

#include "f_defs.h"

subroutine shiftenergy(sig,wfnk,alda,asx,ach,achcor,ax,efsto,asig,enew,zrenorm,&
                       nfreqgpp)

  use global_m
  implicit none

  type (siginfo), intent(in) :: sig
  type (wfnkstates), intent(in) :: wfnk
  integer, intent(in) :: nfreqgpp
  SCALAR, intent(inout) :: & 
    alda(sig%ndiag+sig%noffdiag,sig%nspin), & !< vxc
    asx(nfreqgpp,sig%ndiag+sig%noffdiag,sig%nspin), & !< sx
    ach(nfreqgpp,sig%ndiag+sig%noffdiag,sig%nspin)    !< ch
  complex(DPC), intent(inout) :: achcor(sig%ndiag+sig%noffdiag,sig%nspin) !< static remainder
  SCALAR, intent(inout) :: ax(sig%ndiag+sig%noffdiag,sig%nspin) !< x
  real(DP), intent(out) :: efsto(sig%ndiag,sig%nspin) !< eqp0
  SCALAR, intent(inout) :: asig(sig%ndiag+sig%noffdiag,sig%nspin) !< sig
  real(DP), intent(out) :: enew(sig%ndiag,sig%nspin)  !< eqp1
  real(DP), intent(out) :: zrenorm(sig%ndiag,sig%nspin) !< Znk

  integer :: ii,jj,istart,istop,nl,iflag,ispin
  integer, allocatable :: ndeg(:)
  real(DP) :: fact,dek,dele
  SCALAR :: aldai,axi
  SCALAR, allocatable :: asigi(:),asxi(:),achi(:)
  complex(DPC) :: achcori
  
  PUSH_SUB(shiftenergy)
  
  SAFE_ALLOCATE(ndeg, (sig%ntband))
  SAFE_ALLOCATE(asigi, (nfreqgpp))
  SAFE_ALLOCATE(asxi, (nfreqgpp))
  SAFE_ALLOCATE(achi, (nfreqgpp))

  do ispin=1,sig%nspin
    
    nl=1
    ndeg(nl)=1
    do ii=2,sig%ndiag
      iflag=0
      dek = wfnk%elda(sig%diag(ii),ispin) - wfnk%elda(sig%diag(ii-1),ispin)
      if(abs(dek) .lt. sig%tol) iflag=1
      if (iflag.eq.0) nl=nl+1
      if (iflag.eq.0) ndeg(nl)=1
      if (iflag.eq.1) ndeg(nl)=ndeg(nl)+1
    enddo
    
    istop = 0
    do ii=1,nl
      istart = istop + 1
      istop = istart + ndeg(ii) - 1
      aldai = ZERO
      axi = ZERO
      asxi = ZERO
      achi = ZERO
      achcori = (0.0d0, 0.0d0)
      do jj=istart,istop
        aldai = aldai + alda(jj,ispin)
        axi = axi + ax(jj,ispin)
        asxi(:) = asxi(:) + asx(:,jj,ispin)
        achi(:) = achi(:) + ach(:,jj,ispin)
        achcori = achcori + achcor(jj,ispin)
      enddo
      
      fact = ryd / dble(ndeg(ii))
      do jj=istart,istop
        alda(jj,ispin) = aldai * fact
        ax(jj,ispin) = axi * fact
        asx(:,jj,ispin) = asxi(:) * fact
        ach(:,jj,ispin) = achi(:) * fact
        achcor(jj,ispin) = achcori * fact
        asigi(:) = ax(jj,ispin) + asx(:,jj,ispin) + ach(:,jj,ispin)
! JRD. Not ideal for fdf -3, but user should see spectrum.dat
        asig(jj,ispin) = asigi(2)

! Correcting Eqp [Eq. (37) of Hybertsen & Louie PRB]
! by Murilo (Aug 11, 2000)

        efsto(jj,ispin) = wfnk%elda(sig%diag(jj),ispin) - &
          alda(jj,ispin) + asig(jj,ispin)
        dele = efsto(jj,ispin) - wfnk%ek(sig%diag(jj),ispin)

! SIB:  It seems silly to have the if below.  If we really
! believe that Sigma is a linear function of energy (which
! is assumed by doing the correction to efsto), then using
! both -dw (asig1) and +dw (asig3) is pointless.
!
!            if (dele.gt.0.0d0) enew(jj,ispin) = efsto(jj,ispin)
!     >       +(asig3-asig2)/( sig%dw-asig3+asig2)*dele
!            if (dele.le.0.0d0) enew(jj,ispin) = efsto(jj,ispin)
!     >       +(asig1-asig2)/(-sig%dw-asig1+asig2)*dele
!
! gsm: Instead, let`s use either -dw (asig1) or +dw (asig3)
! or both depending on the value of sig%fdf.  This allows
! us to skip either iw=1 or iw=3 in subroutine mtxel_sxch.

        if (sig%fdf.eq.-1) then
          enew(jj,ispin) = efsto(jj,ispin) + &
            (asigi(2)-asigi(1))/(sig%dw-asigi(2)+asigi(1))*dele
          zrenorm(jj, ispin) = 1d0 / (1d0 - (asigi(2) - asigi(1))/sig%dw)
        elseif (sig%fdf.eq.0) then
          enew(jj,ispin) = efsto(jj,ispin) + &
            (asigi(3)-asigi(1))/(2.0d0*sig%dw-asigi(3)+asigi(1))*dele
          zrenorm(jj, ispin) = 1d0 / (1d0 - (asigi(3) - asigi(1))/(2d0 * sig%dw))
        elseif (sig%fdf.eq.1.or.sig%fdf.eq.2) then
          enew(jj,ispin) = efsto(jj,ispin) + &
            (asigi(3)-asigi(2))/(sig%dw-asigi(3)+asigi(2))*dele
          zrenorm(jj, ispin) = 1d0 / (1d0 - (asigi(3) - asigi(2))/sig%dw)
        else
          enew(jj,ispin) = efsto(jj,ispin)
          zrenorm(jj, ispin) = 1d0
        endif

      enddo ! jj
    enddo ! ii
  enddo ! ispin

  SAFE_DEALLOCATE(ndeg)
  SAFE_DEALLOCATE(asigi)
  SAFE_DEALLOCATE(asxi)
  SAFE_DEALLOCATE(achi)
  SAFE_DEALLOCATE(ndeg)
  
  POP_SUB(shiftenergy)
  
  return
end subroutine shiftenergy
