! ************************************************************* 
!
!   This is a software package CIAO
!
!     developed as a part of the national project "Research and 
!     Development of Innovative Simulation software",which is   
!     supported by the next-generation IT program of MEXT of Japan
!
!   Version history: 
!
!     4.0:  2013/03/01
!           codes for spin-polarized pseudopotential generation are added
!     4.1:  2013/11/22 - 
!           Info of core wfns and energy contributions can be added to gncpp2
!     4.2:  2014/07/23 - 
!           gncpp2 can be geregated even when nmesh /= 1501
!
! ************************************************************* 
!
!  Software name : CIAO (Code for Investigating Atomic Orbitals)
!  Subroutine(s) : calc_etot, write_etot
!  Author(s)     : Masakuni Okamoto (August 25, 2003)
!
!
!  Contact address :  Phase System Consortium
!                     E-mail: phase_system@nims.go.jp URL https://azuma.nims.go.jp
!
!
!  The license of the code and contact address :
!  See the files, COPYRIGHT and LICENSE (or LICENSE_J.pdf)
!
!=====================================================================
   subroutine calc_etot(ier)
!=====================================================================
!
!  Calculates total energy
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ir, ishell, ispin, ll, ll_core
   real(8) :: r
   ier    =  0
   eband_sum = 0.d0
   do ishell = 1,nshell
      if (is_solve(ishell) == 0) then
         cycle
      end if
      eband_sum = eband_sum + focc(ishell) * engy(ishell)
   end do
   if (is_calc /= REL) then
   ekin_sum1 = 0.d0
   do ishell = 1,nshell
      if (is_solve(ishell) == 0) then
         cycle
      end if
      do ir = 1,nmesh
         ll = l_qnum(ishell)
         r  = rpos(ir)
         ekin_sum1 = ekin_sum1 + focc(ishell) &
            * 0.5d0*wr(ir) &
            *( (dxchi_g(ir,ishell)/r)**2 &
               + dble(ll*(ll+1))*(chi_g(ir,ishell)/r)**2 )
      end do
   end do
   else
   ekin_sum1 = 0.d0
   do ishell = 1,nshell
      if (is_solve(ishell) == 0) then
         cycle
      end if
      do ir = 1,nmesh
         ll = l_qnum(ishell)
         r  = rpos(ir)
         ekin_sum1 = ekin_sum1 + focc(ishell) &
            * 0.5d0*wr(ir) &
            *( (dxchi_g(ir,ishell)/r)**2 &
               + dble(ll*(ll+1))*(chi_g(ir,ishell)/r)**2 &
             + (dxchi_f(ir,ishell)/r)**2 &
               + dble(ll*(ll+1))*(chi_f(ir,ishell)/r)**2 )   
      end do
   end do
   end if
   eion_sum = 0.d0
   do ishell = 1,nshell
      ll = l_qnum(ishell)
      if (is_core == PATOM) then
         ll_core = ll
      else
         ll_core = lmax_core
      end if
      select case (is_calc)
      case (NONREL,SREL)
         do ir = 1,nmesh
            eion_sum = eion_sum &
               + wr(ir) * focc(ishell) &
               * chi_g(ir,ishell)**2 * vion(ir,ll_core)
         end do
      case (REL)
         do ir = 1,nmesh
            eion_sum = eion_sum &
               + wr(ir) * focc(ishell) * vion(ir,ll_core) &
               * (chi_g(ir,ishell)**2 + chi_f(ir,ishell)**2)
         end do
      end select
   end do
   eh_sum = 0.d0
   do ispin = 1,nspin
   do ir = 1,nmesh
      r = rpos(ir)
      eh_sum = eh_sum &
             + 2.d0*PI*r*r*wr(ir)*rho(ir,ispin)*vh(ir)
   end do
   end do
   select case (is_xc)
   case (LDAPW92_GNCPP, GGAPW91_F90, GGAPW91_F77, &
         GGAPBE96_GNCPP, GGAPBE96_KATO, &
         GGAPBE96_MOMO2)
   case default
   ex_sum = 0.d0
   ec_sum = 0.d0
   do ispin = 1,nspin
   do ir = 1,nmesh
      r = rpos(ir)
      ex_sum  = ex_sum &
              + 4.d0*PI*r*r*wr(ir)*rho(ir,ispin)*ex(ir)
      ec_sum  = ec_sum &
              + 4.d0*PI*r*r*wr(ir)*rho(ir,ispin)*ec(ir)
   end do
   end do
   end select
   exc_sum = ex_sum + ec_sum
   vx_sum  = 0.d0
   vc_sum  = 0.d0
   do ispin = 1,nspin
   do ir = 1,nmesh
      r = rpos(ir)
      vx_sum = vx_sum &
              + 4.d0*PI*r*r*wr(ir)*rho(ir,ispin)*vx(ir,ispin)
      vc_sum = vc_sum &
              + 4.d0*PI*r*r*wr(ir)*rho(ir,ispin)*vc(ir,ispin)
   end do
   end do
   vxc_sum  = vx_sum + vc_sum
   veff_sum = 0.d0
   do ishell = 1,nshell
      ispin = (1-spin(ishell))/2 + 1
      ll = l_qnum(ishell)
      if (is_core == PATOM) then
         ll_core = ll
      else
         ll_core = lmax_core
      end if
      select case (is_calc)
      case (NONREL,SREL)
         do ir = 1,nmesh
            veff_sum = veff_sum &
               + wr(ir) * focc(ishell) &
               * chi_g(ir,ishell)**2 * veff(ir,ispin,ll_core)
         end do
      case (REL)
         do ir = 1,nmesh
            veff_sum = veff_sum &
               + wr(ir) * focc(ishell) * veff(ir,ispin,ll_core) &
               * (chi_g(ir,ishell)**2 + chi_f(ir,ishell)**2)
         end do
      end select

   end do
   etot_sum1 = ekin_sum1 + eion_sum + eh_sum + ex_sum + ec_sum
   etot_sum2 = eband_sum - eh_sum &
             + (ex_sum + ec_sum - vx_sum - vc_sum)
   etot_sum  = etot_sum2
   ekin_sum2 = eband_sum - veff_sum
   ekin_sum  = ekin_sum2
   end subroutine calc_etot

