!
!  Software name : CIAO (Code for Investigating Atomic Orbitals)
!  Subroutine(s) : calc_logderi_sol, write_logderi_sol, calc_lt_nn_nnn
!                : calc_bsum_sol, set_initpoints_left_ae
!                : int_from_left_ae, pc_adams_5_ae
!  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_sol(ier)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ll, ispin, id, ir, tt, t1, t2, lt, lt1, nref, ltt, &
              node_sum, nrc, nrt, isdiff, ie_logderi, loop
   real(8) :: ee, de, rcut, gcut0, gcut1, dummy2, sum, &
              logderi0, logderi1
   real(8),allocatable :: &
      bsum(:), amat(:,:), bvec(:), coeff(:), fmat(:,:), hmat(:,:), &
      h0vec(:), rphi_tmp(:,:)
   integer,parameter :: loop_max = 200
   real(8),parameter :: eps_logderi = 1.d-5
   ier = 0
  !++++++++++++++++++++++++++++++++++++
   allocate(bsum(nmesh)) ; bsum = 0.d0
  !++++++++++++++++++++++++++++++++++++
   call calc_vcoeff(ier)
   if (ier /= 0) then
      write(IFLOG,*) '### ERROR ### in calc_vcoeff' ; 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 = max(nrcut_logderi,nrcut_max_us)
   end if
   nrt = nrc + 1 + max(iord_diff,iord_pc)
   rcut = rpos(nrc)
   ispin = 1
MAIN1:do ll = 0,lmax
L_EE1:do ie_logderi = 1,ne_logderi
      ee = ee_logderi(ie_logderi)
      id = +1
      call set_initpoints_left_ae(ier,ll,ispin,ee)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in set_initpoints_left'
         go to 99
      end if
      call int_from_left_ae(ier,node_sum,nrt,id,ll,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)

! ============================================= modified by K. T. =========== 4.0
!      logderi_ae(ie_logderi,ll) = gcut1 / gcut0
      logderi_ae(ie_logderi,ll,1) = gcut1 / gcut0
! =========================================================================== 4.0

end do L_EE1
end do MAIN1
MAIN2:do ll = 0,lmax
   select case (is_logderi_method)
   case (FREDHOLM)
      nref = nref_us(ll)
     !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      allocate(amat(nref,nref),bvec(nref),coeff(nref), &
               fmat(nref,nref),hmat(nref,nref),h0vec(nref), &
               rphi_tmp(nmesh,0:nref))
         amat = 0.d0 ; bvec = 0.d0 ; coeff = 0.d0
         fmat = 0.d0 ; hmat = 0.d0 ; h0vec = 0.d0
         rphi_tmp = 0.d0
     !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
   end select
L_EE2:do ie_logderi = 1,ne_logderi
      ee = ee_logderi(ie_logderi)
   select case (is_logderi_method)
   case (ITERATIVE)
      lt1 = lt_n_us(ll,1)
      chi_gl(:) = rphi_us(:,lt1)
      isdiff = 1
      call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                    rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
      logderi0 = gcut1 / gcut0
L_US:do loop = 1,loop_max
      call calc_bsum_sol(ier,nrc,ll,ee,bsum)
      call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
              chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
      call int_from_left_sol(ier,nmesh,node_sum,nrt, &
              ll,ee,iord_nec,dx,rpos, &
              chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
      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)
      logderi1 = gcut1 / gcut0
      if (abs(logderi0-logderi1) < eps_logderi) then
         exit L_US
      else if (loop == loop_max) then
         if (abs(logderi0-logderi1) < 50.d0) then 
            write(IFLOG,'(a40,2i5,f10.5,f12.7)') &
               '### CAUTION ### [logderi] ll,ie,ee,diff:', &
                ll,ie_logderi,ee,abs(logderi0-logderi1)
            logderi0 = logderi1
         else
            write(IFLOG,*) '### ERROR ### loop == loop_max'
            write(IFLOG,*) '   loop ...',loop
            write(IFLOG,*) '   diff ...',abs(logderi0-logderi1)
            write(IFLOG,*) '   ll   ...',ll
            write(IFLOG,*) '   ie   ...',ie_logderi
            write(IFLOG,*) '   ee   ...',ee
            ier = 1 ; go to 99
         end if
      else
         logderi0 = logderi1
      end if
