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

#include "f_defs.h"

module write_result_hp_m

  use global_m
  implicit none

  private
  public :: write_result_hp

contains

subroutine write_result_hp(kp,wfnk,sig,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) :: 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, ispin, iw, nstart, nend

  PUSH_SUB(write_result_hp)

  do ispin=1,sig%nspin
    
! Sigma Diagonal

    write(8,979) (kp%rk(j,ikn),j=1,3),ikn,sig%spin_index(ispin)
    if (sig%freq_dep .eq. -1 .or. &
       (sig%freq_dep .eq. 0 .and. sig%exact_ch .eq. 1) .or. &
       (sig%freq_dep .eq. 1 .and. 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(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)
    else
      write(8,976)
      write(8,975) (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), &
        dble(ach(2,i,ispin)),dble(asig(i,ispin)), &
        efsto(i,ispin),enew(i,ispin),zrenorm(i,ispin),i=1,sig%ndiag)
    endif
979 format(7x,"k =",3f10.6,1x,"ik =",i4,1x,"spin =",i2) 
978 format(/,3x,"n",8x,"elda",8x,"ecor",11x,"x",8x,"sx-x",10x,"ch", &
      9x,"sig",9x,"vxc",8x,"eqp0",8x,"eqp1",9x,"Znk")
977 format(i4,10f12.6)
976 format(/,3x,"n",8x,"elda",8x,"ecor",11x,"x",8x,"sx-x",10x,"ch", &
      9x,"sig",9x,"vxc",8x,"eqp0",8x,"eqp1",9x,"ch'",8x,"sig'", &
      7x,"eqp0'",7x,"eqp1'",9x,"Znk")
975 format(i4,14f12.6)
    
! Sigma Off-Diagonal

    if (sig%noffdiag.gt.0) then
      if (sig%fdf.eq.-1) then
        nstart = 1
        nend = 2
      elseif (sig%fdf.eq.0) then
        nstart = 1
        nend = 3
      elseif (sig%fdf.eq.1) then
        nstart = 2
        nend = 3
      else
        nstart = 2
        nend = 2
      endif
      do iw = nstart, nend
        if (iw.eq.1) write(8,951)
        if (iw.eq.2) write(8,952)
        if (iw.eq.3) write(8,953)
        if (sig%freq_dep .eq. -1 .or. &
           (sig%freq_dep .eq. 0 .and. sig%exact_ch .eq. 1) .or. &
           (sig%freq_dep .eq. 1 .and. sig%exact_ch .eq. 0)) then
          write(8,969) iw, iw, iw
          do i=sig%ndiag+1,sig%ndiag+sig%noffdiag
            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))
#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))
#endif
          enddo
        else
          write(8,966) iw, iw, iw, iw, iw
          do i=sig%ndiag+1,sig%ndiag+sig%noffdiag
            write(8,965) 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))
#ifdef CPLX
            write(8,964) 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)),IMAG(ach(iw,i,ispin)), &
              IMAG(ax(i,ispin)+asx(iw,i,ispin)+ach(iw,i,ispin))
#endif
          enddo
        endif
      enddo
    endif
951 format(/,3x,"e1 = ecor - de")
952 format(/,3x,"e2 = ecor")
953 format(/,3x,"e3 = ecor + de")
969 format(3x,"n",3x,"m",3x,"l",21x,"x",4x,"sx(e",i1,")-x",6x, &
      "ch(e",i1,")",5x,"sig(e",i1,")",9x,"vxc")
968 format(3i4,3x,"real",3x,5f12.6)
967 format(3i4,3x,"imag",3x,5f12.6)
966 format(3x,"n",3x,"m",3x,"l",21x,"x",4x,"sx(e",i1,")-x",6x, &
      "ch(e",i1,")",5x,"sig(e",i1,")",9x,"vxc",5x,"ch'(e",i1,")",4x, &
      "sig'(e",i1,")")
965 format(3i4,3x,"real",3x,7f12.6)
964 format(3i4,3x,"imag",3x,7f12.6)
    
    write(8,*)
    
  enddo ! ispin
  
  POP_SUB(write_result_hp)
  
  return
end subroutine write_result_hp

end module write_result_hp_m
