! ************************************************************* 
!
!   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) : mix_rho
!  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 mix_rho(ier,loop_scf)
!=====================================================================
!
!  M. Okamoto
!
!---------------------------------------------------------------------
   use parameters
   implicit none
   integer,intent(in)  :: loop_scf
   integer,intent(out) :: ier
   integer :: ir, ip, jp, ispin, n_mat, n_vec
   real(8) :: sum, r, g0, gi, gj
   ier = 0
   ispin = 1
   call adjust_rho(ier,IFLOG, &
        nmesh,rpos,wr,rho(1,ispin),felec1,eps_check)
   if (is_spin == POLARIZED) then
      ispin = 2
      call adjust_rho(ier,IFLOG, &
           nmesh,rpos,wr,rho(1,ispin),felec2,eps_check)
   end if
   if (abs(felec1-felec1_old) > eps_check) then
      write(IFLOG,*) '### CAUTION ### felec1 != felec1_old'
      write(IFLOG,*) '   felec1     ...',felec1
      write(IFLOG,*) '   felec1_old ...',felec1_old
      rho_old(:,:) = rho(:,:)
      istart_anderson = loop_scf
      write(IFLOG,*) 'rho_old was reset to rho.'
      write(IFLOG,*) 'istart_anderson was reset to loop_scf.'
      write(IFLOG,*) '   istart_anderson ...',istart_anderson
   end if
   if (n_anderson < 0) then
      write(IFLOG,*) '### ERROR ### n_anderson < 0'
      write(IFLOG,*) '   n_anderson ...',n_anderson
      ier = 1 ; go to 99
   else if (n_anderson == 0) then
      rho(:,:) = (1.d0-mix1)*rho_old(:,:) + mix1*rho(:,:)
   else if (loop_scf-istart_anderson <= n_anderson) then
      do ip = n_anderson,1,-1
         rho_old_p(:,:,ip) = rho_old_p(:,:,ip-1)
         rho_p(:,:,ip)     = rho_p(:,:,ip-1)
      end do
      rho_old_p(:,:,0) = rho_old(:,:)
      rho_p(:,:,0)     = rho(:,:)
      rho(:,:) = (1.d0-mix1)*rho_old(:,:) + mix1*rho(:,:)
   else
LP_SPIN:do ispin = 1,nspin
   do ip = n_anderson,1,-1
      rho_old_p(:,ispin,ip) = rho_old_p(:,ispin,ip-1)
      rho_p(:,ispin,ip)     = rho_p(:,ispin,ip-1)
   end do
   rho_old_p(:,ispin,0) = rho_old(:,ispin)
   rho_p(:,ispin,0)     = rho(:,ispin)
   do ip = 1,n_anderson
      sum = 0.d0
      do ir = 1,nmesh
         r  = rpos(ir)
         g0 = rho_p(ir,ispin, 0) - rho_old_p(ir,ispin, 0)
         gi = rho_p(ir,ispin,ip) - rho_old_p(ir,ispin,ip) - g0
         sum = sum + gi*g0 *r*r*r*r*wr(ir)
      end do
      vec_p(ip,1) = -sum
      do jp = ip,n_anderson
         sum = 0.d0
         do ir = 1,nmesh
            r  = rpos(ir)
            g0 = rho_p(ir,ispin, 0) - rho_old_p(ir,ispin, 0)
            gi = rho_p(ir,ispin,ip) - rho_old_p(ir,ispin,ip) - g0
            gj = rho_p(ir,ispin,jp) - rho_old_p(ir,ispin,jp) - g0
            sum = sum + gi*gj *r*r*r*r*wr(ir)
         end do
         mat_p(ip,jp) = sum ; mat_p(jp,ip) = sum
      end do
   end do
   n_mat = n_anderson ; n_vec = 1
   call axb_real_matrix(ier,n_mat,1,mat_p,coeff_p,vec_p(1,1))
   do ip = 1,n_anderson
      rho_old(:,ispin) = rho_old(:,ispin) &
        + coeff_p(ip) * (rho_old_p(:,ispin,ip) - rho_old_p(:,ispin,0))
      rho(:,ispin) = rho(:,ispin) &
        + coeff_p(ip) * (rho_p(:,ispin,ip) - rho_p(:,ispin,0))
   end do
   do ir = 1,nmesh
      if (rho_old(ir,ispin) < 0.d0) then
         rho_old(ir,ispin) = 0.d0
      end if
      if (rho(ir,ispin) < 0.d0) then
         rho(ir,ispin) = 0.d0
      end if
   end do
   rho(:,ispin) = (1.d0-mix2)*rho_old(:,ispin) + mix2*rho(:,ispin)
end do LP_SPIN
   end if
   ispin = 1
   call adjust_rho(ier,IFLOG, &
        nmesh,rpos,wr,rho(1,ispin),felec1,eps_check)
   if (is_spin == POLARIZED) then
      ispin = 2
      call adjust_rho(ier,IFLOG, &
           nmesh,rpos,wr,rho(1,ispin),felec2,eps_check)
   end if
99 continue
   end subroutine mix_rho
