! ************************************************************* 
!
!   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) : find_ishell_ss, set_init_state_ss
!  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 find_ishell_ss(nshell,n_qnum,l_qnum,nn,ll, &
                             ishell_found)
!=====================================================================
!
!  Finds ishell
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   implicit none
   integer,intent(in)  :: nshell, n_qnum(nshell), l_qnum(nshell), &
                          nn, ll
   integer,intent(out) :: ishell_found
   integer :: ishell, n, l
   do ishell = 1,nshell
      n = n_qnum(ishell)
      l = l_qnum(ishell)
      if ((nn == n).and.(ll == l)) then
         ishell_found = ishell
         exit
      end if
      if (ishell == nshell) then
         ishell_found = 0
         exit
      end if
   end do
   end subroutine find_ishell_ss

!============================================= added by K. T. ============= 4.0
subroutine find_ishell_ss_kt( nshell, n_qnum, l_qnum, nn, ll, &
     &                        myspin, spin_qnum, ishell_found )
  implicit none

  integer,intent(in)  :: nshell, n_qnum(nshell), l_qnum(nshell), &
       &                 nn, ll, myspin, spin_qnum(nshell)
  integer,intent(out) :: ishell_found

  integer :: ishell, n, l, ispin

  do ishell = 1,nshell
     n = n_qnum(ishell)
     l = l_qnum(ishell)

     ispin = spin_qnum(ishell)

     if ((nn == n).and.(ll == l).and.(ispin==myspin)) then
        ishell_found = ishell
        exit
     end if
     if (ishell == nshell) then
        ishell_found = 0
        exit
     end if
  end do

end subroutine find_ishell_ss_kt
! =========================================================================== 4.0
!=====================================================================
   subroutine set_init_state_ss(ier)
!=====================================================================
!
!  Sets initial states
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ishell, ir, iss, n1, l1, n2, l2, ips, ispin, lss, lshell
   real(8) :: r, sum1, sum2

! ================================ added by K. T. ====================== 4.0
   integer :: ispin_ps
! ====================================================================== 4.0   

   ier = 0
   if (is_core_hole_unscreened /= NO) then
      call reset_felec_ss(ier)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in reset_felec_ss'
         go to 99
      end if
   end if
   do iss = 1,nss
      n1 = n_val_label_ss(iss)
      l1 = l_val_label_ss(iss)
      if (focc_ss(iss) < 0.d0) then
         write(IFLOG,*) '### ERROR ### focc_ss < 0'
         write(IFLOG,*) '   focc_ss ...',focc_ss(iss)
         write(IFLOG,*) '   (n,l,s) ...',n1,l1,spin_ss(iss)
         ier = 1 ; go to 99
      end if
   end do
   do iss = 1,nss
      n1 = n_val_label_ss(iss)
      l1 = l_val_label_ss(iss)
      do ips = 1,nps
         n2 = n_val_label_ps(ips)
         l2 = l_val_label_ps(ips)
         if ((n1 == n2).and.(l1 == l2)) then
            exit
         end if
         if (ips == nps) then
            write(IFLOG,*) '### ERROR ###'
            write(IFLOG,*) 'The valence states specified for solve_pp is'
            write(IFLOG,*) 'inequivalent to those for the pseudopotential.'
            write(IFLOG,*) '   (n,l) ...',n1,l1
            ier = 1 ; go to 99
         end if
      end do
   end do

   dee_save(:) = 0.d0
   do iss = 1,nss
      ishell = ishell_ss(iss)
      engy_ss(iss) = engy(ishell)
   end do

   sum1 = 0.d0
   do ir = 1,nmesh
      r = rpos(ir)

! =========================================== modiifed by K. T. ============ 4.0
!      rho_ss(ir,1) = rho_sol(ir)
!
      if ( nspin == 1 ) then
         rho_ss(ir,1) = rho_sol(ir,1)
      else if ( nspin == 2 ) then
         rho_ss(ir,1) = ( rho_sol(ir,1) +rho_sol(ir,2) ) /2.0
      endif
