! ************************************************************* 
!
!   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_unbound_state
!  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_unbound_state(ier)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ir, ishell, ll, nn, ispin, kk, id, ll_core, &
              node, node_sum, nrt, nrc, ir0, ir2, isdiff, n1, n2
   real(8) :: r, dr, ee, g_norm, sum, &
              rcut, r0, r1, r2, g0, g1, g2, f0, f1, f2, sign_mod, &
              dummy, dummy2
   ier    =  0
   call calc_vcoeff(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in calc_vcoeff' ; go to 99
   end if
   write(IFLOG,*)
   write(IFLOG,*) 'Calculating unbound states ...'
MAIN:do ishell = 1,nshell
      if ((is_solve(ishell) /= 0).or.(is_valence(ishell) == 0)) then
         cycle MAIN
      end if
      engy(ishell) = 0.d0      
      ee = efermi              
      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
      nn = n_qnum(ishell)
      kk = k_qnum(ishell)
      rcut = rcut_tm(ll)
      node = 0
         write(IFLOG,'(1x,a31,5i5)') &
            '??? ishell,ispin,nn,ll,node ...',ishell,ispin,nn,ll,node
SRCH_RC:do ir = nmesh,10,-1
         r = rpos(ir)
         if (r < rcut) then
            nrc = ir ; exit SRCH_RC
         end if
      end do SRCH_RC
      nrt = nrc + 20
      id = +1
      call set_initpoints_left(ier,ll,kk,ispin,ee)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in set_initpoints_left'
         go to 99
      end if
      call int_from_left(ier,node_sum,nrt,id,ll,kk,ee,ispin)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in int_from_left' ; go to 99
      end if
      if (node_sum > node) then
         write(IFLOG,*) '### CAUTION ### node_sum > node'
         write(IFLOG,*) '   node_sum ...',node_sum
         write(IFLOG,*) '   node     ...',node
      end if
      ir0 = nrc ; ir2 = nrc+1
      select case (is_calc)
      case (NONREL,SREL)
      call set_weight_exp(ier,1,ir0,rpos,wt)
      sum = 0.d0
      do ir = 1,ir0
         sum = sum + chi_gl(ir)**2 * wt(ir)
      end do
      r0 = rpos(ir0) ; r2 = rpos(ir2) ; r1 = (r0+r2)*0.5d0
      dr = r1 - r0
      g0 = chi_gl(ir0) ; g2 = chi_gl(ir2)
      isdiff = 0
      n1 = ir0 - iord_diff ; n2 = ir0 + iord_diff
      if (n1 < 1) then
         n1 = 1 ; n2 = 1 + iord_diff*2
      else if (n2 > nmesh) then
         n1 = nmesh - iord_diff*2 ; n2 = nmesh
      end if
      call diff_exp(ier,isdiff,n1,n2,rpos,chi_gl,r1,g1,dummy,dummy2)
      sum  = sum + (g0*g0 + 4.d0*g1*g1 + g2*g2) / 3.d0 * dr
      case (REL)
      call set_weight_exp(ier,1,ir0,rpos,wt)
      sum = 0.d0
      do ir = 1,ir0
         sum = sum + (chi_gl(ir)**2 + chi_fl(ir)**2) * wt(ir)
      end do
      r0 = rpos(ir0) ; r2 = rpos(ir2) ; r1 = (r0+r2)*0.5d0
      dr = r1 - r0
      g0 = chi_gl(ir0) ; g2 = chi_gl(ir2)
      f0 = chi_fl(ir0) ; f2 = chi_fl(ir2)
      isdiff = 0
      n1 = ir0 - iord_diff ; n2 = ir0 + iord_diff
      if (n1 < 1) then
         n1 = 1 ; n2 = 1 + iord_diff*2
      else if (n2 > nmesh) then
         n1 = nmesh - iord_diff*2 ; n2 = nmesh
      end if
      call diff_exp(ier,isdiff,n1,n2,rpos,chi_gl,r1,g1,dummy,dummy2)
      call diff_exp(ier,isdiff,n1,n2,rpos,chi_fl,r1,f1,dummy,dummy2)
      sum  = sum + (g0*g0 + 4.d0*g1*g1 + g2*g2) / 3.d0 * dr
      sum  = sum + (f0*f0 + 4.d0*f1*f1 + f2*f2) / 3.d0 * dr
      end select
      if (g1 < 0.d0) then
         write(IFLOG,*) '### CAUTION ### g1 < 0'
         write(IFLOG,*) '   g1 (Hamman) ...',g1
      end if
      g_norm = sqrt(sum)
      if (g1 > 0.d0) then
         sign_mod =  1.d0
      else
         sign_mod = -1.d0
      end if
      select case (is_calc)
      case (NONREL,SREL)
         do ir = 1,nrt
              chi_g(ir,ishell) =   chi_gl(ir)/g_norm * sign_mod
            dxchi_g(ir,ishell) = dxchi_gl(ir)/g_norm * sign_mod
         end do
         do ir = nrt+1,nmesh
              chi_g(ir,ishell) = 0.d0
            dxchi_g(ir,ishell) = 0.d0
         end do
      case (REL)
         do ir = 1,nrt
              chi_g(ir,ishell) =   chi_gl(ir)/g_norm * sign_mod
            dxchi_g(ir,ishell) = dxchi_gl(ir)/g_norm * sign_mod
              chi_f(ir,ishell) =   chi_fl(ir)/g_norm * sign_mod
            dxchi_f(ir,ishell) = dxchi_fl(ir)/g_norm * sign_mod
         end do
         do ir = nrt+1,nmesh
              chi_g(ir,ishell) = 0.d0
            dxchi_g(ir,ishell) = 0.d0
              chi_f(ir,ishell) = 0.d0
            dxchi_f(ir,ishell) = 0.d0
         end do
      end select
end do MAIN
99 continue
   end subroutine calc_unbound_state