end do L_US

! ========================================= modified by K. T. ================ 4.0
!      logderi_us(ie_logderi,ll) = logderi1
      logderi_us(ie_logderi,ll,1) = logderi1
! ============================================================================ 4.0

   case (FREDHOLM)
      bsum = 0.d0
      call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
              chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
      call int_from_left_sol(ier,nmesh,node_sum,nrt, &
              ll,ee,iord_nec,dx,rpos, &
              chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
      if (ier /= 0) then
         write(IFLOG,*) '### ERROR ### in int_from_left_ps' ; go to 99
      end if
      rphi_tmp(:,0) = chi_gl(:)
      do tt = 1,nref
         lt = lt_n_us(ll,tt)
         bsum(:) = -rbeta_us(:,lt)
         call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
                 chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
         call int_from_left_sol(ier,nmesh,node_sum,nrt, &
                 ll,ee,iord_nec,dx,rpos, &
                 chi_gl,chi_fl,dxchi_gl,dxchi_fl,vloc_scr_us,bsum)
         if (ier /= 0) then
            write(IFLOG,*) '### ERROR ### in int_from_left_ps'
            go to 99
         end if
         rphi_tmp(:,tt) = chi_gl(:)
      end do
      fmat(:,:) = 0.d0
      do t1 = 1,nref
      do t2 = 1,nref
         ltt = ltt_nm_us(ll,t1,t2)
         fmat(t1,t2) = dmat_us(ltt) - ee*q_sum_us(ltt)
      end do
      end do
      do t1 = 1,nref
         lt1 = lt_n_us(ll,t1)
         do t2 = 1,nref
            sum = 0.d0
            do ir = 1,nmesh
               sum = sum + rbeta_us(ir,lt1)*rphi_tmp(ir,t2)*wr(ir)
            end do
            hmat(t1,t2) = sum
         end do
      end do
      amat = matmul(fmat,hmat)
      do tt = 1,nref
         amat(tt,tt) = amat(tt,tt) + 1.d0
      end do
      do tt = 1,nref
         lt = lt_n_us(ll,tt)
         sum = 0.d0
         do ir = 1,nmesh
            sum = sum + rbeta_us(ir,lt)*rphi_tmp(ir,0)*wr(ir)
         end do
         h0vec(tt) = sum
      end do      
      bvec = -matmul(fmat,h0vec)
      call axb_real_matrix(ier,nref,1,amat,coeff,bvec)
      chi_gl(:) = rphi_tmp(:,0)
      do tt = 1,nref
         chi_gl(:) = chi_gl(:) + coeff(tt)*rphi_tmp(:,tt)
      end do
      isdiff = 1
      call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                    rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
      logderi1 = gcut1 / gcut0
! ================================================ modified by K. T. ======== 4.0
!      logderi_us(ie_logderi,ll) = logderi1
      logderi_us(ie_logderi,ll,1) = logderi1
! =========================================================================== 4.0
   end select
end do L_EE2
   select case (is_logderi_method)
   case (FREDHOLM)
     !+++++++++++++++++++++++++++++++++++++++++++++++++++++
      deallocate(amat,bvec,coeff,fmat,hmat,h0vec,rphi_tmp)
     !+++++++++++++++++++++++++++++++++++++++++++++++++++++
  end select
end do MAIN2
99 continue
  !+++++++++++++++++
   deallocate(bsum)
  !+++++++++++++++++
   end subroutine calc_logderi_sol

! ==================================== added by K. T. ======================== 4.0
subroutine calc_logderi_sol_kt(ier)
  use parameters
  implicit none

  integer,intent(out) :: ier
  integer :: ll, ispin, id, ir, tt, t1, t2, lt, lt1, nref, ltt, &
       node_sum, nrc, nrt, isdiff, ie_logderi, loop
  integer :: itmp1, itmp2

  real(8) :: ee, de, rcut, gcut0, gcut1, dummy2, sum, &
       logderi0, logderi1

  real(8),allocatable :: &
       bsum(:), amat(:,:), bvec(:), coeff(:), fmat(:,:), hmat(:,:), &
       h0vec(:), rphi_tmp(:,:)

  integer,parameter :: loop_max = 200
  real(8),parameter :: eps_logderi = 1.d-5

  ier = 0

  !++++++++++++++++++++++++++++++++++++
  allocate(bsum(nmesh)) ; bsum = 0.d0
  !++++++++++++++++++++++++++++++++++++

  call calc_vcoeff(ier)
  if (ier /= 0) then
     write(IFLOG,*) '### ERROR ### in calc_vcoeff' ; 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 = max(nrcut_logderi,nrcut_max_us)
  end if

  nrt = nrc + 1 + max(iord_diff,iord_pc)
  rcut = rpos(nrc)


  Do ispin=1, nspin
     
     MAIN1:do ll = 0,lmax

        L_EE1:do ie_logderi = 1,ne_logderi
           
           ee = ee_logderi(ie_logderi)
           id = +1
           
           call set_initpoints_left_ae(ier,ll,ispin,ee)
           if (ier /= 0) then
              write(IFLOG,*) '### ERROR ### in set_initpoints_left'
              go to 99
           end if
           
           call int_from_left_ae(ier,node_sum,nrt,id,ll,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_ae(ie_logderi,ll,ispin) = gcut1 / gcut0

        end do L_EE1
     end do MAIN1
     

     MAIN2:do ll = 0,lmax

        select case (is_logderi_method)
           
        case (FREDHOLM)
           nref = nref_us(ll)

           !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
           allocate(amat(nref,nref),bvec(nref),coeff(nref), &
                fmat(nref,nref),hmat(nref,nref),h0vec(nref), &
                rphi_tmp(nmesh,0:nref))
           amat = 0.d0 ; bvec = 0.d0 ; coeff = 0.d0
           fmat = 0.d0 ; hmat = 0.d0 ; h0vec = 0.d0
           rphi_tmp = 0.d0
           !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        end select

        L_EE2:do ie_logderi = 1,ne_logderi
           ee = ee_logderi(ie_logderi)
           
           select case (is_logderi_method)

           case (ITERATIVE)
              
              lt1 = lt_n_us(ll, 1 +nref_max_us *(ispin-1) )
              chi_gl(:) = rphi_us(:,lt1)
              
              isdiff = 1
              
              call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                   rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
              logderi0 = gcut1 / gcut0
              
              L_US:do loop = 1,loop_max
                 
                 call calc_bsum_sol_kt( ier, nrc, ll, ee, ispin, bsum )
                 
                 call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
                      &     chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                      &     vloc_scr_us(:,ispin), bsum )
                 
                 call int_from_left_sol(ier,nmesh,node_sum,nrt, &
                      & ll,ee,iord_nec,dx,rpos, &
                      & chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                      & vloc_scr_us(:,ispin), bsum )
                 
                 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)
                 
                 logderi1 = gcut1 / gcut0

                 if (abs(logderi0-logderi1) < eps_logderi) then
                    exit L_US
                    
                 else if (loop == loop_max) then
                    if (abs(logderi0-logderi1) < 50.d0) then 
                       write(IFLOG,'(a40,2i5,f10.5,f12.7)') &
                            '### CAUTION ### [logderi] ll,ie,ee,diff:', &
                            ll,ie_logderi,ee,abs(logderi0-logderi1)
                       logderi0 = logderi1
                    else
                       write(IFLOG,*) '### ERROR ### loop == loop_max'
                       write(IFLOG,*) '   loop ...',loop
                       write(IFLOG,*) '   diff ...',abs(logderi0-logderi1)
                       write(IFLOG,*) '   ll   ...',ll
                       write(IFLOG,*) '   ispin   ...', ispin
                       write(IFLOG,*) '   ie   ...',ie_logderi
                       write(IFLOG,*) '   ee   ...',ee
                       ier = 1 ; go to 99
                    end if

                 else
                    logderi0 = logderi1
                 end if
                 
              end do L_US

              logderi_us(ie_logderi,ll,ispin) = logderi1


           case (FREDHOLM)
           
              bsum = 0.d0

              call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
                   &    chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                   &    vloc_scr_us(:,ispin) ,bsum )

              call int_from_left_sol(ier,nmesh,node_sum,nrt, &
                   & ll,ee,iord_nec,dx,rpos, &
                   & chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                   & vloc_scr_us(:,ispin), bsum )
              
              if (ier /= 0) then
                 write(IFLOG,*) '### ERROR ### in int_from_left_ps' ; go to 99
              end if
              
              rphi_tmp(:,0) = chi_gl(:)

              do tt = 1,nref
                 itmp1 = tt + nref_max_us *(ispin -1)

                 lt = lt_n_us(ll,itmp1)
                 bsum(:) = -rbeta_us(:,lt)
                 
                 call set_initpoints_left_sol(ier,nmesh,ll,ee,rpos, &
                      &  chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                      &  vloc_scr_us(:,ispin), bsum )

                 call int_from_left_sol(ier,nmesh,node_sum,nrt, &
                      & ll,ee,iord_nec,dx,rpos, &
                      & chi_gl,chi_fl,dxchi_gl,dxchi_fl, &
                      & vloc_scr_us(:,ispin), bsum )
                 
                 if (ier /= 0) then
                    write(IFLOG,*) '### ERROR ### in int_from_left_ps'
                    go to 99
                 end if
                 
                 rphi_tmp(:,tt) = chi_gl(:)
              end do
              
              fmat(:,:) = 0.d0
              
              do t1 = 1,nref
                 do t2 = 1,nref
                    itmp1 = t1 + nref_max_us * (ispin -1)
                    itmp2 = t2 + nref_max_us * (ispin -1)

                    ltt = ltt_nm_us(ll,itmp1,itmp2)
                    fmat(t1,t2) = dmat_us(ltt) - ee*q_sum_us(ltt)
                 end do
              end do
              
              do t1 = 1,nref
                 itmp1 = t1 + nref_max_us * (ispin -1)
                 lt1 = lt_n_us(ll,itmp1)

                 do t2 = 1,nref
                    sum = 0.d0
                    do ir = 1,nmesh
                       sum = sum + rbeta_us(ir,lt1)*rphi_tmp(ir,t2)*wr(ir)
                    end do
                    hmat(t1,t2) = sum
                 end do
              end do
              
              amat = matmul(fmat,hmat)
              do tt = 1,nref
                 amat(tt,tt) = amat(tt,tt) + 1.d0
              end do
              
              do tt = 1,nref
                 itmp1 = tt + nref_max_us * (ispin -1)
                 lt = lt_n_us(ll,itmp1)

                 sum = 0.d0
                 do ir = 1,nmesh
                    sum = sum + rbeta_us(ir,lt)*rphi_tmp(ir,0)*wr(ir)
                 end do
                 h0vec(tt) = sum
              end do
              
              bvec = -matmul(fmat,h0vec)
              
              call axb_real_matrix(ier,nref,1,amat,coeff,bvec)
              
              chi_gl(:) = rphi_tmp(:,0)
              do tt = 1,nref
                 chi_gl(:) = chi_gl(:) + coeff(tt)*rphi_tmp(:,tt)
              end do
              
              isdiff = 1
              call diff_exp(ier,isdiff,nrc-iord_diff,nrc+iord_diff, &
                   rpos,chi_gl,rcut,gcut0,gcut1,dummy2)
              
              logderi1 = gcut1 / gcut0
              logderi_us(ie_logderi,ll,ispin) = logderi1

           end select
     
        end do L_EE2


        select case (is_logderi_method)
        case (FREDHOLM)
           !+++++++++++++++++++++++++++++++++++++++++++++++++++++
           deallocate(amat,bvec,coeff,fmat,hmat,h0vec,rphi_tmp)
           !+++++++++++++++++++++++++++++++++++++++++++++++++++++
        end select
        
     end do MAIN2
     
  End do

