!===========================================================================
!
! Routines:
!
! (1) write_result_dyn()        Originally By ?         Last Modified 7/3/2008 (JRD)
!
!     Writes the quasiparticle spectrum to the output
!
!===========================================================================

#include "f_defs.h"

module write_result_dyn_m

  use global_m
  implicit none

  private
  public :: write_result_dyn

contains

subroutine write_result_dyn(kp,wfnk,sig,ach_n1,ax,asx,ach,ach_cor,achcor,asig,alda,efsto,ikn)
  type (kpoints), intent(in) :: kp
  type (wfnkstates), intent(in) :: wfnk
  type (siginfo), intent(in) :: sig
  complex(DPC), intent(in) :: ach_n1(:,:,:) !< (sig%ntband,sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: ax(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: asx(:,:,:) !< (sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: ach(:,:,:) !< (sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: ach_cor(:,:,:) !< (sig%nfreqeval,sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: achcor(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: asig(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: alda(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: efsto(:,:) !< (sig%ndiag,sig%nspin)
  integer, intent(in) :: ikn
  
  integer :: iw, i, j, ivbm, icbm, idis, ispin
  integer, allocatable :: iwlda(:)
  real(DP) :: sumvcor, sumccor, sumdcor, sumdconv, diff, diffmin, e_lk
  real(DP), allocatable :: sumv(:), sumc(:), sumd(:)
  complex(DPC) :: achconv

  PUSH_SUB(write_result_dyn)

  ! Initialization

  if (sig%fullConvLog .eq. 0) then
    SAFE_ALLOCATE(sumv, (sig%ntband))
    SAFE_ALLOCATE(sumc, (sig%ntband))
    SAFE_ALLOCATE(sumd, (sig%ntband))
    ivbm=0
    icbm=0
    do i = 1, sig%ndiag
      if (sig%diag(i).eq.sig%nvband) ivbm=i
      if (sig%diag(i).eq.sig%nvband+1) icbm=i
    enddo
  endif

  do ispin=1,sig%nspin

! Sigma Diagonal

    SAFE_ALLOCATE(iwlda, (sig%ndiag))

! JRD: Find iw closest to e_lk

    do i = 1, sig%ndiag
      diffmin = INF
      e_lk = wfnk%ek(sig%diag(i),ispin)
      do iw=1,sig%nfreqeval
        diff = abs(sig%freqevalmin + (iw-1)*sig%freqevalstep - e_lk)
        if (diff .lt. diffmin) then
          diffmin=diff
          iwlda(i)=iw
        endif
      enddo
    enddo

    call write_qp(6)
    call write_qp(7)

    SAFE_DEALLOCATE(iwlda)

! CH Convergence Log

    if (sig%fullConvLog .eq. 0) then
      
      write(127,'(a,3e16.8,a,i2)') '# k =',(kp%rk(j,ikn),j=1,3), &
        ' spin=',sig%spin_index(ispin)
      write(127,*) '# n1 ', &
        '<i|Sigma_ch|i> (eV), partial sum'
      write(127,*) '#      nbands   ch(vbm)          ch(cbm)', &
        '           diff        converged'
      
      if (ivbm.ne.0) then
        do j = 1, sig%ntband
          sumv(j) = ryd * sum(dble(ach_n1(1:j,ivbm,ispin)))
        enddo
        sumvcor = sumv(sig%ntband) + dble(achcor(ivbm,ispin))
      else
        do j = 1, sig%ntband
          sumv(j) = 0.0d0
        enddo
        sumvcor = 0.0d0
      endif
      if (icbm.ne.0) then
        do j = 1, sig%ntband
          sumc(j) = ryd * sum(dble(ach_n1(1:j,icbm,ispin)))
        enddo
        sumccor = sumc(sig%ntband) + dble(achcor(icbm,ispin))
      else
        do j = 1, sig%ntband
          sumc(j) = 0.0d0
        enddo
        sumccor = 0.0d0
      endif
      do j = 1, sig%ntband
        sumd(j) = sumc(j) - sumv(j)
      enddo
      sumdcor = sumccor - sumvcor
      
      if (sig%exact_ch.eq.0) then
        idis = sig%ntband / 10
        if (idis.gt.0) then
          sumdconv = (dble(sig%ntband) * sumd(sig%ntband) - &
            dble(sig%ntband - idis) * sumd(sig%ntband - idis)) / dble(idis)
        else
          sumdconv = 0.0d0
        endif
      else
        sumdconv = sumdcor
      endif
      
      do j = 1, sig%ntband
        write(127,'(i8,4e16.8)') j, sumv(j), sumc(j), sumd(j), sumdconv
      enddo
      
    elseif (sig%fullConvLog .eq. 1) then
      
      write(127,801) (kp%rk(j,ikn),j=1,3), ikn, sig%spin_index(ispin)
      write(127,802) sig%ndiag
      do i = 1, sig%ndiag
        write(127,803) sig%diag(i)
        if (sig%exact_ch.eq.0) then
          do j = 1, sig%ntband
            write(127,804) j, ryd * sum(dble(ach_n1(1:j,i,ispin)))
          enddo
        else
          achconv = achcor(i,ispin) + ryd * sum(ach_n1(1:sig%ntband,i,ispin))
          do j = 1, sig%ntband
            write(127,804) j, ryd * sum(dble(ach_n1(1:j,i,ispin))), dble(achconv)
          enddo
        endif
      enddo
      
    elseif (sig%fullConvLog .eq. 2) then
      
      write(127,801) (kp%rk(j,ikn),j=1,3), ikn, sig%spin_index(ispin)
      write(127,802) sig%ndiag
      do i = 1, sig%ndiag
        write(127,803) sig%diag(i)
        if (sig%exact_ch.eq.0) then
          do j = 1, sig%ntband
            write(127,804) j, ryd * sum(ach_n1(1:j,i,ispin))
          enddo
        else
          achconv = achcor(i,ispin) + ryd * sum(ach_n1(1:sig%ntband,i,ispin))
          do j = 1, sig%ntband
            write(127,804) j, ryd * sum(ach_n1(1:j,i,ispin)), achconv
          enddo
        endif
      enddo
      
    endif ! sig%fullConvLog
    
801 format('#',1x,'k =',3f10.6,1x,'ik =',i4,1x,'spin =',i2)
802 format(2x,'nbands',i5)
803 format(2x,'band =',i5)
804 format(i8,4e16.8)
    
  enddo ! ispin
  
  if (sig%fullConvLog .eq. 0) then
    SAFE_DEALLOCATE(sumv)
    SAFE_DEALLOCATE(sumc)
    SAFE_DEALLOCATE(sumd)
  endif
  
  POP_SUB(write_result_dyn)
  
  return

contains

  subroutine write_qp(iunit)
    integer, intent(in) :: iunit

    write(iunit,979) (kp%rk(j,ikn),j=1,3),ikn,sig%spin_index(ispin)
979 format(/,7x,"k =",3f10.6,1x,"ik =",i4,1x,"spin =",i2)

    write(iunit,978)
978 format(/,3x,"n",5x,"elda",5x,"ecor",8x,"x",2x,"re sx-x",4x, &
      "re ch",3x,"re sig",4x,"re cor",4x,"vxc",5x,"re eqp0", &
      /,33x,"im sx-x",4x,"im ch",3x,"im sig",4x,"im cor",12x,"im eqp0")

    write(iunit,977) (sig%diag(i),wfnk%elda(sig%diag(i),ispin), &
      wfnk%ek(sig%diag(i),ispin),dble(ax(i,ispin)),dble(asx(iwlda(i),i,ispin)), &
      dble(ach(iwlda(i),i,ispin)+achcor(i,ispin)),dble(asig(i,ispin)+achcor(i,ispin)),&
      dble(ach_cor(iwlda(i),i,ispin)+achcor(i,ispin)),dble(alda(i,ispin)), &
      dble(efsto(i,ispin)+achcor(i,ispin)),IMAG(asx(iwlda(i),i,ispin)), &
      IMAG(ach(iwlda(i),i,ispin)),IMAG(asig(i,ispin)),&
      IMAG(ach_cor(iwlda(i),i,ispin)),IMAG(efsto(i,ispin)),i=1,sig%ndiag)
977 format(i4,9f9.3,/,31x,4f9.3,9x,f9.3)

! Sigma Off-Diagonal

    if (sig%noffdiag.gt.0) then
      write(iunit,969)
969 format(/,3x,"n",3x,"m",3x,"l",18x,"x",5x,"sx-x",7x,"ch",6x,"sig",6x,"vxc")

      do i=sig%ndiag+1,sig%ndiag+sig%noffdiag
        iw=iwlda(sig%offmap(i-sig%ndiag, 3))

        write(iunit,968) sig%off1(i-sig%ndiag),sig%off2(i-sig%ndiag), &
          sig%off3(i-sig%ndiag),dble(ax(i,ispin)),dble(asx(iw,i,ispin)), &
          dble(ach(iw,i,ispin)+achcor(i,ispin)),dble(ax(i,ispin)+asx(iw,i,ispin)+ach(iw,i,ispin)+achcor(i,ispin)), &
          dble(alda(i,ispin))
968 format(3i4,3x,"real",3x,5f9.3)

#ifdef CPLX
        write(iunit,967) sig%off1(i-sig%ndiag),sig%off2(i-sig%ndiag), &
          sig%off3(i-sig%ndiag),IMAG(ax(i,ispin)),IMAG(asx(iw,i,ispin)), &
          IMAG(ach(iw,i,ispin)),IMAG(ax(i,ispin)+asx(iw,i,ispin)+ach(iw,i,ispin)), &
          IMAG(alda(i,ispin))
#else
        write(iunit,967) sig%off1(i-sig%ndiag),sig%off2(i-sig%ndiag), &
          sig%off3(i-sig%ndiag),0.0d0,IMAG(asx(iw,i,ispin)), &
          IMAG(ach(iw,i,ispin)+achcor(i,ispin)),IMAG(asx(iw,i,ispin)+ach(iw,i,ispin)+achcor(i,ispin)), &
          0.0d0
#endif
967 format(3i4,3x,"imag",3x,5f9.3)
      enddo
    endif

  end subroutine write_qp

end subroutine write_result_dyn

end module write_result_dyn_m
