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

#include "f_defs.h"

subroutine shiftenergy_dyn(sig,wfnk,alda,asx,ach,ach_cor,ach_corb,ach2,achcor,ax, &
  efsto,asig,ikn,kp)

  use global_m
  implicit none

  type (siginfo), intent(in) :: sig
  type (wfnkstates), intent(in) :: wfnk
  SCALAR, intent(inout) :: alda(sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(inout) :: &
    asx(sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin), &
    ach(sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin), &
    ach_cor(sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin), &
    ach_corb(sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin), &
    ach2(sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin), &
    achcor(sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(inout) :: ax(sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(out) :: efsto(sig%ndiag,sig%nspin)
  complex(DPC), intent(inout) :: asig(sig%ndiag+sig%noffdiag,sig%nspin)
  integer, intent(in) :: ikn
  type (kpoints), intent(in) :: kp

  integer :: iwlda,iw
  integer :: ii,jj,istart,istop,nl,iflag,ispin
  integer, allocatable :: ndeg(:)
  real(DP) :: fact,dek,eval,diff,diffmin,e_lk
  real(DP) :: specsum(sig%nfreqeval)
  SCALAR :: aldai,axi
  complex(DPC) :: asxi(sig%nfreqeval), achi(sig%nfreqeval), asigt(sig%nfreqeval)
  complex(DPC) :: ach_cori(sig%nfreqeval)
  complex(DPC) :: ach_corbi(sig%nfreqeval)
  complex(DPC) :: asigt_cor(sig%nfreqeval)
  complex(DPC) :: asigt_corb(sig%nfreqeval)
  complex(DPC) :: ach2i(sig%nfreqeval), asigt2(sig%nfreqeval), achcori
  
! JRD: CHANGE THIS ROUTINE A----LOT!!! :) 

  PUSH_SUB(shiftenergy_dyn)

  SAFE_ALLOCATE(ndeg, (sig%ntband))
  
  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
    
    specsum = 0D0
    
    istop = 0
    do ii=1,nl
      istart = istop + 1
      istop = istart + ndeg(ii) - 1
      aldai =0.0d0
      axi =0.0d0
      asxi(:) = 0.0d0
      achi(:) = 0.0d0
      ach_cori(:) = 0.0d0
      ach_corbi(:) = 0.0d0
      ach2i(:) = 0.0d0
      achcori = 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)
        ach_cori(:) = ach_cori(:) + ach_cor(:,jj,ispin)
        ach_corbi(:) = ach_corbi(:) + ach_corb(:,jj,ispin)
        ach2i(:) = ach2i(:) + ach2(:,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
        ach_cor(:,jj,ispin) = ach_cori(:) * fact
        ach_corb(:,jj,ispin) = ach_corbi(:) * fact
        ach2(:,jj,ispin) = ach2i(:) * fact
        achcor(jj,ispin) = achcori * fact
        asigt(:) = ax(jj,ispin) + asx(:,jj,ispin) + ach(:,jj,ispin) + achcor(jj,ispin)
        asigt_cor(:) = ax(jj,ispin) + ach_cor(:,jj,ispin) + achcor(jj,ispin)
        asigt_corb(:) = ax(jj,ispin) + ach_corb(:,jj,ispin) + achcor(jj,ispin)
        asigt2(:) = ax(jj,ispin) + asx(:,jj,ispin) + ach2(:,jj,ispin) + achcor(jj,ispin)

! JRD: Find iw closest to e_lk
        
        diffmin = INF
        e_lk = wfnk%ek(sig%diag(jj),ispin)
        do iw=1,sig%nfreqeval
          diff = abs(sig%freqevalmin + (iw-1)*sig%freqevalstep - e_lk)
          if (diff .lt. diffmin) then
            diffmin=diff
            iwlda=iw
          endif
        enddo
        
!            write(6,*) 'ShiftEnergy - iwlda', j, e_lk, iwlda 

! gsm: asig shall not contain static remainder, it is added in write_result_dyn/write_result_dyn_hp
!            asig(jj,ispin) = asigt(iwlda) - achcor(jj,ispin)
        asig(jj,ispin) = ax(jj,ispin) + asx(iwlda,jj,ispin) + ach(iwlda,jj,ispin)

! JRD: Write out Sigma(omega)

        if (peinf%inode .eq. 0) then
          write(8000,2001) 
          do iw=1,sig%nfreqeval
            eval = sig%freqevalmin + (iw-1)*sig%freqevalstep
            if (IMAG(asigt(iw)) .gt. TOL_Zero) then
              write(0,'(a,3f12.6)') 'WARNING: You have a positive imaginary Sigma at k = ', kp%rk(:,ikn)
              write(0,'(a,i6,a,f12.6,a,2f12.6)') 'band calc ', jj, ', evaluation energy ', eval, ' : Im Sigma = ', IMAG(asigt(iw))
            endif
!                eval2 = wfnk%elda(sig%diag(jj),ispin) + dble(asigt(iw)) - alda(jj,ispin)
!
! CHP: spectral function is not very meaningful unless one knows the final Fermi energy
!      (i.e., after the GW correction) conserving the Fermi sphere volume. In practice,
!      one has to (1) read the calculated real part of the self energy, (2) find out
!      what is the new Fermi energy (manually), (3) subtract this value from the
!      real part of the self energies, (4) and calculate the spectral function.
!
!      Also, EQP(k,w) is not physical.  EQP is a function only of k which can
!      be obtained by solving EQP(k)=E0(k)+Re(Sig(k,EQP(k))).  This process is
!      straightforward once one knows Re(Sig(k,w)).
!
!      Printed energy is now with respect to the Fermi energy (sig%efermi).
!
!                spectral = (1D0/PI_D) * abs(IMAG(asigt(iw))) / ( (eval - eval2)**2 + IMAG(asigt(iw))**2)
!                specsum(iw) = specsum(iw) + spectral
!                write(8000,2000) kp%rk(:,ikn), ispin, sig%diag(jj), iw, eval, eval2, &
!                 dble(asigt(iw)),IMAG(asigt(iw)),spectral
            write(8000,2000) kp%rk(:,ikn), ispin, sig%diag(jj), iw, eval, &
              dble(asigt(iw)),IMAG(asigt(iw)),dble(asigt2(iw)),IMAG(asigt2(iw)), &
              dble(asigt_corb(iw)),IMAG(asigt_corb(iw)),dble(asigt_cor(iw)),IMAG(asigt_cor(iw))

! CHP: IM(asigt2) was obtained by using a zero energy broadening in the energy
!      denominator for the self energy evaluation.  Thus, IM(asigt2) vanishes
!      at the Fermi level, which is physically correct: the scattering rate of
!      a quasiparticle at the Fermi surface is zero.  However, (1) this routine
!      currently is meaningful only for systems having inversion symmetry
!      and (2) IM(asigt2) does not satisfy the Kramers-Kronig relation with
!      RE(asigt) for obvious reasons.

          enddo
          write(8000,*) ''
        endif
              

! 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)

      enddo ! jj
    enddo ! ii
  enddo ! ispin

!      if (peinf%inode .eq. 0) then
!        do iw = 1, sig%nfreqeval
!          eval = sig%freqevalmin + (iw-1)*sig%freqevalstep
!          write(8001,2002) kp%rk(:,ikn), eval, specsum(iw)
!        enddo
!          write(8001,*) ''
!      endif

! CHP: not to printout the spectral function

! 2000 format(3F12.5,2x,3i4,2x,7F12.5)
! 2001 format("#",6x,"kx",10x,"ky",10x,"kz",7x,"spn",1x,"bnd",2x,"iw",8x,"Ew",10x,"EQP", &
!      5x,"RE(SIGMA)",3x,"IM(SIGMA)",6x,"SPEC")
! 2002 format(3F12.5,2x,2F12.5)
2000 format(3F12.5,2x,3i4,2x,9F12.5)
 2001 format("#",6x,"kx",10x,"ky",10x,"kz",7x,"spn",1x,"bnd",2x,"iw",8x,"Ew", &
        6x,"RE(SIGMA)",3x,"IM(SIGMA)",2x,"RE(SIGMA2)",2x,"IM(SIGMA2)",2x,"RE(SIGMA3)",2x,"IM(SIGMA3)", &
        2x,"RE(SIGMA4)",2x,"IM(SIGMA4)")

  SAFE_DEALLOCATE(ndeg)

  POP_SUB(shiftenergy_dyn)

  return
end subroutine shiftenergy_dyn
