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

#include "f_defs.h"

module write_result_dyn_hp_m

  use global_m
  implicit none

  private
  public :: write_result_dyn_hp

contains

subroutine write_result_dyn_hp(kp,wfnk,sig,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
  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, ispin
  integer, allocatable :: iwlda(:)
  real(DP) :: diff, diffmin, e_lk
  
  PUSH_SUB(write_result_dyn_hp)

  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

    write(8,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)
    
    if(sig%exact_ch .eq. 0) then
      write(8,978)
      write(8,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)),dble(asig(i,ispin)),dble(ach_cor(iwlda(i),i,ispin)),dble(alda(i,ispin)), &
        dble(efsto(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)
978   format(/,3x,"n",8x,"elda",8x,"ecor",11x,"x",5x,"re sx-x",7x, &
        "re ch",6x,"re sig",9x,"re cor",5x,"vxc",5x,"re eqp0", &
        /,45x,"im sx-x",7x,"im ch",6x,"im sig",4x,"im cor",17x,"im eqp0")
977   format(i4,9f12.6,/,40x,4f12.6,12x,f12.6)
    else         
      write(8,980)
      write(8,981) (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)),dble(ach(iwlda(i),i,ispin)),dble(asig(i,ispin)),&
        dble(ach_cor(iwlda(i),i,ispin)),dble(efsto(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)
980   format(/,3x,"n",8x,"elda",8x,"ecor",11x,"x",5x,"re sx-x",7x, &
        "re ch",6x,"re sig",4x,"re cor",5x,"vxc",10x,"re eqp0",6x,"re ch'",5x,"re sig'",5x,"re cor'",4x,"re eqp0'", &
        /,45x,"im sx-x",7x,"im ch",6x,"im sig",4x,"im cor",18x,"im eqp0")
981   format(i4,13f12.6,/,40x,4f12.6,12x,f12.6)
    endif

! Sigma Off-Diagonal

    if (sig%noffdiag.gt.0) then
      if(sig%exact_ch == 0) then
        write(8,969)
      else
        write(8,970)
      endif
      do i=sig%ndiag+1,sig%ndiag+sig%noffdiag
        iw=iwlda(sig%offmap(i-sig%ndiag, 3))
        if (sig%exact_ch .eq. 0) then
          write(8,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))
        else
          write(8,971) 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)), dble(ach(iw,i,ispin)), dble(ax(i,ispin)+asx(iw,i,ispin)+ach(iw,i,ispin))
        endif
#ifdef CPLX
        write(8,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)+achcor(i,ispin)),IMAG(ax(i,ispin)+asx(iw,i,ispin)+ach(iw,i,ispin)+achcor(i,ispin)), &
          IMAG(alda(i,ispin))
#else
972 format(3i4,3x,"imag",3x,7f12.6)
        write(8,972) 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
      enddo
    endif
969 format(/,3x,"n",3x,"m",3x,"l",21x,"x",8x,"sx-x",10x,"ch",9x, &
      "sig",9x,"vxc")
968 format(3i4,3x,"real",3x,5f12.6)
967 format(3i4,3x,"imag",3x,5f12.6)
971 format(3i4,3x,"real",3x,7f12.6)
970 format(/,3x,"n",3x,"m",3x,"l",21x,"x",8x,"sx-x",10x,"ch",9x, &
      "sig",9x,"vxc",9x,"ch'",8x,"sig'")
    
    SAFE_DEALLOCATE(iwlda)
    
    write(8,*)
    
  enddo ! ispin
  
  POP_SUB(write_result_dyn_hp)
  
  return
end subroutine write_result_dyn_hp

end module write_result_dyn_hp_m
