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

#include "f_defs.h"

module write_result_m

  use global_m
  implicit none

  private
  public :: write_result

contains

subroutine write_result(kp,wfnk,sig,ach_n1,ax,asx,ach,achcor,asig,alda,efsto,enew, &
  zrenorm,ikn)
  type (kpoints), intent(in) :: kp
  type (wfnkstates), intent(in) :: wfnk
  type (siginfo), intent(in) :: sig
  SCALAR, intent(in) :: ach_n1(:,:,:) !< (sig%ntband,sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: ax(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: asx(:,:,:) !< (nfreqgpp,sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: ach(:,:,:) !< (nfreqgpp,sig%ndiag+sig%noffdiag,sig%nspin)
  complex(DPC), intent(in) :: achcor(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: asig(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  SCALAR, intent(in) :: alda(:,:) !< (sig%ndiag+sig%noffdiag,sig%nspin)
  real(DP), intent(in) :: efsto(:,:) !< (sig%ndiag,sig%nspin)
  real(DP), intent(in) :: enew(:,:) !< (sig%ndiag,sig%nspin)
  real(DP), intent(in) :: zrenorm(:,:) !< (sig%ndiag,sig%nspin)
  integer, intent(in) :: ikn

  integer :: i, j, ivbm, icbm, idis, ispin, iw
  real(DP) :: sumvcor, sumccor, sumdcor, sumdconv, eval
  real(DP), allocatable :: sumv(:), sumc(:), sumd(:)
  SCALAR :: achconv
  
! Initialization
  
  PUSH_SUB(write_result)
  
  if (sig%freq_dep /= -1 .and. 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

    if (sig%fdf .eq. -3) then
      do i=1, sig%ndiag
          do iw=1,sig%nfreqeval
            eval = sig%freqevalmin + (iw-1)*sig%freqevalstep
            write(8000,2000) kp%rk(:,ikn), ispin, i, iw, eval, dble(asx(iw,i,ispin)), & 
                          dble(ach(iw,i,ispin))+dble(achcor(i,ispin)), & 
                          dble(asx(iw,i,ispin)+ax(i,ispin)+ach(iw,i,ispin))+dble(achcor(i,ispin))
          enddo
          write(8000,*) ''
      enddo
    endif

2000 format(3F12.5,2x,3i4,2x,4F12.5)

    call write_qp(6)
    call write_qp(7)

! CH Convergence Log

    if(sig%freq_dep .ne. -1 .and. .not. (sig%freq_dep .eq. 0 .and. sig%exact_ch .eq. 1)) then
      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%freq_dep .eq. 1 .and. 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%freq_dep .eq. 1 .and. 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 = SCALARIFY(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%freq_dep .eq. 1 .and. 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 = SCALARIFY(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
    endif ! sig%freq_dep

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 .and. sig%freq_dep .ne. 0) then
    SAFE_DEALLOCATE(sumv)
    SAFE_DEALLOCATE(sumc)
    SAFE_DEALLOCATE(sumd)
  endif

  POP_SUB(write_result)

  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",5x,"sx-x",7x,"ch", &
      6x,"sig",6x,"vxc",5x,"eqp0",5x,"eqp1",6x,"Znk")

! JRD: Not ideal for fdf -3, but user should see spectrum.dat
    write(iunit,977) (sig%diag(i),wfnk%elda(sig%diag(i),ispin), &
      wfnk%ek(sig%diag(i),ispin),dble(ax(i,ispin)),dble(asx(2,i,ispin)), &
      dble(ach(2,i,ispin)+achcor(i,ispin)),dble(asig(i,ispin)+achcor(i,ispin)), &
      dble(alda(i,ispin)),efsto(i,ispin)+dble(achcor(i,ispin)), &
      enew(i,ispin)+dble(achcor(i,ispin))*zrenorm(i,ispin), &
      zrenorm(i,ispin),i=1,sig%ndiag)
977 format(i4,10f9.3)
    
! Sigma Off-Diagonal

! JRD: Not ideal for fdf -3, but user should see spectrum.dat
    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
        write(iunit,968) sig%off1(i-sig%ndiag),sig%off2(i-sig%ndiag), &
          sig%off3(i-sig%ndiag),dble(ax(i,ispin)),dble(asx(2,i,ispin)), &
          dble(ach(2,i,ispin)+achcor(i,ispin)), &
          dble(ax(i,ispin)+asx(2,i,ispin)+ach(2,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(2,i,ispin)), &
          IMAG(ach(2,i,ispin)+achcor(i,ispin)), &
          IMAG(ax(i,ispin)+asx(2,i,ispin)+ach(2,i,ispin)+achcor(i,ispin)), &
          IMAG(alda(i,ispin))
967 format(3i4,3x,"imag",3x,5f9.3)
#endif
      enddo
    endif

  end subroutine write_qp

end subroutine write_result

end module write_result_m