!=====================================================================
   subroutine write_etot(ifile)
!=====================================================================
!
!  Writes total energy to ifile
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in) :: ifile
   integer        :: i
   character(100) :: line
   do i = 1,100
      line(i:i) = '-'
   end do
   write(ifile,*)
   write(ifile,*)  'etot  Total energy [All-electron]'
   write(ifile,10) line(1:100)
   write(ifile,11) 'Energy (Ha)','Energy (eV)'
   write(ifile,10) line(1:100)
   if (is_calc == NONREL) then
   write(ifile,20) 'Ekin  ',ekin_sum1,ekin_sum1*HARTREE
   else
   write(ifile,20) 'Ekin  ',ekin_sum ,ekin_sum*HARTREE
   end if
   write(ifile,20) 'Eion  ',eion_sum ,eion_sum *HARTREE
   write(ifile,20) 'Eh    ',eh_sum   ,eh_sum   *HARTREE
   write(ifile,20) 'Exc   ',exc_sum  ,exc_sum  *HARTREE
   write(ifile,10) line(1:100)
   if (is_calc == NONREL) then
   write(ifile,20) 'Ekin* ',ekin_sum2,ekin_sum2*HARTREE
   end if
   write(ifile,20) 'Ex    ',ex_sum   ,ex_sum   *HARTREE
   write(ifile,20) 'Ec    ',ec_sum   ,ec_sum   *HARTREE
   write(ifile,20) 'Vx    ',vx_sum   ,vx_sum   *HARTREE
   write(ifile,20) 'Vc    ',vc_sum   ,vc_sum   *HARTREE
   write(ifile,20) 'Vxc   ',vxc_sum  ,vxc_sum  *HARTREE
   write(ifile,20) 'Eband ',eband_sum,eband_sum*HARTREE
   write(ifile,10) line(1:100)
   if (is_calc == NONREL) then
   write(ifile,20) 'Etot  ',etot_sum1,etot_sum1*HARTREE
   write(ifile,20) 'Etot* ',etot_sum2,etot_sum2*HARTREE
   else
   write(ifile,20) 'Etot  ',etot_sum ,etot_sum *HARTREE
   end if
   write(ifile,10) line(1:100)
   if (is_calc == NONREL) then
   write(ifile,*)  'etot  Ekin* = Eband - Veff = Eband - Eion - 2Eh - Vxc'
   write(ifile,*)  'etot  Etot  = Ekin + Eion + Eh + Exc'
   write(ifile,*)  'etot  Etot* = Eband - Eh + (Exc - Vxc)'
   else
   write(ifile,*)  'etot  Ekin = Eband - Veff = Eband - Eion - 2Eh - Vxc'
   write(ifile,*)  'etot  Etot = Eband - Eh + (Exc - Vxc)'
   end if
10 format(1x,'etot',a50)
11 format(1x,'etot',2x,6x,2(9x,a11))
20 format(1x,'etot',2x,a6,2(f20.10))
   end subroutine write_etot