99 continue

  !+++++++++++++++++
  deallocate(bsum)
  !+++++++++++++++++

end subroutine calc_logderi_sol_kt
! =========================================================================== 4.0

!=====================================================================
   subroutine write_logderi_sol(ier)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(out) :: ier
   integer :: ll, tt, lt, nref, ispin, ie_logderi, nrc
   real(8) :: ee
   character(1) :: ch_ln, fn_label_orbital
   character(2) :: ch_del, ch2
   ier = 0
   if (nrcut_logderi == 0) then
      nrc = nrcut_max_us
   else
      nrc = max(nrcut_logderi,nrcut_max_us)
   end if
   ch_del = ','//' '
   open(IFLDR,file=trim(ldrfile),status='unknown')
   write(IFLDR,*) 'Logarithmic derivatives [Separable]'
   call write_file_header(IFLDR)
   write(IFLDR,23) ne_logderi,'ne_mesh'
   do ll = 0,lmax
      ch_ln = fn_label_orbital(ll)
      ch2(1:2) = '_'//ch_ln(1:1)
      nref = nref_us(ll)
      if (nref == 0) then
         cycle
      end if

      ispin = 1
      write(IFLDR,*)
      write(IFLDR,30) ll,nref,ispin,'(l, nref, s)'
      do tt = 1,nref
      lt = lt_n_us(ll,tt)
      write(IFLDR,31) eref_us(lt),'elevel'
      end do
      write(IFLDR,31) rpos(nrc)  ,'rcut  '
      write(IFLDR,*)
      write(IFLDR,*) 'ee'//ch2//ch_del//'ldr_ae'//ch2//ch_del &
                     //'ldr_us'//ch2
      do ie_logderi = 1,ne_logderi
         ee = ee_logderi(ie_logderi)