! ========================================================================== 4.0

      sum1 = sum1 + rho_ss(ir,1) * r*r*wr(ir)
   end do

   sum1 = sum1 * 4.d0*PI
   sum2 = 0.d0

   do ir = 1,nmesh
      r = rpos(ir)
      rho_ss(ir,1) = rho_ss(ir,1) * felec_ss/sum1
      if (is_spin_ss == POLARIZED) then
         rho_ss(ir,2) = (felec2_ss/felec_ss) * rho_ss(ir,1)
         rho_ss(ir,1) = rho_ss(ir,1) - rho_ss(ir,2)
         sum2 = sum2 + (rho_ss(ir,1)+rho_ss(ir,2)) * r*r*wr(ir)
      else
         sum2 = sum2 + rho_ss(ir,1) * r*r*wr(ir)
      end if
   end do

   sum2 = sum2 * 4.d0*PI

   write(IFLOG,10) '??? check: initial felec1_ss,felec2_ss ...', &
                                       felec1_ss,felec2_ss

10 format(1x,a42,2f15.10)

   if (abs(sum2-felec_ss) > 1.d-6) then
      write(IFLOG,*) '### ERROR ### sum of rho_ss != felec_ss'
      write(IFLOG,*) '   sum of rho_ss ...',sum2
      write(IFLOG,*) '   felec_ss      ...',felec_ss
      ier = 1 ; go to 99
   end if

! ========================================= modified by K. T. ============== 4.0
!   do ispin = 1,nspin_ss
!      vloc_scr_ss(:,ispin) = vloc_scr_sol(:)
!   end do
!
   if ( nspin == 1 ) then
      do ispin = 1,nspin_ss
         vloc_scr_ss(:,ispin) = vloc_scr_sol(:,1)
      end do

   else if ( nspin == 2 ) then

      if ( nspin_ss == 1 ) then
         vloc_scr_ss(:,ispin) = ( vloc_scr_sol(:,1) + vloc_scr_sol(:,2) )/2.0

      else if ( nspin_ss == 2 ) then

         Do ispin=1, nspin_ss
            ispin_ps = ispin                      ! uncertain

            vloc_scr_ss(:,ispin) = vloc_scr_sol(:,ispin_ps)
            vloc_scr_ss(:,ispin) = vloc_scr_sol(:,ispin_ps)
         End Do
      endif

   endif
! ========================================================================== 4.0

   do ispin = 1,nspin_ss
      dmat_ss(:,ispin) = dmat_us(:)
      vlocqps_ss(:,ispin) = vlocqps_us(:)
   end do
   is_solve_ss(:) = 1
   do iss = 1,nss
      ishell = ishell_ss(iss)
      if ((abs(felec2_ss) < 1.d-6).and.(spin_ss(iss) == -1)) then
         is_solve_ss(iss) = 0
      end if
      if (is_solve(ishell) == 0) then
         is_solve_ss(iss) = 0
      end if
   end do
   etot_ss = -1.d0
   do iss = 1,nss
      ishell = ishell_ss(iss)
      nrm_pos_ss(iss) = nrm_pos(ishell)
      select case (spin_ss(iss))
      case (+1)
         spin_label_ss(iss) = '+'
      case (-1)
         spin_label_ss(iss) = '-'
      end select
   end do
   call sort_engy_ss(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in sort_engy_ss' ; go to 99
   end if
   call set_focc_ss(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in set_focc_ss' ; go to 99
   end if
   do iss = 1,nss
      lss = list_ss(iss)
      lshell = ishell_ss(lss)
      write(IFLOG,*) '(n,l,s),focc,nocc,is_solve ...', &
         n_qnum(lshell),l_qnum(lshell),spin_ss(lss), &
         focc_ss(lss),nocc_ss(lss),is_solve_ss(lss)
   end do
99 continue
   end subroutine set_init_state_ss
