! ************************************************************* 
!
!   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_logderi_nc, write_logderi_nc, calc_vcoeff_ps
!                : set_initpoints_left_ps, int_from_left_ps
!  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_logderi_nc(ier)
!=====================================================================
!
!  M. Okamoto
!
!  ### CAUTION ### 2006.08.23 M.O.
!  Temporarily, tt = 1
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ir, ishell, ll, nn, tt, kk, jj2, ispin, ips, id, &
              node_sum, nrc, nrt, isdiff, ie_logderi
   real(8) :: ee, de, rcut, gcut0, gcut1, dummy2
   ier = 0
   call calc_vcoeff(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in calc_vcoeff' ; go to 99
   end if
   call calc_vcoeff_ps(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in calc_vcoeff_ps' ; go to 99
   end if
   de = (emax_logderi - emin_logderi) / dble(ne_logderi-1)
   do ie_logderi = 1,ne_logderi
      ee_logderi(ie_logderi) = emin_logderi &
                             + dble(ie_logderi-1) * de
   end do
   if (rcut_logderi < 1.d-12) then
      nrcut_logderi = 0
   else if (rcut_logderi >= rmax) then
      write(IFLOG,*) '### ERROR ### rcut_logderi >= rmax'
      write(IFLOG,*) '   rcut_logderi ...',rcut_logderi
      write(IFLOG,*) '   rmax         ...',rmax
      ier = 1 ; go to 99
   else
      do ir = nmesh,5,-1
         if (rpos(ir) < rcut_logderi) then
            nrcut_logderi = ir ; exit
         end if
      end do
   end if
   if (nrcut_logderi == 0) then
      nrc = nrcut_max_us
   else
      nrc = nrcut_logderi
   end if
   nrt = nrc + 1 + iord_diff
   rcut = rpos(nrc)
MAIN:do ips = 1,nps
   ishell = ishell_ps(ips,1)
   ispin = (1-spin(ishell))/2 + 1
   ll = l_qnum(ishell)
   nn = n_qnum(ishell)
   tt = 1
   kk = k_qnum(ishell)
   jj2 = j2_qnum(ishell)
L_EE:do ie_logderi = 1,ne_logderi
      ee = ee_logderi(ie_logderi)
      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
      isdiff = 1
      call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                    rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
      logderi(ie_logderi,ips) = gcut1 / gcut0
      call set_initpoints_left_ps(ier,ll,ips,ee)
      call int_from_left_ps(ier,node_sum,nrt,id,ll,tt,kk,ee,ips)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in int_from_left_ps' ; go to 99
      end if
      isdiff = 1
      call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                    rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
      logderi_ps(ie_logderi,ips) = gcut1 / gcut0
end do L_EE
end do MAIN
99 continue
   end subroutine calc_logderi_nc

!=====================================================================
   subroutine write_logderi_nc(ier)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ips, ishell, nn, ll, kk, jj2, ispin, ie_logderi
   real(8) :: ee
   character(1) :: fn_label_orbital
   character(2) :: ch_del, ch2
   ier = 0
   ch_del = ','//' '
   open(IFLDR,file=trim(ldrfile),status='unknown')
   write(IFLDR,*) 'Logarithmic derivatives [Semilocal]'
   call write_file_header(IFLDR)
   write(IFLDR,23) ne_logderi,'ne_mesh'
   do ips = 1,nps
      ishell = ishell_ps(ips,1)
      nn = n_qnum(ishell)
      ll = l_qnum(ishell)
      kk = k_qnum(ishell)
      jj2 = j2_qnum(ishell)
      ispin = (1-spin(ishell))/2 + 1
      ch2(1:2) = '_'//fn_label_orbital(ll)
      write(IFLDR,*)
      write(IFLDR,30) nn,ll,jj2,ispin,'(n, l, 2*j, s)'
      write(IFLDR,31) engy(ishell),'elevel'
      write(IFLDR,31) rcut_tm(ll) ,'rcut  '
      write(IFLDR,*)
      write(IFLDR,*) 'ee'//ch2//ch_del//'logderi'//ch2//ch_del &
                     //'logderi_ps'//ch2
      do ie_logderi = 1,ne_logderi
         ee = ee_logderi(ie_logderi)
         write(IFLDR,10) ee,logderi(ie_logderi,ips), &
                            logderi_ps(ie_logderi,ips)
      end do
   end do
10 format(3(1pe20.10))
23 format(1x,i10,10x,    5x,':',1x,a7)
30 format(1x,4i5,        5x,':',1x,a14)
31 format(1x,f20.10,     5x,':',1x,a6)
   close(IFLDR)
   end subroutine write_logderi_nc

!=====================================================================
   subroutine calc_vcoeff_ps(ier)
!=====================================================================
!
!  M. Okamoto
!
!  ### CAUTION ### 2006.08.23 M.O.
!  Temporarily, tt = 1 for veff_ps()
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ncoeff, ips, ir, i, j
   real(8) :: r
   real(8),allocatable :: rveff(:), rave(:)
   integer :: n_mat, n_vec
   real(8),allocatable :: mat_a(:,:), vec_b(:,:)
   ier = 0
   ncoeff =  iord_coeff
  !+++++++++++++++++++++++++++++++++++++++++
   allocate(rveff(ncoeff),rave(0:2*ncoeff))
      rveff = 0.d0 ; rave = 0.d0
  !+++++++++++++++++++++++++++++++++++++++++
   n_mat = ncoeff ; n_vec = 1
  !++++++++++++++++++++++++++++++++++++++++++++++++
   allocate(mat_a(n_mat,n_mat),vec_b(n_mat,n_vec))
      mat_a = 0.d0 ; vec_b = 0.d0
  !++++++++++++++++++++++++++++++++++++++++++++++++
   do ips = 1,nps
      rave(:) = 0.d0 ; rveff(:) = 0.d0
      do ir = 1,20
         r = rpos(ir)
         do i = 0,(n_mat-1)*2
            rave(i) = rave(i) + r**i
         end do
         do i = 1,n_mat
            rveff(i) = rveff(i) + veff_ps(ir,ips,1) * r**i
         end do
      end do
      mat_a(:,:) = 0.d0 ; vec_b(:,:) = 0.d0
      do i = 1,n_mat
         vec_b(i,1) = rveff(i)
         do j = 1,n_mat
            mat_a(i,j) = rave(i+j-2)
         end do
      end do
      call axb_real_matrix(ier,n_mat,1,mat_a,vec_b(1,1),vec_b(1,1))
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in axb_real_matrix'
         go to 99
      end if
      do i = 1,n_mat
         vcoeff_ps(i-2,ips,1) = vec_b(i,1)
      end do
   end do
  !++++++++++++++++++++++++
   deallocate(mat_a,vec_b)
   deallocate(rveff,rave)
  !++++++++++++++++++++++++
99 continue
   end subroutine calc_vcoeff_ps

!=====================================================================
   subroutine set_initpoints_left_ps(ier,ll,ips,ee)
!=====================================================================
!
!  M. Okamoto
!
!  ### CAUTION ### 2006.08.23 M.O.
!  Temporarily, tt = 1 for veff_ps()
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: ll, ips
   real(8),intent(in)  :: ee
   integer,intent(out) :: ier
   integer :: ncoeff, icoeff, ir, j
   real(8) :: sum, r
   real(8),allocatable :: gcoeff(:), fcoeff(:)
   ier = 0
   ncoeff =  iord_coeff
  !++++++++++++++++++++++++++++++++++++++++++++
   allocate(gcoeff(0:ncoeff),fcoeff(0:ncoeff))
      gcoeff = 0.d0 ; fcoeff = 0.d0
  !++++++++++++++++++++++++++++++++++++++++++++
   gcoeff(0) = 1.d0
   fcoeff(0) = vcoeff_ps(-1,ips,1) / dble(ll+1) * gcoeff(0)
   if (ncoeff >= 2) then
      do icoeff = 1,ncoeff-1
         gcoeff(icoeff) =  fcoeff(icoeff-1) / dble(icoeff)
         sum = 0.d0
         do j = -1,icoeff-1
            sum = sum + vcoeff_ps(j,ips,1)*gcoeff(icoeff-1-j)
         end do
         fcoeff(icoeff) = (-2.d0*ee*gcoeff(icoeff-1)+2.d0*sum) &
                        / dble(icoeff+2*ll+2)
      end do
   end if
   do ir = 1,10
      r = rpos(ir)
      chi_gl(ir) = 0.d0
      chi_fl(ir) = 0.d0
      do icoeff = 0,ncoeff-1
         chi_gl(ir) = chi_gl(ir) &
           + gcoeff(icoeff) * r**(icoeff+ll+1)
         chi_fl(ir) = chi_fl(ir) &
           + fcoeff(icoeff) * r**(icoeff+ll+1)
      end do
      call dgdx_dfdx_nonrel(r,chi_gl(ir),chi_fl(ir), &
             dxchi_gl(ir),dxchi_fl(ir),ll,ee,veff_ps(ir,ips,1))
   end do
  !++++++++++++++++++++++++++
   deallocate(gcoeff,fcoeff)
  !++++++++++++++++++++++++++
   end subroutine set_initpoints_left_ps

!=====================================================================
   subroutine int_from_left_ps(ier,node_sum,nrt,id,ll,tt,kk,ee,ips)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: nrt, id, ll, tt, kk, ips
   real(8),intent(out) :: ee
   integer,intent(out) :: ier, node_sum
   integer :: nec, ir
   ier = 0
   nec = iord_nec
   node_sum = 0
   select case (iord_pc)
   case(4)
      do ir = 3,nrt+1
         call pc_adams_4ps(ier,ir,id,ll,tt,kk,ee,nec,ips)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
   case(5)
      do ir = 4,nrt+1
         call pc_adams_5ps(ier,ir,id,ll,tt,kk,ee,nec,ips)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
   case(6)
      do ir = 4,nrt+1
         call pc_adams_6ps(ier,ir,id,ll,tt,kk,ee,nec,ips)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
   case(7)
      do ir = 5,nrt+1
         call pc_adams_7ps(ier,ir,id,ll,tt,kk,ee,nec,ips)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
   case(8)
      do ir = 6,nrt+1
         call pc_adams_8ps(ier,ir,id,ll,tt,kk,ee,nec,ips)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
   case default
      write(IFLOG,*) '### ERROR ### iord_pc is invalid (inc)'
      write(IFLOG,*) '   iord_pc ...',iord_pc
      ier = 1 ; go to 99
   end select
99 continue
   end subroutine int_from_left_ps