! ============================================ modified by K. T. =========== 4.0
!         write(IFLDR,10) ee,logderi_ae(ie_logderi,ll), &
!                            logderi_us(ie_logderi,ll)
         write(IFLDR,10) ee,logderi_ae(ie_logderi,ll,1), &
                            logderi_us(ie_logderi,ll,1)
! ========================================================================== 4.0
      end do
   end do
10 format(3(1pe20.10))
23 format(1x,i10,10x,5x,':',1x,a7)
30 format(1x,3i5, 5x,5x,':',1x,a12)
31 format(1x,f20.10, 5x,':',1x,a6)
   close(IFLDR)
   end subroutine write_logderi_sol

!=============================== added by K. T. ======================== 4.0
subroutine write_logderi_sol_kt(ier)
  use parameters
  implicit none

  integer,intent(out) :: ier
  integer :: ll, tt, lt, nref, ispin, ie_logderi, nrc
  real(8) :: ee
  character(1) :: ch_ln, fn_label_orbital
  character(2) :: ch_del, ch2

  integer :: itmp1

  ier = 0
  if (nrcut_logderi == 0) then
     nrc = nrcut_max_us
  else
     nrc = max(nrcut_logderi,nrcut_max_us)
  end if

  ch_del = ','//' '

  open(IFLDR,file=trim(ldrfile),status='unknown')
  write(IFLDR,*) 'Logarithmic derivatives [Separable]'

  call write_file_header(IFLDR)
  write(IFLDR,23) ne_logderi,'ne_mesh'

  do ll = 0,lmax
     ch_ln = fn_label_orbital(ll)
     ch2(1:2) = '_'//ch_ln(1:1)

     nref = nref_us(ll)
     if (nref == 0) then
        cycle
     end if
     
     Do ispin=1, nspin
        write(IFLDR,*)
        write(IFLDR,30) ll,nref,ispin,'(l, nref, s)'

        do tt = 1,nref
           itmp1 = tt + nref_max_us * (ispin -1)
           lt = lt_n_us(ll,itmp1)

           write(IFLDR,31) eref_us(lt),'elevel'
        end do

        write(IFLDR,31) rpos(nrc)  ,'rcut  '
        write(IFLDR,*)
        write(IFLDR,*) 'ee'//ch2//ch_del//'ldr_ae'//ch2//ch_del &
             //'ldr_us'//ch2

        do ie_logderi = 1,ne_logderi
           ee = ee_logderi(ie_logderi)
           write(IFLDR,10) ee, logderi_ae(ie_logderi,ll,ispin), &
                &              logderi_us(ie_logderi,ll,ispin)
        end do
     end do
     
  End do

