! ************************************************************* 
!
!   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
!
!   latest version: 
!
!     4.0:  2013/01/17 
!           codes for spin-polarized pseudopotential generation are added
!
! ************************************************************* 
!
!  Software name : CIAO (Code for Investigating Atomic Orbitals)
!  Subroutine(s) : sort_engy, set_focc, calc_efermi
!  Author(s)     : Masakuni Okamoto (August 25, 2003)
!
!  The license of the code and contact address :
!  See the files, COPYRIGHT and LICENSE (or LICENSE_J.pdf)
!
!=====================================================================
   subroutine sort_engy(ier)
!=====================================================================
!
!  Sorts energy levels
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ishell, jshell, imin
   ier = 0
   do ishell = 1,nshell
      list_shell(ishell) = ishell
   end do
   do ishell = 1,nshell-1
      imin = ishell
      do jshell = ishell+1,nshell
         if (engy(list_shell(jshell)) < engy(list_shell(imin))) then
            imin = jshell
         end if
      end do
      call iswap(list_shell(ishell),list_shell(imin))
   end do
99 continue
   end subroutine sort_engy

!=====================================================================
   subroutine set_focc(ier)
!=====================================================================
!
!  Sets focc
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ishell, lshell, nn, ll, ss, lspin
   real(8) :: ftot, sum
   ier = 0
   select case (is_spin_state)
   case (AUTOMATIC)
   foccnl_tmp(:,:,:) = foccnl(:,:,:)
   do ishell = 1,nshell
      lshell = list_shell(ishell)
      nn   = n_qnum(lshell)
      ll   = l_qnum(lshell)
      ftot = dble(nocc(lshell))
      if (ftot >= foccnl_tmp(nn,ll,1)) then
         focc(lshell) = foccnl_tmp(nn,ll,1)
         foccnl_tmp(nn,ll,1) = 0.d0
      else
         focc(lshell) = ftot
         foccnl_tmp(nn,ll,1) = foccnl_tmp(nn,ll,1) - ftot
      end if
   end do
   case (UD_SPECIFIED, SPIN_SPECIFIED)
   foccnls_tmp(:,:,:) = foccnls(:,:,:)
   do ishell = 1,nshell
      lshell = list_shell(ishell)
      nn   = n_qnum(lshell)
      ll   = l_qnum(lshell)
      ss   = spin  (lshell)
      lspin = 2 - (ss+1)/2
      ftot = dble(nocc(lshell))
      if (ftot >= foccnls_tmp(nn,ll,lspin)) then
         focc(lshell) = foccnls_tmp(nn,ll,lspin)
         foccnls_tmp(nn,ll,lspin) = 0.d0
      else
         focc(lshell) = ftot
         foccnls_tmp(nn,ll,lspin) = foccnls_tmp(nn,ll,lspin) - ftot
      end if
      write(IFLOG,*) 'ishell,lshell,focc ...',ishell,lshell,focc(lshell)
   end do
   end select
   do ishell = 1,nshell
      if ((focc(ishell) > 1.d-15).and.(is_solve(ishell) == 0)) then
         write(IFLOG,*) '### ERROR ### focc != 0 for is_solve = 0'
         write(IFLOG,*) '   ishell   ...', ishell
         write(IFLOG,*) '   label    ...', ' '//state(ishell)
         write(IFLOG,*) '   focc     ...', focc(ishell)
         write(IFLOG,*) '   is_solve ...', is_solve(ishell)
         ier =1 ; go to 99
      end if
   end do
   sum = 0.d0
   do ishell = 1,nshell
      if (is_solve(ishell) /= 0) then
         sum = sum + focc(ishell)
      end if
   end do
   if (abs(sum-felec) > eps_check) then
      write(IFLOG,*) '### ERROR ### sum of focc != felec'
      write(IFLOG,*) '   sum of focc ...',sum
      write(IFLOG,*) '   felec       ...',felec
      ier = 1 ; go to 99
   end if
99 continue
   end subroutine set_focc

!=====================================================================
   subroutine calc_efermi(ier)
!=====================================================================
!
!  Calculates Fermi level
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ishell, lshell
   ier = 0
   efermi = 0.d0
   do ishell = 1,nshell
      lshell = list_shell(ishell)
      if (abs(focc(lshell)) > 1.d-10) then
         efermi = engy(lshell)
      else
         exit
      end if
   end do
99 continue
   end subroutine calc_efermi