10 format(3(1pe20.10))
23 format(1x,i10,10x,5x,':',1x,a7)
30 format(1x,3i5, 5x,5x,':',1x,a12)
31 format(1x,f20.10, 5x,':',1x,a6)

  close(IFLDR)

end subroutine write_logderi_sol_kt
! ======================================================================= 4.0

!=====================================================================
   subroutine calc_lt_nn_nnn(ll,ee,lt1,lt2)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: ll
   real(8),intent(in)  :: ee
   integer,intent(out) :: lt1, lt2
   real(8),allocatable :: dee(:)
   integer,allocatable :: tee(:)
   integer :: nref, i, j, tn, lt
   nref = nref_us(ll)
  !+++++++++++++++++++++++++++++++++++++++++++++++++++++
   allocate(dee(nref),tee(nref)) ; dee = 0.d0 ; tee = 0
  !+++++++++++++++++++++++++++++++++++++++++++++++++++++
   do tn = 1,nref
      lt = lt_n_us(ll,tn)
      dee(tn) = abs(ee - eref_us(lt))
      tee(tn) = tn
   end do
   if (nref == 1) then
      lt1 = lt_n_us(ll,1)
      lt2 = lt_n_us(ll,1)
   else
      do i = 1,nref-1
         do j = i+1,nref
            if (dee(tee(i)) > dee(tee(j))) then
               call iswap(tee(i),tee(j))
            end if
         end do
      end do
      lt1 = lt_n_us(ll,tee(1))
      lt2 = lt_n_us(ll,tee(2))
   end if   
  !++++++++++++++++++++
   deallocate(dee,tee)
  !++++++++++++++++++++
   end subroutine calc_lt_nn_nnn

!=====================================================================
   subroutine calc_bsum_sol(ier,nrc,ll,ee,bsum)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   integer,intent(in)  :: nrc, ll
   real(8),intent(in)  :: ee
   integer,intent(out) :: ier
   real(8),intent(out) :: bsum(nmesh)
   integer :: ir, nref, tn, tm, ltn, ltm, ltt
   real(8) :: sum
   ier = 0
   nref = nref_us(ll)
   bsum(:) = 0.d0
   do tm = 1,nref
      ltm = lt_n_us(ll,tm)
      sum = 0.d0
      do ir = 1,nmesh
         sum = sum + wr(ir)*rbeta_us(ir,ltm)*chi_gl(ir)
      end do
      do tn = 1,nref
         ltn = lt_n_us(ll,tn)
         ltt = ltt_nm_us(ll,tn,tm)
         do ir = 1,nrc
         bsum(:) = bsum(:) &
            + rbeta_us(:,ltn)*(dmat_us(ltt)-ee*q_sum_us(ltt))*sum
         end do
      end do
   end do
   end subroutine calc_bsum_sol

!===================================== added by K. T. ======================= 4.0
subroutine calc_bsum_sol_kt( ier, nrc, ll, ee, ispin, bsum )
  use parameters
  implicit none

  integer,intent(in)  :: nrc, ll, ispin
  real(8),intent(in)  :: ee
  integer,intent(out) :: ier
  real(8),intent(out) :: bsum(nmesh)
  
  integer :: ir, nref, tn, tm, ltn, ltm, ltt
  integer :: itmp1, itmp2
  real(8) :: sum

  ier = 0
  nref = nref_us(ll)

  bsum(:) = 0.d0

  do tm = 1,nref
     itmp1 = tm + nref_max_us *(ispin -1)
     ltm = lt_n_us(ll,itmp1)

     sum = 0.d0
     do ir = 1,nmesh
        sum = sum + wr(ir)*rbeta_us(ir,ltm)*chi_gl(ir)
     end do

     do tn = 1,nref
        itmp2 = tn + nref_max_us *(ispin -1)

        ltn = lt_n_us(ll,itmp2)
        ltt = ltt_nm_us(ll,itmp2,itmp1)

        do ir = 1,nrc
           bsum(:) = bsum(:) &
                + rbeta_us(:,ltn)*(dmat_us(ltt)-ee*q_sum_us(ltt))*sum
        end do
     end do
  end do

end subroutine calc_bsum_sol_kt
! ============================================================================= 4.0

!=====================================================================
   subroutine set_initpoints_left_ae(ier,ll,ispin,ee)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: ll, ispin
   real(8),intent(in)  :: ee
   integer,intent(out) :: ier
   integer :: ncoeff, icoeff, j, ir, ll_core
   real(8) :: sum, r, mass, power
   real(8),allocatable :: gcoeff(:), fcoeff(:)
   ier = 0
   ncoeff =  iord_coeff
  !++++++++++++++++++++++++++++++++++++++++++++
   allocate(gcoeff(0:ncoeff),fcoeff(0:ncoeff))
      gcoeff = 0.d0 ; fcoeff = 0.d0
  !++++++++++++++++++++++++++++++++++++++++++++
   if (is_core == PATOM) then
      ll_core = ll
   else
      ll_core = lmax_core
   end if
   select case (is_calc)
   case (NONREL)
      gcoeff(0) = 1.d0
      fcoeff(0) = vcoeff(-1,ispin,ll_core) / 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(j,ispin,ll_core)*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(ir,ispin,ll_core))
      end do
   case (SREL)
      mass = 1.d0 + 0.5d0*ALPHA*ALPHA*(ee-veff(1,ispin,ll_core))
      select case (ll)
      case (0)
         gcoeff(0) = 1.d0 ; power = 1.d0
         do icoeff = 1,ncoeff
            sum = 0.d0
            do j = -1,icoeff-2
               sum = sum + vcoeff(j,ispin,ll_core)*gcoeff(icoeff-j-2)
            end do
            if (icoeff >= 2) then
               sum = sum - ee*gcoeff(icoeff-2)
            end if
            gcoeff(icoeff) = sum * 2.d0*mass &
                                 / dble(icoeff*(icoeff+1))
            fcoeff(icoeff-1) = dble(icoeff) / (2.d0*mass) &
                             * gcoeff(icoeff)
         end do
      case (1:)
         gcoeff(0) = 0.d0 ; gcoeff(1) = 1.d0 ; power = dble(ll)
         fcoeff(0) = dble(ll)/(2.d0*mass) * gcoeff(1)
         if (ncoeff >= 2) then
            do icoeff = 2,ncoeff
               sum = 0.d0
               do j = -1,icoeff-2
                  sum = sum + vcoeff(j,ispin,ll_core) &
                              * gcoeff(icoeff-j-2)
               end do
               sum = sum - ee*gcoeff(icoeff-2)
               gcoeff(icoeff) = sum * 2.d0*mass &
                              / dble((icoeff-1)*(icoeff+2*ll))
               fcoeff(icoeff-1) = dble(icoeff+ll-1) &
                                / (2.d0*mass) * gcoeff(icoeff)
            end do
         end if
      end select
      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**(dble(icoeff)+power)
            chi_fl(ir) = chi_fl(ir) &
              + fcoeff(icoeff) * r**(dble(icoeff)+power)
         end do
         call dgdx_dfdx_srel(r,chi_gl(ir),chi_fl(ir), &
              dxchi_gl(ir),dxchi_fl(ir),ll,ee,veff(ir,ispin,ll_core))
      end do
   end select
99 continue
  !++++++++++++++++++++++++++
   deallocate(gcoeff,fcoeff)
  !++++++++++++++++++++++++++
   end subroutine set_initpoints_left_ae

!=====================================================================
   subroutine int_from_left_ae(ier,node_sum,nrt,id,ll,ee,ispin)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: nrt, id, ll, ispin
   real(8),intent(in)  :: ee
   integer,intent(out) :: ier, node_sum
   integer :: nec, ir
   ier = 0
   nec = iord_nec
   node_sum = 0
      do ir = 4,nrt+1
         call pc_adams_5_ae(ier,ir,id,ll,ee,nec,ispin)
         if (chi_gl(ir)*chi_gl(ir-1) < 0.d0) then
            node_sum = node_sum + 1
         end if
      end do
99 continue
   end subroutine int_from_left_ae

!=====================================================================
   subroutine pc_adams_5_ae(ier,ir,id,ll,ee,nec,ispin)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters   
   implicit none
   integer,intent(in)    :: ir, ll, nec, ispin
   real(8),intent(in)    :: ee
   integer,intent(inout) :: id
   integer,intent(out)   :: ier
   integer :: iec, ll_core
   real(8) :: dx24, &
              g0, g1, g2, g3, dg0, dg1, dg2, dg3, g9, dg9, &
              f0, f1, f2, f3, df0, df1, df2, df3, f9, df9
   ier = 0
   if (is_core == PATOM) then
      ll_core = ll
   else
      ll_core = lmax_core
   end if
   id   = sign(1, id)
   dx24 = dx / 24.d0 * dble(id)
   select case (id)
   case(+1)
      g0  =   chi_gl(ir     ) ; f0  =   chi_fl(ir     )
      g1  =   chi_gl(ir-1*id) ; f1  =   chi_fl(ir-1*id)
      g2  =   chi_gl(ir-2*id) ; f2  =   chi_fl(ir-2*id)
      g3  =   chi_gl(ir-3*id) ; f3  =   chi_fl(ir-3*id)
      dg0 = dxchi_gl(ir     ) ; df0 = dxchi_fl(ir     )
      dg1 = dxchi_gl(ir-1*id) ; df1 = dxchi_fl(ir-1*id)
      dg2 = dxchi_gl(ir-2*id) ; df2 = dxchi_fl(ir-2*id)
      dg3 = dxchi_gl(ir-3*id) ; df3 = dxchi_fl(ir-3*id)
   case(-1)
      g0  =   chi_gr(ir     ) ; f0  =   chi_fr(ir     )
      g1  =   chi_gr(ir-1*id) ; f1  =   chi_fr(ir-1*id)
      g2  =   chi_gr(ir-2*id) ; f2  =   chi_fr(ir-2*id)
      g3  =   chi_gr(ir-3*id) ; f3  =   chi_fr(ir-3*id)
      dg0 = dxchi_gr(ir     ) ; df0 = dxchi_fr(ir     )
      dg1 = dxchi_gr(ir-1*id) ; df1 = dxchi_fr(ir-1*id)
      dg2 = dxchi_gr(ir-2*id) ; df2 = dxchi_fr(ir-2*id)
      dg3 = dxchi_gr(ir-3*id) ; df3 = dxchi_fr(ir-3*id)
   end select
   g9 = g0 + dx24 * (55.d0*dg0 - 59.d0*dg1 + 37.d0*dg2 - 9.d0*dg3)
   f9 = f0 + dx24 * (55.d0*df0 - 59.d0*df1 + 37.d0*df2 - 9.d0*df3)
   do iec = 1,nec
      select case (is_calc)
      case (NONREL)
         call dgdx_dfdx_nonrel(rpos(ir+id),g9,f9,dg9,df9, &
                               ll,ee,veff(ir+id,ispin,ll_core))
      case (SREL)
         call dgdx_dfdx_srel(rpos(ir+id),g9,f9,dg9,df9, &
                             ll,ee,veff(ir+id,ispin,ll_core))
      end select
      g9 = g0 + dx24 * (9.d0*dg9 + 19.d0*dg0 - 5.d0*dg1 + dg2)
      f9 = f0 + dx24 * (9.d0*df9 + 19.d0*df0 - 5.d0*df1 + df2)
   end do
   select case (is_calc)
   case (NONREL)
      call dgdx_dfdx_nonrel(rpos(ir+id),g9,f9,dg9,df9, &
                            ll,ee,veff(ir+id,ispin,ll_core))
   case (SREL)
      call dgdx_dfdx_srel(rpos(ir+id),g9,f9,dg9,df9, &
                          ll,ee,veff(ir+id,ispin,ll_core))
   end select
   select case (id)
   case(+1)
        chi_gl(ir+id) =  g9 ;   chi_fl(ir+id) =  f9
      dxchi_gl(ir+id) = dg9 ; dxchi_fl(ir+id) = df9
   case(-1)
        chi_gr(ir+id) =  g9 ;   chi_fr(ir+id) =  f9
      dxchi_gr(ir+id) = dg9 ; dxchi_fr(ir+id) = df9
   end select
   end subroutine pc_adams_5_ae
