module m_Potential_mixing
! $Id: m_Potential_Mixing.F90 376 2014-06-17 07:48:31Z jkoga $
!
  use m_Const_Parameters,    only : BUCS, DP, OFF &
       &                          , EXECUT,SIMPLE_CUBIC,BOHR,NO,ANTIFERRO &
       &                          , ANEW,RENEW,ON, SIMPLE,BROYD1,BROYD2,DFP,PULAY &
       &                          , OLD, NEXT, PAI, VTK &
       &                          , DELTA10 &
       &                          , unit_conv_byname, UMICRO, GAMMA, DELTA &
       &                          , ELECTRON, INVERSE, YES, CMPLDP
  use m_IterationNumbers,    only : iteration,iteration_for_cmix
  use m_Parallelization,     only : mpi_comm_group &
       &                          , ista_kngp,iend_kngp,is_kngp,ie_kngp,np_kngp,mp_kngp &
       &                          , npes,mype,ierr &
       &                          , is_kgpm,ie_kgpm,ista_kgpm,iend_kgpm,mp_kgpm &
       &                          , nis_fftp, nie_fftp, myrank_g, nrank_g
  use m_Timing,              only : tstatc0_begin, tstatc0_end
  use m_Control_Parameters,  only : nspin,ipri,ipriwf, c_precon &
       &                          , amix,bmix,hownew,nbxmix,istrbr &
       &                          , kimg,af,neg,ipripulay &
       &                          , iprichargemixing &
       &                          , sw_recomposing, spin_density_mixfactor &
       &                          , amin, sw_precon_diff, sw_metric_diff,metric_ratio &
       &                          , sw_force_simple_mixing,printable

  use m_Crystal_Structure,   only : univol, sw_magnetic_constraint
  use m_PlaneWaveBasisSet,   only : kg,kgp,ngpt_l,ngabc,gr_l,kgpm

  use m_Electronic_Structure, only : vlhxc_l, vlhxco_l => vlhxc_l_old

  use m_Control_Parameters,  only : sw_mix_bothspins_sametime &
                                  , sw_recomposing_hsr, sw_force_simple_mixing_hsr
  use m_Ionic_System,        only : ityp, natm
  use m_PseudoPotential,     only : ilmt, nlmt

! =================================== added by K. Tagami ============== 11.0&13.0U2
  use m_Control_Parameters,  only : ndim_magmom, noncol, sw_mix_imaginary_hardpart, &
       &                            sw_hubbard, sw_mix_charge_hardpart
  use m_PseudoPotential,     only : ipaw, flg_paw,  dion_scr_noncl, dion_scr_noncl_old, &
       &                            dion_paw, dion_paw_old
  use m_Electronic_Structure, only : vlhxcQ, vlhxcQ_old, dhub, dhub_aimag
  use m_ES_Mag_Constraint,   only : MagField_constrain_hardpart
! ===================================================================== 11.0&13.0U2

  use m_Control_Parameters,  only : sw_gradient_simplex, alpha_pulay

  implicit none

  real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
  real(kind=DP), allocatable, dimension(:,:,:) :: vlhxcstore_l, vlhxcostore_l

  real(kind=DP),private,pointer, dimension(:,:,:) ::       rho,rhoo  ! MPI
  !         rho => vlhxc_l, rhoo => vlhxco_l ( when kgpm == kgp)
  !         rho and rhoo is projected from vlhxc_l and vlhxco_l, respectively ( otherwise)

  real(kind=DP),private,allocatable,dimension(:,:,:,:) :: rhoj,Frhoj
  real(kind=DP),private,allocatable,dimension(:,:,:)   :: rhojo,Frhojo
  real(kind=DP),private,allocatable,dimension(:,:,:)   :: rhoj_vhsr,Frhoj_vhsr
  real(kind=DP),private,allocatable,dimension(:,:)   :: rhoj_vhsro,Frhoj_vhsro

! === DEBUG by tkato 2011/09/09 ================================================
! real(kind=DP),private, pointer, dimension(:,:)        :: work
! ==============================================================================

!!$  integer, private,parameter   :: n_ratio_q1 = 20
  integer, private             :: n_ratio_q1 = 20
  real(DP),private,parameter   :: q0_default = 1.5*BOHR
  real(DP),private             :: amix_cprec, bmix_cprec
  logical, private             :: param_cprecon_decided = .false.
  real(DP),private             :: q0 = -1.d0, q1 = -1.d0
  real(DP),private,save        :: fg2, frg2

! --> T. Yamasaki, 03rd Aug. 2009
!!  real(DP),private,pointer,dimension(:,:)     :: c_p !d(ista_kngp:iend_kngp,nspin/(af+1))
  real(DP),public,pointer,dimension(:,:)     :: c_p !d(ista_kngp:iend_kngp,nspin/(af+1))

  real(DP),private,pointer,dimension(:,:)     :: c_pm !d(ista_kgpm:iend_kgpm,nspin/(af+1))
! <--

  ! -- For Broyden and DFP mixing method --
  integer, private,parameter                :: iU = 1, iVD = 1, iW = 2, iY = 2, iV = 2
  integer, private                          :: nspin_m
  real(DP),private,allocatable,dimension(:) :: f_p !d(ista_kgpm:iend_kgpm)
  real(DP),private,allocatable,dimension(:,:,:) :: d0_l,u_l,v_l,w_l,dout,dd_l
  real(DP),private,pointer,dimension(:,:,:)         :: F_l
  real(DP),private,allocatable,target,dimension(:,:,:) :: din
  !                                             d(kgpm,kimg,nspin_m)
  real(DP),private,allocatable,dimension(:,:,:)     :: dF_l
  !     dF_l(deltaF):= \Delta \cal F^{m} = \cal F^{m} - \cal F^{m-1}
  !              = F[\rho^{m}] - F[\rho^{m-1}] - (\rho^{m} - \rho^{m-1})
  real(DP),private,allocatable,target,dimension(:,:,:,:,:) :: urec_l
  real(DP),private,allocatable,dimension(:,:,:)     :: f      !d(nbxmix,nbxmix,nspin)
  real(DP),private,allocatable,dimension(:)         :: g      !d(nbxmix)
  !    f and g are used only when hownew == RENEW
  integer, private,allocatable,dimension(:)         :: ncrspd !d(nbxmix)
  real(DP),private,allocatable,dimension(:,:,:)     :: uuf    !d(nbxmix,nspin,2),
                                                   !only for DFP method
  real(DP),private,allocatable,dimension(:,:)       :: uuf_p
  real(DP),private,allocatable,dimension(:,:)       :: g_p
  real(DP),private,allocatable,dimension(:)         :: prj_wk
#ifdef _CDMIX_USE_POINTER_
! Tsuyoshi Miyazaki tmp
  real(DP),private,pointer,dimension(:,:,:)         :: urec_l_3
  real(DP),private,pointer,dimension(:,:,:)         :: urec_l_3_2
#endif

  logical          :: force_dealloc = .false.
  integer, private :: previous_waymix = 0

  include 'mpif.h'
  integer istatus(mpi_status_size)

! ========================== adde by K. Tagami ========================== 5.0
  integer :: nsize_rho_vhsr
  integer, private, allocatable :: imap_vhsr(:)    ! d(nsize_rho_vhsr)
  real(kind=DP),private,allocatable, dimension(:,:) ::   rho_vhsr, rhoo_vhsr
                                                  ! d(nsize_rho_vhsr,nspin)

  real(DP),private,allocatable,dimension(:,:) :: d0_vhsr, u_vhsr, v_vhsr, w_vhsr, &
        &                                        dout_vhsr, dd_vhsr
  real(DP),private,pointer,dimension(:,:)         :: FF_vhsr
  real(DP),private,allocatable,target,dimension(:,:) :: din_vhsr
  !                                             d( nsize_rho_vhsr,nspin_m)
  real(DP),private,allocatable,dimension(:,:)     :: dF_vhsr
  real(DP),private,allocatable,target,dimension(:,:,:,:) :: urec_vhsr

  logical, save :: first = .true.

  real(kind=DP), allocatable :: vnonlocal_store(:,:,:,:)
  real(kind=DP), allocatable :: vnonlocal_old_store(:,:,:,:)
  real(kind=DP), allocatable :: dion_paw_store(:,:,:,:)
  real(kind=DP), allocatable :: dion_paw_old_store(:,:,:,:)
!
  real(kind=DP), allocatable :: rho_store(:,:), vhsr(:,:,:,:)
  real(kind=DP), allocatable :: rhoo_store(:,:), vhsro(:,:,:,:)

! ==============================================================

! ========================== adde by K. Tagami ========================== 11.0
  integer :: nsize_rho_vhsr_unit
!  integer :: sw_mix_imaginary_hardpart = OFF
!  integer :: sw_mix_imaginary_hardpart = ON
! ======================================================================= 11.0

! =======
  real(kind=DP), allocatable :: vnonlocal_r(:,:,:,:), vnonlocal_r_old(:,:,:,:)
  real(kind=DP), allocatable :: vnonlocal_i(:,:,:,:), vnonlocal_i_old(:,:,:,:)
! ======

! --- contained subroutines ---
!   7. m_Pot_prepare_precon       <-(Potential_Mixing)
!  10. m_Pot_simple_mixing        <-(Potential_Mixing)
!  22. precon_4_pot_mix       <-(@10), (@53),(@54),(@55),(@60)
!  23. precon_4_mult             <-(@37),(@45),(48)
!  24. iter_from_reset           <-(@53),(@54),(@55),(@60)
!  25. icrspd_is                 <-(@53),(@54),(@55)
!  26. mult1s                    <-(@49),(@50),(@51),(@53),(@54),(@55),(@60)
!  27. mult1s5                   <-(@53),(@55),(@60)
!  28. mult1s10                  <-(@60)
!  29. subtr_j_th_term           <-(@49),(@50),(@53),(@55)
!  30. store_to_urec2            <-(@53),(@55)
!  31. set_ncrspd_mxiter_etc     <-(@53),(@54),(@55)
!    - rotate_cmix_arrays
!  32. simple_mix1               <-(@53),(@54),(@55),(@60)
!  33. scatter_chg_onto_d        <-(@32),(@40),(@51)
!  34. scatter_cp_onto_cpm       <-(@23),(@40)
!  35. concentrate_d_to_chg      <-(@51),(@55),(@60)
!  36. mix_dealloc_previous      <-(@53),(@54),(@55),(@60)
!  37. mix_broyden_allocate      <-(@51),(@54)
!  38. mix_broyden_deallocate    <-(@36)
!  39. mix_broyden_alloc2        <-(@54)
!  40. alloc_rho_rhoo_and_cpm    <-(@39),(@43),(@46),(@58)
!  41. mix_broyden_dealloc2      <-(@54)
!  42. dealloc_rho_rhoo_and_cpm  <-(@41),(@44),(@47),(@59)
!  43. mix_broyden_alloc3        <-(@53)
!  44. mix_broyden_dealloc3      <-(@53)
!  45. mix_DFP_allocate          <-(@55)
!  46. mix_DFP_alloc2            <-(@55)
!  47. mix_DFP_dealloc2          <-(@55)
!  -x. devide_v_with_vdF
!  49. renew_u_br                <-(@53),(@54)
!  50. renew_d_br                <-(@53),(@54)
!  51. renew_d_last_br           <-(@53),(@54)
!  52. simple_mix_large_Gc       <-(@51),(@55),(@60)
!  53. m_Pot_mix_broyden1         <-(Potential_Mixing)
!    - dF_F_d0_u_v_and_dd - renew_v
!  54. m_Pot_mix_broyden2         <-(Potential_Mixing)
!    - dF_F_d0_u_and_v
!  55. m_Pot_mix_DFP              <-(Potential_Mixing)
!    - dF_F_d0_u_and_w - renew_w - renew_d - renew_d_last
!  56. mix_pulay_allocate        <-(@60)
!  57. mix_pulay_deallocate      <-(@36)
!  58. mix_pulay_alloc2          <-(@60)
!  59. mix_pulay_dealloc2        <-(@60)
!  60. m_Pot_mix_pulay            <-(Potential_Mixing)
!    - mix_pulay_alloc3 - mix_pulay_dealloc3
!    - Resid_and_dd_into_urec - Ri_dot_Rj - Rj_dot_d
!    - get_finv -get_matrix -renew_d_using_g

contains

! ------------------------------------
  subroutine m_Pot_alloc_array_vnonlocal
    allocate( vnonlocal_r( nlmt,nlmt,natm,ndim_magmom ) )
    vnonlocal_r = 0.0d0
    if ( noncol ) then
       allocate( vnonlocal_i( nlmt,nlmt,natm,ndim_magmom ) )
       vnonlocal_i = 0.0d0
    endif

    if ( sw_mix_charge_hardpart == ON ) then
       allocate( vnonlocal_r_old( nlmt,nlmt,natm,ndim_magmom ) )
       vnonlocal_r_old = 0.0d0
    endif
    if ( noncol .and. sw_mix_imaginary_hardpart == ON ) then
       allocate( vnonlocal_i_old( nlmt,nlmt,natm,ndim_magmom ) )
       vnonlocal_i_old = 0.0d0
    endif
  end subroutine m_Pot_alloc_array_vnonlocal

  subroutine m_Pot_dealloc_array_vnonlocal
    deallocate( vnonlocal_r )
    if ( allocated( vnonlocal_r_old ) ) deallocate( vnonlocal_r_old )

    if ( noncol ) then
       deallocate( vnonlocal_i )
       if ( allocated( vnonlocal_i_old ) ) deallocate( vnonlocal_i_old )
    endif
  end subroutine m_Pot_dealloc_array_vnonlocal

  subroutine m_Pot_add_vnonlocal_to_vlhxcQ
    vlhxcQ = vlhxcQ + vnonlocal_r
  end subroutine m_Pot_add_vnonlocal_to_vlhxcQ

  subroutine m_Pot_cp_vnonlocal_to_old
    vnonlocal_r_old = vnonlocal_r
    if ( noncol .and. sw_mix_imaginary_hardpart == ON ) then
       vnonlocal_i_old = vnonlocal_i
    endif
  end subroutine m_Pot_cp_vnonlocal_to_old

  subroutine m_Pot_set_array_vnonlocal
    integer :: is

    if ( noncol ) then
       vnonlocal_r = 0.0d0;  vnonlocal_i = 0.0d0
       if ( sw_hubbard == ON ) then
          vnonlocal_r = dhub;   vnonlocal_i = dhub_aimag
       endif
       if ( sw_magnetic_constraint == ON ) then
          Do is=2, ndim_magmom
             vnonlocal_r(:,:,:,is) = vnonlocal_r(:,:,:,is) &
                  &               +MagField_constrain_hardpart(:,:,:,is-1)
          End Do
       endif
    else
       vnonlocal_r = 0.0d0
       if ( sw_hubbard == ON ) then
          vnonlocal_r = dhub
       endif
       if ( sw_magnetic_constraint == ON ) then
          vnonlocal_r(:,:,:,1) = vnonlocal_r(:,:,:,1) &
               &                +MagField_constrain_hardpart(:,:,:,1)
          vnonlocal_r(:,:,:,2) = vnonlocal_r(:,:,:,2) &
               &                -MagField_constrain_hardpart(:,:,:,1)
       endif
    endif

  end subroutine m_Pot_set_array_vnonlocal
! ------------------------------------

  subroutine alloc_vlhxcstore_recompos_vlhxc(rmxt,rmxtrc)
    real(kind=DP),intent(in) :: rmxt
    real(kind=DP),intent(out),dimension(nspin_m) :: rmxtrc
#ifdef __TIMER_SUB__
    call timer_sta(1104)
#endif
    allocate(vlhxcstore_l(ista_kngp:iend_kngp,kimg,nspin))
    allocate(vlhxcostore_l(ista_kngp:iend_kngp,kimg,nspin))
#ifdef __TIMER_DO__
  call timer_sta(1149)
#endif
    vlhxcstore_l = vlhxc_l
    vlhxcostore_l = vlhxco_l
    vlhxc_l(:,:,1)  = vlhxcstore_l(:,:,1)  + vlhxcstore_l(:,:,2)
    vlhxc_l(:,:,2)  = vlhxcstore_l(:,:,1)  - vlhxcstore_l(:,:,2)
    vlhxco_l(:,:,1) = vlhxcostore_l(:,:,1) + vlhxcostore_l(:,:,2)
    vlhxco_l(:,:,2) = vlhxcostore_l(:,:,1) - vlhxcostore_l(:,:,2)
#ifdef __TIMER_DO__
  call timer_end(1149)
#endif
    rmxtrc(1) = rmxt
    rmxtrc(2) = rmxt*spin_density_mixfactor
#ifdef __TIMER_SUB__
    call timer_end(1104)
#endif
  end subroutine alloc_vlhxcstore_recompos_vlhxc

  subroutine compos_vlhxc_dealloc_vlhxcstore
#ifdef __TIMER_SUB__
    call timer_sta(1106)
#endif
#ifdef __TIMER_DO__
  call timer_sta(1153)
#endif
    vlhxcstore_l = vlhxc_l
    vlhxc_l(:,:,1) = 0.5d0*(vlhxcstore_l(:,:,1) + vlhxcstore_l(:,:,2))
    vlhxc_l(:,:,2) = 0.5d0*(vlhxcstore_l(:,:,1) - vlhxcstore_l(:,:,2))
    vlhxco_l = vlhxcostore_l
#ifdef __TIMER_DO__
  call timer_end(1153)
#endif
    deallocate(vlhxcostore_l, vlhxcstore_l)
#ifdef __TIMER_SUB__
    call timer_end(1106)
#endif
  end subroutine compos_vlhxc_dealloc_vlhxcstore

  subroutine m_Pot_prepare_precon(nfout,rmxt)
    integer, intent(in)      :: nfout
    real(kind=DP), intent(in):: rmxt
    real(kind=DP) :: G_longest, G_shortest, x, gg,gg_mpi
    integer       :: i, n
    real(kind=DP) :: G_longest_mpi, G_shortest_mpi
    integer       :: ist !mpi

    if(param_cprecon_decided) return
#ifdef __TIMER_SUB__
    call timer_sta(1102)
#endif

    if(iprichargemixing >= 2) write(nfout,*) ' << d_para_cprec >>'

!mpi    G_longest = maxval(gr_l)
!mpi    G_shortest = minval(gr_l(2:kgp))
    G_longest_mpi = maxval(gr_l(ista_kngp:iend_kngp))

    ist = ista_kngp
    if(ist == 1) ist = 2

    G_shortest_mpi = minval(gr_l(ist:iend_kngp))
    call mpi_allreduce(G_longest_mpi,G_longest,1 &
                   &  ,mpi_double_precision,mpi_max,mpi_comm_group,ierr)
    call mpi_allreduce(G_shortest_mpi,G_shortest,1 &
                   &  ,mpi_double_precision,mpi_min,mpi_comm_group,ierr)
    if(iprichargemixing >= 2) then
       write(nfout,*) ' G_longest = ', G_longest
       write(nfout,*) ' G_shortest = ', G_shortest
    end if
    amix_cprec = amix; bmix_cprec = bmix
    if(amix_cprec < 0.d0) then
       amix_cprec = rmxt
       if(iprichargemixing >= 2) write(nfout,*) ' amix_cprec = ', amix_cprec
    end if
    if(bmix_cprec < 0.d0) then
       q0 = q0_default
    else
       q0 = bmix_cprec*G_shortest
    end if
    q0 = q0*q0
    if(iprichargemixing >= 2) then
       write(nfout,*) ' bmix_cprec = ', bmix_cprec
       write(nfout,*) ' q0   = ', q0
    end if

    if (metric_ratio>0) n_ratio_q1 = metric_ratio

    x = G_longest**2  - n_ratio_q1*G_shortest**2
    if(x < 0.d0) then
       n = (G_longest/G_shortest)**2 - 1.d0
       if(n <= 0) n = 1
       x = G_longest**2 - n * G_shortest**2
    else
       n = n_ratio_q1
    end if
    if(iprichargemixing >= 2) write(nfout,*) ' n = ', n
    q1 = (n-1) * G_shortest**2 * G_longest**2/x
    q1 = dsqrt(q1)
    if(iprichargemixing >= 2) write(nfout,*) ' q1 = ', q1

    if(nspin == 2 .or. noncol ) then  
       i = 2
!!$       gg = gr_l(i)**2
       gg = 0.d0
       if(ista_kngp <= i .and. i <= iend_kngp) gg = gr_l(i)**2
       if(npes > 1) then
          call mpi_allreduce(gg,gg_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
          gg = gg_mpi
       end if

       if(iprichargemixing >= 2) write(nfout,'(" !! gg = ",d20.8)') gg

       if (amin<=0) then
          amin = 0.d0
       endif
       fg2 = max(gg/(gg+q0),amin)
       frg2 = 1.0d0 + q1**2/gg
       if(iprichargemixing >= 2) then
          write(nfout,*) ' ! amix_cprec = ', amix_cprec, ' fg2 = ', fg2
          write(nfout,*) ' ! amix_cprec*g_S**2/(g_S**2+q0) = ', amix_cprec*fg2
       end if
    else
       fg2 = 0.d0
       frg2 = 0.d0
    endif

    param_cprecon_decided = .true.
#ifdef __TIMER_SUB__
    call timer_end(1102)
#endif
  end subroutine m_Pot_prepare_precon

  subroutine m_Pot_force_dealloc()
    force_dealloc = .true.
  end subroutine m_Pot_force_dealloc

  subroutine m_Pot_simple_mixing(nfout,rmxt)
    integer ,intent(in)      :: nfout
    real(kind=DP),intent(in) :: rmxt

    integer       :: is, k
    integer       :: id_sname = -1
#ifdef __TIMER_SUB__
    call timer_sta(1103)
#endif

! ================================ modified by K. Tagami =============== 11.0
!!! --> T. Yamasaki  03 Aug. 2009
!!    nspin_m  = nspin/(af+1)
!!! <--
!
    if ( noncol ) then
       nspin_m = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ====================================================================== 11.0

    call tstatc0_begin('m_Pot_simple_mixing ',id_sname,1)

    if(previous_waymix /= SIMPLE.or.force_dealloc) then
       call mix_dealloc_previous()
! ------------------------------  ktDEBUG -------------------- 20121030
       call mix_dealloc_previous_vhsr()
! ------------------------------  ktDEBUG -------------------- 20121030
       force_dealloc = .false.
    end if

! ================================ modified by K. Tagami =============== 11.0
!! --> T. Yamasaki  03 Aug. 2009
!    allocate(rmxtrc(nspin_m))
!
!    if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
!       call alloc_vlhxcstore_recompos_vlhxc(rmxt,rmxtrc) ! --> vlhxc_l, vlhxco_l, rmxtrc
!    else
!       rmxtrc = rmxt
!    end if
!    if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
!! --> T. Yamasaki  03 Aug. 2009
!
!
    allocate(rmxtrc(nspin_m))

    if ( noncol ) then
       rmxtrc = rmxt
    else
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vlhxcstore_recompos_vlhxc(rmxt,rmxtrc) ! --> vlhxc_l, vlhxco_l, rmxtrc
       else
          rmxtrc = rmxt
       endif
    end if
    if(ipri >= 2) write(nfout,'(" rmxt = ",d20.8)') rmxt
! ====================================================================== 11.0

!!$    allocate(c_p(ista_kngp:iend_kngp))
    allocate(c_p(ista_kngp:iend_kngp,nspin_m))
    c_p = 0.0d0                 ! ===== Adde by K. Tagami =========


! ================================ modified by K. Tagami =============== 11.0
!!    call precon_4_pot_mix(rmxtrc,c_p)
!
    if ( noncol ) then
       call precon_4_pot_mix_noncl(rmxtrc,c_p)
!       write(*,*) 'rmxtrc = ', rmxtrc
!       write(*,*) 'cp = ', c_p
!       stop
    else
       call precon_4_pot_mix(rmxtrc,c_p)
!       write(*,*) 'rmxtrc = ', rmxtrc
!       write(*,*) 'cp = ', c_p
!       stop
    endif
! ======================================================================= 11.0


#ifdef __TIMER_DO__
  call timer_sta(1148)
#endif
! ================================ modified by K. Tagami ================ 11.0
!!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       do k = 1, kimg
          vlhxc_l(:,k,is) = c_p(:,is)*vlhxc_l(:,k,is) + (1.0d0-c_p(:,is))*vlhxco_l(:,k,is)
       end do
    end do
#ifdef __TIMER_DO__
  call timer_end(1148)
#endif
    deallocate(c_p)

!
    if ( .not. noncol ) then
       if (sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call compos_vlhxc_dealloc_vlhxcstore()
       end if
    endif
    deallocate(rmxtrc)

    previous_waymix = SIMPLE
    call tstatc0_end(id_sname)

#ifdef __TIMER_SUB__
    call timer_end(1103)
#endif
  end subroutine m_Pot_simple_mixing

  subroutine precon_4_pot_mix(pmix,c_p)
    real(DP),intent(in),dimension(nspin_m)                       :: pmix
    real(DP),intent(out), dimension(ista_kngp:iend_kngp,nspin_m) :: c_p
    integer              :: i
    real(DP)             :: gg, agg, tmp
    integer              :: ist  !for mpi
    integer              :: is
#ifdef __TIMER_SUB__
    call timer_sta(1105)
#endif

    if(iprichargemixing >= 2) write(6,'("! pmix(precon_4_pot_mix) = ",f8.4)') pmix
    if(c_precon) then
       ist = ista_kngp
       if(ist == 1) ist = 2
       if(nspin_m == 2) then
#ifdef __TIMER_DO__
  call timer_sta(1150)
#endif
          do i = ist, iend_kngp  !for mpi
             gg = gr_l(i)*gr_l(i)
             tmp = max(gg/(gg+q0),amin)
!!$             agg = amix_cprec*gg/(gg+q0)
             agg = amix_cprec*tmp
             c_p(i,1) = agg * pmix(1)
             if (sw_recomposing==ON .and. sw_precon_diff==NO)then
                c_p(i,2) = amix_cprec * pmix(2)
             else
                c_p(i,2) = agg * pmix(2)
             endif
          enddo
#ifdef __TIMER_DO__
  call timer_end(1150)
#endif
          if(mype == 0) then
             c_p(1,1) = amix_cprec*fg2 * pmix(1)
             if (sw_recomposing==ON .and. sw_precon_diff==NO)then
                c_p(1,2) = amix_cprec * pmix(2)
             else
                c_p(1,2) = amix_cprec*fg2 * pmix(2)
             endif
          end if
       else
#ifdef __TIMER_DO__
  call timer_sta(1151)
#endif
          do i = ist, iend_kngp  !for mpi
             gg = gr_l(i)*gr_l(i)
             tmp = max(gg/(gg+q0),amin)
!!$             c_p(i,1) = amix_cprec*gg/(gg+q0) * pmix(1)
             c_p(i,1) = amix_cprec* tmp * pmix(1)
          end do
#ifdef __TIMER_DO__
  call timer_end(1151)
#endif
          if(mype == 0) c_p(1,1) = amix_cprec*fg2 * pmix(1)
       end if
    else
#ifdef __TIMER_DO__
  call timer_sta(1152)
#endif
       do is = 1, nspin, af+1
          c_p(:,is) = pmix(is)
       end do
#ifdef __TIMER_DO__
  call timer_end(1152)
#endif
    endif
#ifdef __TIMER_SUB__
    call timer_end(1105)
#endif
  end subroutine precon_4_pot_mix

! ===================================== added by K. Tagami ================ 11.0
  subroutine precon_4_pot_mix_noncl(pmix,c_p)
    real(DP),intent(in),dimension(nspin_m)                       :: pmix
    real(DP),intent(out), dimension(ista_kngp:iend_kngp,nspin_m) :: c_p
    integer              :: i
    real(DP)             :: gg, agg, tmp
    integer              :: ist  !for mpi
    integer              :: is

    if(iprichargemixing >= 2) then
       write(6,'("! pmix(precon_4_pot_mix_noncl) = ",f8.4)') pmix
    end if

    if(c_precon) then
       ist = ista_kngp
       if(ist == 1) ist = 2

       do i = ist, iend_kngp  !for mpi
          gg = gr_l(i)*gr_l(i)
          tmp = max(gg/(gg+q0),amin)
!!$             agg = amix_cprec*gg/(gg+q0)
          agg = amix_cprec*tmp
          c_p(i,:) = agg * pmix(:)
       end do
       if (mype == 0) then
          c_p(1,:) = amix_cprec*fg2 * pmix(:)
       end if
    else
       do is = 1, ndim_magmom
          c_p(:,is) = pmix(is)
       end do
    endif

  end subroutine precon_4_pot_mix_noncl
! ============================================================== 11.0

  subroutine precon_4_mult(f_q)
    real(DP),intent(out), dimension(ista_kgpm:iend_kgpm)   :: f_q
    integer  :: i, ist      !mpi
    real(kind=DP), pointer, dimension(:) :: gr_l_m

    f_q = 0.d0
    if(c_precon ) then
       ist  = ista_kgpm
       if(ist == 1) ist = 2
       if(kgp == kgpm .or. npes == 1) then
          do i = ist, iend_kgpm  !for mpi
             f_q(i) = 1.0d0 + (q1/gr_l(i))**2
          end do
       else
          allocate(gr_l_m(ista_kngp:iend_kngp))
! ============================== by K. Tagami =============
        gr_l_m = 0.0d0
! ========================================================
          call scatter_cp_onto_cpm(gr_l,gr_l_m)
          do i = ist, iend_kgpm  !for mpi
             f_q(i) = 1.0d0 + (q1/gr_l_m(i))**2
          end do
          deallocate(gr_l_m)
       end if
       if(mype==0) f_q(1) = frg2
!mpi       f_q(2:kgpm) = 1 + (q1/gr_l(2:kgpm))**2
!mpi       f_q(1)       = frg2
    else
       f_q          = 1.d0
    end if

  end subroutine precon_4_mult

  function iter_from_reset()
    integer             :: n, nbox
    integer             :: iter_from_reset
    if(hownew ==  ANEW) then
       n = (iteration_for_cmix - istrbr - 1)/(nbxmix-1)
       if(n < 0) n = 0
       nbox = iteration_for_cmix - (n*(nbxmix-1) + istrbr +1) + 2
       iter_from_reset = nbox + istrbr - 1
    else
       iter_from_reset = iteration_for_cmix
    endif
  end function iter_from_reset

  function icrspd_is(iter)
    integer, intent(in) :: iter
    integer             :: icrspd_is
    if(iter-istrbr+1 < nbxmix) then
       icrspd_is = ncrspd(iter-istrbr+1)
    else
       icrspd_is = ncrspd(nbxmix)
    endif
  end function icrspd_is

  subroutine mult1s(u,v,f_q,fmult)
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: u,v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
    real(DP),intent(out),dimension(nspin_m)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,i
#ifdef __TIMER_SUB__
    call timer_sta(1114)
#endif

    fmult = 0.d0

! ================================ modified by K. Tagami ============== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ===================================================================== 11.0

       p = 0.d0
       fac=1.0d0
#ifdef __TIMER_DO__
  call timer_sta(1160)
#endif
       do ik = 1,kimg
          do i = ista_kgpm, iend_kgpm   ! mpi
! ========================================== modified by K. Tagami ======== 11.0
!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
!
             if ( noncol ) then
                fac=f_q(i)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(i)
                endif
             endif
! ======================================================================== 11.0

!             p = p + f_q(i)*u(i,ik,is)*v(i,ik,is)
             p = p + fac*u(i,ik,is)*v(i,ik,is)
          end do
       end do
#ifdef __TIMER_DO__
  call timer_end(1160)
#endif
       if( npes >= 2) then
          call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
          p = p_mpi
       end if
       fmult(is) = p*univol
    enddo
#ifdef __TIMER_SUB__
    call timer_end(1114)
#endif
  end subroutine mult1s

  subroutine mult1s_reduce_spin(u,v,f_q,fmult)
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: u,v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
!!$    real(DP),intent(out),dimension(nspin_m)            :: fmult
    real(DP),intent(out)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,i

    fmult = 0.d0
    p = 0.d0

! ================================ modified by K. Tagami ============== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ===================================================================== 11.0

!!$       p = 0.d0
       fac=1.0d0
       do ik = 1,kimg
          do i = ista_kgpm, iend_kgpm   ! mpi
! ========================================== modified by K. Tagami ======== 11.0
!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
!
             if ( noncol ) then
                fac=f_q(i)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(i)
                endif
             endif
! ======================================================================== 11.0

!             p = p + f_q(i)*u(i,ik,is)*v(i,ik,is)
             p = p + fac*u(i,ik,is)*v(i,ik,is)
          end do
       end do
       if( npes >= 2) then
          call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
          p = p_mpi
       end if
    enddo
    fmult = p
  end subroutine mult1s_reduce_spin

  subroutine mult1s5(u,mb,muv,j,iuv,v,f_q,fmult)
    integer,intent(in) :: mb,muv,j,iuv
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m,mb,muv) :: u
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
    real(DP),intent(out),dimension(nspin_m)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,i

#ifdef __TIMER_SUB__
    call timer_sta(1115)
#endif
    fmult = 0.d0
! ================================ modified by K. Tagami ============== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ===================================================================== 11.0

       p = 0.d0
       fac=1.0d0
#ifdef __TIMER_DO__
  call timer_sta(1162)
#endif
       do ik = 1,kimg
          do i = ista_kgpm, iend_kgpm   ! mpi
! ========================================== modified by K. Tagami ======== 11.0
!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
!
             if ( noncol ) then
                fac=f_q(i)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(i)
                endif
             end if
! ========================================================================= 11.0

             p = p + fac*u(i,ik,is,j,iuv)*v(i,ik,is)
          end do
       end do
#ifdef __TIMER_DO__
  call timer_end(1162)
#endif
       if( npes >= 2) then
          call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
          p = p_mpi
       end if
       fmult(is) = p*univol
    enddo
#ifdef __TIMER_SUB__
    call timer_sta(1115)
#endif
  end subroutine mult1s5

  subroutine mult1s5_reduce_spin(u,mb,muv,j,iuv,v,f_q,fmult)
    integer,intent(in) :: mb,muv,j,iuv
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m,mb,muv) :: u
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m) :: v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
!!$    real(DP),intent(out),dimension(nspin_m)            :: fmult
    real(DP),intent(out)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,i

    fmult = 0.d0
    p = 0.d0

! ================================ modified by K. Tagami ============== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ===================================================================== 11.0

!!$       p = 0.d0
       fac = 1.0d0
       do ik = 1,kimg
          do i = ista_kgpm, iend_kgpm   ! mpi
! ========================================== modified by K. Tagami ======== 11.0
!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(i)
!
             if ( noncol ) then
                fac=f_q(i)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(i)
                endif
             end if
! ========================================================================= 11.0

             p = p + fac*u(i,ik,is,j,iuv)*v(i,ik,is)
          end do
       end do
    enddo
    if( npes >= 2) then
       call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
       p = p_mpi
    end if
    fmult = p*univol
  end subroutine mult1s5_reduce_spin

  subroutine mult1s10(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
    integer,intent(in) :: mb,muv,i,iu,j,iv
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m,mb,muv) :: u,v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
    real(DP),intent(out),dimension(nspin_m)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,ig
#ifdef __TIMER_SUB__
    call timer_sta(1137)
#endif

    fmult = 0.d0

! ====================================== modified by K. Tagami =========== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ======================================================================== 11.0

       p = 0.d0
       fac = 1.0d0
#ifdef __TIMER_DO__
  call timer_sta(1186)
#endif
       do ik = 1,kimg
          do ig = ista_kgpm, iend_kgpm   ! mpi
! ====================================== modified by K. Tagami ============= 11.0
!!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(ig)
!
             if ( noncol ) then
                fac=f_q(ig)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(ig)
                endif
             end if
! ========================================================================== 11.0

             p = p + fac*u(ig,ik,is,i,iu)*v(ig,ik,is,j,iv)
          end do
       end do
#ifdef __TIMER_DO__
  call timer_end(1186)
#endif
       if( npes >= 2) then
          call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
          p = p_mpi
       end if
       fmult(is) = p*univol
    enddo
#ifdef __TIMER_SUB__
    call timer_end(1137)
#endif
  end subroutine mult1s10

  subroutine mult1s10_reduce_spin(u,mb,muv,i,iu,v,j,iv,f_q,fmult)
    integer,intent(in) :: mb,muv,i,iu,j,iv
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm,kimg,nspin_m,mb,muv) :: u,v
    real(DP),intent(in), dimension(ista_kgpm:iend_kgpm):: f_q
    real(DP),intent(out)            :: fmult

    real(DP) :: p, p_mpi, fac
    integer  :: is,ik,ig

    fmult = 0.d0
    p = 0.d0

! ====================================== modified by K. Tagami =========== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ======================================================================== 11.0

!!$       p = 0.d0
       fac = 1.0d0
       do ik = 1,kimg
          do ig = ista_kgpm, iend_kgpm   ! mpi

! ====================================== modified by K. Tagami ============= 11.0
!!             if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) fac=f_q(ig)
!
             if ( noncol ) then
                fac=f_q(ig)
             else
                if (is==1 .or. sw_recomposing==OFF .or. sw_metric_diff==ON) then
                   fac=f_q(ig)
                endif
             end if
! ========================================================================== 11.0

             p = p + fac*u(ig,ik,is,i,iu)*v(ig,ik,is,j,iv)
          end do
       end do
    enddo
    if( npes >= 2) then
       call mpi_allreduce(p,p_mpi,1,mpi_double_precision,mpi_sum,mpi_comm_group,ierr)
       p = p_mpi
    end if
    fmult = p*univol
  end subroutine mult1s10_reduce_spin

  subroutine subtr_j_th_term(f,iuv,j,um)
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP), intent(in),   dimension(nspin) :: f
    real(DP), intent(in),   dimension(nspin_m) :: f
! ==============================================================================
    integer,  intent(in)                     :: iuv,j
    real(DP), intent(inout)                  :: um(ista_kgpm:iend_kgpm,kimg,nspin_m)
    integer :: is, ik, i, istart
#ifdef __TIMER_SUB__
    call timer_sta(1116)
#endif

    istart = ista_kgpm
    if(istart == 1) istart = 2
#ifdef __TIMER_DO__
  call timer_sta(1164)
#endif

! =============================== modified by K. Tagami =================== 11.0
!!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ========================================================================== 11.0

       do ik = 1, kimg
          do i = istart, iend_kgpm   ! mpi
             um(i,ik,is) = um(i,ik,is) - f(is)*urec_l(i,ik,is,j,iuv)
          end do
       end do
    end do
#ifdef __TIMER_DO__
  call timer_end(1164)
#endif
#ifdef __TIMER_SUB__
    call timer_end(1116)
#endif
  end subroutine subtr_j_th_term

  subroutine store_to_urec2(v,f,j,iuv)
    real(DP), intent(in)                     :: v(ista_kgpm:iend_kgpm,kimg,nspin_m)
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP), intent(in),  dimension(nspin)  :: f
    real(DP), intent(in),  dimension(nspin_m)  :: f
! ==============================================================================
    integer , intent(in)                     :: j,iuv

    real(DP)          :: dv
    integer           :: is
#ifdef __TIMER_SUB__
    call timer_sta(1119)
#endif

#ifdef __TIMER_DO__
  call timer_sta(1165)
#endif
! ====================================== modified by K. Tagami ============= 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ========================================================================== 11.0

       dv = 1.d0/f(is)
       urec_l(:,:,is,j,iuv) = v(:,:,is)*dv
    end do
#ifdef __TIMER_DO__
  call timer_end(1165)
#endif
#ifdef __TIMER_SUB__
    call timer_end(1119)
#endif
  end subroutine store_to_urec2

  subroutine set_ncrspd_mxiter_etc(iter,iuv,mxiter)
    integer, intent(in)  :: iuv,iter
    integer, intent(out) :: mxiter
#ifdef __TIMER_SUB__
    call timer_sta(1111)
#endif
    if(hownew == RENEW) then
       if((iter-istrbr+1) >= 3) then
          if((iter-istrbr+1) > nbxmix) then   ! When the box overflows
             call rotate_cmix_arrays          !-(contained here) ->mxiter,ncrspd,urec_l,f,g
          else
             mxiter = (iter-istrbr+1) - 1
             ncrspd(iter-istrbr+1) = iter-istrbr+1
          endif
       else
          mxiter = (iter-istrbr+1) - 1
          ncrspd(1) = 1
          ncrspd(2) = 2
       endif
    else ! if(hownew == ANEW)
       mxiter = (iter-istrbr+1) - 1
       ncrspd(iter-istrbr+1) = iter-istrbr+1
    endif

#ifdef __TIMER_SUB__
    call timer_end(1111)
#endif
  contains
    subroutine rotate_cmix_arrays
      integer :: is,j,i,icr,jcr,iwork
#ifdef __TIMER_SUB__
    call timer_sta(1112)
#endif

#ifdef __TIMER_DO__
  call timer_sta(1158)
#endif
! ======================================= modified by K. Tagami ========= 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0

         do j = 3, nbxmix
            icr = ncrspd(2)
            jcr = ncrspd(j)
            g(j) = f(icr,jcr,is)
            do i = 3, j-1
               icr = ncrspd(i)
               g(j) = g(j) - f(icr,jcr,is)*g(i)
            enddo
            icr = ncrspd(2)
            urec_l(:,:,is,jcr,iuv) &
                 & = urec_l(:,:,is,jcr,iuv) + g(j)*urec_l(:,:,is,icr,iuv)
         enddo
      enddo
#ifdef __TIMER_DO__
  call timer_end(1158)
#endif
      mxiter = nbxmix-1
      iwork = ncrspd(2)
#ifdef __TIMER_DO__
  call timer_sta(1159)
#endif
      do i = 2, mxiter
         ncrspd(i)= ncrspd(i+1)
      end do
#ifdef __TIMER_DO__
  call timer_end(1159)
#endif
      ncrspd(mxiter+1) = iwork
#ifdef __TIMER_SUB__
    call timer_end(1112)
#endif
    end subroutine rotate_cmix_arrays
  end subroutine set_ncrspd_mxiter_etc

  subroutine simple_mix2(p)
    real(DP), intent(in), dimension(ista_kngp:iend_kngp,nspin_m) :: p
    integer  :: is,k

! ==================================== added by K. Tagami ============ 11.0
    if ( noncol ) return
! ===================================================================11.0

    if(nspin<2 .or. af==1) return

    if(kgpm == kgp .or. npes == 1) then
!!$       write(6,'(" ! kgpm == kgp")')
       do is = 2, 2
          din (ista_kgpm:iend_kgpm,:,is) = vlhxco_l(ista_kgpm:iend_kgpm,:,is)
          dout(ista_kgpm:iend_kgpm,:,is) = vlhxc_l (ista_kgpm:iend_kgpm,:,is)
       end do
    else
       call scatter_chg_onto_d(vlhxco_l,din )  ! -(m_C.D.)
       call scatter_chg_onto_d(vlhxc_l, dout)  ! -(m_C.D.)
    end if

    do is = 2,2
       do k = 1, kimg
          vlhxc_l(:,k,is) = p(:,is)*vlhxc_l(:,k,is) + (1.0d0-p(:,is))*vlhxco_l(:,k,is)
       end do
    end do
  end subroutine simple_mix2

  subroutine simple_mix1(p)
    real(DP), intent(in), dimension(ista_kngp:iend_kngp,nspin_m) :: p
    integer  :: is,k
#ifdef __TIMER_SUB__
    call timer_sta(1108)
#endif

    if(kgpm == kgp .or. npes == 1) then
!!$       write(6,'(" ! kgpm == kgp")')
#ifdef __TIMER_DO__
  call timer_sta(1154)
#endif
! ========================= modified by K. Tagami ==================== 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ==================================================================== 11.0

          din (ista_kgpm:iend_kgpm,:,is) = vlhxco_l(ista_kgpm:iend_kgpm,:,is)
          dout(ista_kgpm:iend_kgpm,:,is) = vlhxc_l (ista_kgpm:iend_kgpm,:,is)
       end do
#ifdef __TIMER_DO__
  call timer_end(1154)
#endif
    else
       call scatter_chg_onto_d(vlhxco_l,din )  ! -(m_C.D.)
       call scatter_chg_onto_d(vlhxc_l, dout)  ! -(m_C.D.)
    end if

#ifdef __TIMER_DO__
  call timer_sta(1155)
#endif
! ========================= modified by K. Tagami ==================== 11.0
!    do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ==================================================================== 11.0
       do k = 1, kimg
          vlhxc_l(:,k,is) = p(:,is)*vlhxc_l(:,k,is) + (1.0d0-p(:,is))*vlhxco_l(:,k,is)
       end do
    end do
#ifdef __TIMER_DO__
  call timer_end(1155)
#endif

#ifdef __TIMER_SUB__
    call timer_end(1108)
#endif
  end subroutine simple_mix1

  subroutine scatter_chg_onto_d(c,d)
! ================================== modified by K. Tagami ============= 11.0
!    real(DP),intent(in), dimension(ista_kngp:iend_kngp,kimg,nspin) :: c
!    real(DP),intent(out),dimension(ista_kgpm:iend_kgpm,kimg,nspin) :: d
!
    real(DP),intent(in), dimension(ista_kngp:iend_kngp,kimg,ndim_magmom) :: c
    real(DP),intent(out),dimension(ista_kgpm:iend_kgpm,kimg,ndim_magmom) :: d
! ======================================================================= 11.0

    integer :: ip,is,istart,iend,nelmnt,i,ik,ipbase
#ifdef __TIMER_SUB__
    call timer_sta(1121)
#endif

    nelmnt = mp_kngp*kimg*nspin_m
    prj_wk = 0.d0
    do ip = 0, npes - 1
       ! (1)  coping input data onto a work array, and broadcasting
       if(is_kngp(ip) > kgpm) exit
#ifdef __TIMER_DO__
  call timer_sta(1168)
#endif
       if(ip == mype) then

! =============================== modified by K. Tagami ============== 11.0
!          do is = 1, nspin, af+1
          do is = 1, ndim_magmom, af+1
! ==================================================================== 11.0

             do ik = 1, kimg
                ipbase = mp_kngp*(ik-1) + mp_kngp*kimg*(is-1)
                do i = 1, iend_kngp-ista_kngp+1
                   prj_wk(i + ipbase) = c(ista_kngp-1+i,ik,is)
!!$                   prj_wk(i,ik,is) = c(ista_kngp-1+i,ik,is)
                end do
             end do
          end do
       end if
#ifdef __TIMER_DO__
  call timer_end(1168)
#endif
       call mpi_bcast(prj_wk,nelmnt,mpi_double_precision,ip,mpi_comm_group,ierr)

       ! (2) projection
       istart = ista_kgpm; if(istart < is_kngp(ip)) istart = is_kngp(ip)
       iend   = iend_kgpm; if(iend   > ie_kngp(ip)) iend   = ie_kngp(ip)
       if(iend < istart) cycle
#ifdef __TIMER_DO__
  call timer_sta(1170)
#endif
! ====================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! =========================================================================== 11.0

          do ik = 1, kimg
             ipbase = mp_kngp*(ik-1) + mp_kngp*kimg*(is-1)
             do i = istart, iend
                d(i,ik,is) = prj_wk(i + ipbase)
!!$                d(i,ik,is) = prj_wk(i - is_kngp(ip)+1,ik,is)
             end do
          end do
!!$          d(istart:iend,:,is) = prj_wk(istart-is_kngp(ip)+1:iend-is_kngp(ip)+1,:,is)
       end do
#ifdef __TIMER_DO__
  call timer_end(1170)
#endif
    end do
#ifdef __TIMER_SUB__
    call timer_end(1121)
#endif
  end subroutine scatter_chg_onto_d

  subroutine scatter_cp_onto_cpm(cp,cpm)
    real(DP),intent(in), dimension(ista_kngp:iend_kngp,nspin_m) :: cp
    real(DP),intent(out),dimension(ista_kgpm:iend_kgpm,nspin_m) :: cpm

    integer :: ip,istart,iend,i, is, ibase, nelmnt

! --> T. Yamasaki, 03rd Aug. 2009
    nelmnt = mp_kngp*nspin_m
! <--
!!$    print '(" -- scatter_cp_onto_cpm -- ")'
    do ip = 0, npes - 1
       ! (1)  coping input data onto a work array, and broadcasting
       if(is_kngp(ip) > kgpm) exit
       if(ip == mype) then
! --> T. Yamasaki, 03rd Aug. 2009

! ============================= modified by K. Tagami ================= 11.0
!          do is = 1, nspin, af+1
          do is = 1, ndim_magmom, af+1
! ==================================================================== 11.0

             ibase = mp_kngp*(is-1)
             do i = 1, iend_kngp-ista_kngp+1
                prj_wk(i+ibase) = cp(ista_kngp-1+i,is)
             end do
          end do
!!$          do i = 1, iend_kngp-ista_kngp+1
!!$             prj_wk(i)     = cp(ista_kngp-1+i)
!!$!!$             prj_wk(i,1,1) = cp(ista_kngp-1+i)
!!$          end do
       end if
!!$       call mpi_bcast(prj_wk,mp_kngp,mpi_double_precision,ip,mpi_comm_group,ierr)
       call mpi_bcast(prj_wk,mp_kngp*nspin_m,mpi_double_precision,ip,mpi_comm_group,ierr)
! <--
       ! (2) projection
       istart = ista_kgpm; if(istart < is_kngp(ip)) istart = is_kngp(ip)
       iend   = iend_kgpm; if(iend   > ie_kngp(ip)) iend   = ie_kngp(ip)
       if(iend < istart) cycle
! --> T. Yamasaki, 03rd Aug. 2009

! ==================================== modified by K. Tagami ============== 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ========================================================================= 11.0
          ibase = mp_kngp*(is-1)
          do i = istart, iend
             cpm(i,is) = prj_wk(i + ibase)
          end do
       end do
!!$       do i = istart, iend
!!$          cpm(i) = prj_wk(i - is_kngp(ip)+1)
!!$!!$          cpm(i) = prj_wk(i -is_kngp(ip)+1,1,1)
!!$       end do
!!$!!$       cpm(istart:iend) = prj_wk(istart-is_kngp(ip)+1:iend-is_kngp(ip)+1,1,1)
! <--
    end do
  end subroutine scatter_cp_onto_cpm

  subroutine concentrate_d_to_chg(d,c)
! ============================= modified by K. Tagami ====================== 11.0
!    real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,kimg,nspin) :: d
!    real(DP),intent(out), dimension(ista_kngp:iend_kngp,kimg,nspin) :: c
    real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,kimg,ndim_magmom) :: d
    real(DP),intent(out), dimension(ista_kngp:iend_kngp,kimg,ndim_magmom) :: c
! =========================================================================== 11.0

    integer :: ip,is,istart,iend,nelmnt,ik,i,ip2,ipbase
!!$    integer :: istart_p, iend_p

#ifdef __TIMER_SUB__
    call timer_sta(1122)
#endif
    if(kgpm < kgp .and. npes /= 1) then
       nelmnt = mp_kgpm*kimg*nspin_m
       do ip = 0, npes - 1
          if(is_kngp(ip) > kgpm) exit
          do ip2 = 0, npes - 1
             istart = is_kgpm(ip2); if(istart < is_kngp(ip)) istart = is_kngp(ip)
             iend   = ie_kgpm(ip2); if(iend   > ie_kngp(ip)) iend   = ie_kngp(ip)
             if(iend < istart) cycle
             if(mype == ip2) then
#ifdef __TIMER_DO__
  call timer_sta(1171)
#endif
! ================================ modified by K. Tagami ================= 11.0
!                do is = 1, nspin, af+1
                do is = 1, ndim_magmom, af+1
! ======================================================================== 11.0
                   do ik = 1, kimg
                      ipbase = mp_kgpm*(ik-1) + mp_kgpm*kimg*(is-1) - istart + 1
                      do i = istart, iend
                         prj_wk(i+ipbase) = d(i,ik,is)
                      end do
                   end do
                end do
#ifdef __TIMER_DO__
  call timer_end(1171)
#endif
                call mpi_send(prj_wk,nelmnt,mpi_double_precision,ip,1,mpi_comm_group,ierr)
             end if
             if(mype == ip) then
                call mpi_recv(prj_wk,nelmnt,mpi_double_precision,ip2,1,mpi_comm_group,istatus,ierr)
#ifdef __TIMER_DO__
  call timer_sta(1173)
#endif
! ================================ modified by K. Tagami ================= 11.0
!                do is = 1, nspin, af+1
                do is = 1, ndim_magmom, af+1
! ======================================================================== 11.0
                   do ik = 1, kimg
                      ipbase = mp_kgpm*(ik-1) + mp_kgpm*kimg*(is-1) - istart + 1
                      do i = istart, iend
                         c(i,ik,is) = prj_wk(i+ipbase)
                      end do
                   end do
                end do
#ifdef __TIMER_DO__
  call timer_end(1173)
#endif
             end if
             call mpi_barrier(mpi_comm_group,ierr)
          end do
       end do
    end if
#ifdef __TIMER_SUB__
    call timer_end(1122)
#endif
  end subroutine concentrate_d_to_chg

  subroutine mix_dealloc_previous()
    if(previous_waymix == BROYD2) then
       call mix_broyden_deallocate()
    else if(previous_waymix == PULAY) then
       call mix_PULAY_deallocate()
    end if
  end subroutine mix_dealloc_previous

  subroutine mix_broyden_allocate
!!$    if(allocated(f_p)) return

! ========================= modified by K. Tagami =================== 11.0
!    nspin_m  = nspin/(af+1)
!
    if ( noncol ) then
       nspin_m  = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ====================================================================== 11.0

! ================================ Modofied by K. Tagami ===========
!    allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_Pot)
    allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0.0d0
    call precon_4_mult(f_p) !-(m_Pot)
! ================================================================
    allocate(din(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(dout(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(dF_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(urec_l(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix,2))
    allocate(prj_wk(mp_kngp*kimg*nspin_m))
! ======================================Added by K. Tagami ========
    din = 0.0d0; dout = 0.0d0; dF_l = 0.0d0; urec_l = 0.0d0; prj_wk = 0.0d0
! ==================================================================
    if(hownew == RENEW) then
! ============================= modified by K. Tagami =========== 11.0
!       allocate(f(nbxmix,nbxmix,nspin))
!
       if ( noncol ) then
          allocate(f(nbxmix,nbxmix,ndim_magmom))
       else
          allocate(f(nbxmix,nbxmix,nspin))
       endif
! =============================================================== 11.0
       allocate(g(nbxmix))
! ================================= Added by K. Tagami ==========
        f = 0.0d0; g = 0.0d0
! ==============================================================
    end if
    allocate(ncrspd(nbxmix))
! ================================= Added by K. Tagami ==========
        ncrspd = 0
! ==============================================================
  end subroutine mix_broyden_allocate

  subroutine mix_broyden_deallocate
    if(allocated(f_p)) deallocate(f_p)
    if(allocated(din)) deallocate(din)
    if(allocated(dout)) deallocate(dout)
    if(allocated(dF_l)) deallocate(dF_l)
    if(allocated(urec_l)) deallocate(urec_l)
    if(allocated(prj_wk)) deallocate(prj_wk)
    if(allocated(f)) deallocate(f)
    if(allocated(g)) deallocate(g)
    if(allocated(ncrspd)) deallocate(ncrspd)
  end subroutine mix_broyden_deallocate

  subroutine mix_broyden_alloc2
    allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(u_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(v_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
! =========================================== Added by K. Tagami =======
    d0_l = 0; u_l = 0; v_l = 0
! =======================================================================
    call alloc_rho_rhoo_and_cpm
  end subroutine mix_broyden_alloc2

  subroutine alloc_rho_rhoo_and_cpm
    if(kgpm < kgp .and. npes /= 1 ) then
       allocate(rho(ista_kgpm:iend_kgpm,kimg,nspin_m))
       allocate(rhoo(ista_kgpm:iend_kgpm,kimg,nspin_m))
       allocate(c_pm(ista_kgpm:iend_kgpm,nspin_m))
! ============================================= Added by K. Tagami ======
       rho = 0.0d0; rhoo = 0.0d0 ; c_pm = 0.0d0
! =======================================================================
       call scatter_chg_onto_d(vlhxc_l,rho)
       call scatter_chg_onto_d(vlhxco_l,rhoo)
       call scatter_cp_onto_cpm(c_p,c_pm)
    else
       rho => vlhxc_l; rhoo => vlhxco_l; c_pm => c_p
    end if
  end subroutine alloc_rho_rhoo_and_cpm

  subroutine mix_broyden_dealloc2
    deallocate(d0_l); deallocate(u_l); deallocate(v_l)
    call dealloc_rho_rhoo_and_cpm
  end subroutine mix_broyden_dealloc2

  subroutine dealloc_rho_rhoo_and_cpm
    if(kgpm < kgp .and. npes /= 1) deallocate(rho)
    if(kgpm < kgp .and. npes /= 1) deallocate(rhoo)
    if(kgpm < kgp .and. npes /= 1) deallocate(c_pm)
  end subroutine dealloc_rho_rhoo_and_cpm

  subroutine mix_broyden_alloc3
#ifdef __TIMER_SUB__
    call timer_sta(1109)
#endif
    allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(u_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(v_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(dd_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
! =========================================== Added by K. Tagami ===
    d0_l = 0.0d0; u_l = 0.0d0; v_l = 0.0d0; dd_l = 0.0d0
! =================================================================
    call alloc_rho_rhoo_and_cpm
#ifdef __TIMER_SUB__
    call timer_end(1109)
#endif
  end subroutine mix_broyden_alloc3

  subroutine mix_broyden_dealloc3
    deallocate(d0_l); deallocate(u_l); deallocate(v_l); deallocate(dd_l)
    call dealloc_rho_rhoo_and_cpm
  end subroutine mix_broyden_dealloc3

!!! ========================== added by K. Tagami ================ 5.0
  subroutine alloc_rhostore_recomp( rmxt, rmxtrc )
    real(kind=DP),intent(in) :: rmxt
    real(kind=DP),intent(out),dimension(nspin_m) :: rmxtrc

    allocate( rhoo_store( nsize_rho_vhsr,nspin) )
    allocate( rho_store( nsize_rho_vhsr,nspin) )

    rho_store = rho_vhsr;      rhoo_store = rhoo_vhsr

     rho_vhsr(:,1) =  rho_store(:,1) +  rho_store(:,2)
     rho_vhsr(:,2) =  rho_store(:,1) -  rho_store(:,2)
    rhoo_vhsr(:,1) = rhoo_store(:,1) + rhoo_store(:,2)
    rhoo_vhsr(:,2) = rhoo_store(:,1) - rhoo_store(:,2)
    rmxtrc(1) = rmxt;     rmxtrc(2) = rmxt*spin_density_mixfactor

  end subroutine alloc_rhostore_recomp

  subroutine compose_rho_dealloc_store
    rho_store = rho_vhsr

    rho_vhsr(:,1) = 0.5d0*( rho_store(:,1) + rho_store(:,2) )
    rho_vhsr(:,2) = 0.5d0*( rho_store(:,1) - rho_store(:,2) )

    rhoo_vhsr(:,1) = 0.5d0*( rhoo_store(:,1) + rhoo_store(:,2) )
    rhoo_vhsr(:,2) = 0.5d0*( rhoo_store(:,1) - rhoo_store(:,2) )

!    rhoo_vhsr = rhoo_store
    deallocate( rho_store, rhoo_store )

  end subroutine compose_rho_dealloc_store

! ====== Have to change --
  subroutine alloc_vhsrstore_recomp( rmxt, rmxtrc )
    real(kind=DP),intent(in) :: rmxt
    real(kind=DP),intent(out),dimension(nspin_m) :: rmxtrc

    allocate( vnonlocal_store ( nlmt, nlmt, natm, nspin ) )
    allocate( vnonlocal_old_store( nlmt, nlmt, natm, nspin ) )
    vnonlocal_store = 0.0d0;  vnonlocal_old_store = 0.0d0
!
    vnonlocal_store = vnonlocal_r;  
    vnonlocal_old_store = vnonlocal_r_old

    vnonlocal_r(:,:,:,1) = vnonlocal_store(:,:,:,1) +vnonlocal_store(:,:,:,2)
    vnonlocal_r(:,:,:,2) = vnonlocal_store(:,:,:,2) -vnonlocal_store(:,:,:,2)
    vnonlocal_r_old(:,:,:,1) = vnonlocal_old_store(:,:,:,1) +vnonlocal_old_store(:,:,:,2)
    vnonlocal_r_old(:,:,:,2) = vnonlocal_old_store(:,:,:,1) -vnonlocal_old_store(:,:,:,2)

    if ( flg_paw ) then
       allocate( dion_paw_store ( nlmt, nlmt, nspin, natm ) )
       allocate( dion_paw_old_store( nlmt, nlmt, nspin, natm ) )
       dion_paw_store = 0.0d0;  dion_paw_old_store = 0.0d0

       dion_paw_store = dion_paw
       dion_paw_old_store = dion_paw_old
!
       dion_paw(:,:,1,:) = dion_paw_store(:,:,1,:) +dion_paw_store(:,:,2,:)
       dion_paw(:,:,2,:) = dion_paw_store(:,:,2,:) -dion_paw_store(:,:,2,:)
       dion_paw_old(:,:,1,:) = dion_paw_old_store(:,:,1,:) +dion_paw_old_store(:,:,2,:)
       dion_paw_old(:,:,2,:) = dion_paw_old_store(:,:,2,:) -dion_paw_old_store(:,:,2,:)
    endif
! --
    
    rmxtrc(1) = rmxt;     rmxtrc(2) = rmxt*spin_density_mixfactor
  end subroutine alloc_vhsrstore_recomp

  subroutine compose_vhsr_dealloc_store
    vnonlocal_store = vnonlocal_r
    vnonlocal_old_store = vnonlocal_r_old

    vnonlocal_r(:,:,:,1) = vnonlocal_store(:,:,:,1) +vnonlocal_store(:,:,:,2)
    vnonlocal_r(:,:,:,2) = vnonlocal_store(:,:,:,2) -vnonlocal_store(:,:,:,2)
    vnonlocal_r_old(:,:,:,1) = vnonlocal_old_store(:,:,:,1) +vnonlocal_old_store(:,:,:,2)
    vnonlocal_r_old(:,:,:,2) = vnonlocal_old_store(:,:,:,1) -vnonlocal_old_store(:,:,:,2)

    vnonlocal_r     = vnonlocal_r     /2.0d0
    vnonlocal_r_old = vnonlocal_r_old /2.0d0

    deallocate( vnonlocal_store, vnonlocal_old_store )

    if ( flg_paw ) then
       dion_paw_store = dion_paw
       dion_paw_old_store = dion_paw_old

       dion_paw(:,:,1,:) = dion_paw_store(:,:,1,:) +dion_paw_store(:,:,2,:)
       dion_paw(:,:,2,:) = dion_paw_store(:,:,2,:) -dion_paw_store(:,:,2,:)
       dion_paw_old(:,:,1,:) = dion_paw_old_store(:,:,1,:) +dion_paw_old_store(:,:,2,:)
       dion_paw_old(:,:,2,:) = dion_paw_old_store(:,:,2,:) -dion_paw_old_store(:,:,2,:)

       dion_paw     = dion_paw     /2.0d0
       dion_paw_old = dion_paw_old /2.0d0

       deallocate( dion_paw_store, dion_paw_old_store )
    endif
! --

  end subroutine compose_vhsr_dealloc_store

 subroutine simple_mix_kt(rmx_this)
    real(kind=DP), intent(in) :: rmx_this(nspin_m)

    din_vhsr   = rhoo_vhsr ! vlhxco
    dout_vhsr  = rho_vhsr  ! vlhxc
    rho_vhsr(:,1) = rmx_this(1) *dout_vhsr(:,1) + ( 1.0D0 - rmx_this(1) )* din_vhsr(:,1)
    if(nspin_m==2) rho_vhsr(:,2) = rmx_this(2) *dout_vhsr(:,2) + ( 1.0D0 - rmx_this(2) )* din_vhsr(:,2)

! ===================== added by K. Tagami ================================ 11.0
    if ( noncol ) then
       rho_vhsr(:,2) = rmx_this(2) *dout_vhsr(:,2) + ( 1.0D0 -rmx_this(2) )* din_vhsr(:,2)
       rho_vhsr(:,3) = rmx_this(3) *dout_vhsr(:,3) + ( 1.0D0 -rmx_this(3) )* din_vhsr(:,3)
       rho_vhsr(:,4) = rmx_this(4) *dout_vhsr(:,4) + ( 1.0D0 -rmx_this(4) )* din_vhsr(:,4)
    endif
! ========================================================================= 11.0

  end subroutine simple_mix_kt

  subroutine simple_mix2_kt(rmx_this)
    real(kind=DP), intent(in) :: rmx_this(nspin_m)

    if(nspin_m==2)then
        din_vhsr(:,2)  = rhoo_vhsr(:,2)         ! vlhxco
       dout_vhsr(:,2)  =  rho_vhsr(:,2)          ! vlhxc
       rho_vhsr(:,2) = rmx_this(2) *dout_vhsr(:,2) + ( 1.0D0 - rmx_this(2) )* din_vhsr(:,2)
    endif
! ===================== added by K. Tagami ================================ 11.0
    if ( noncol ) then
       din_vhsr(:,2)  = rhoo_vhsr(:,2);     dout_vhsr(:,2)  =  rho_vhsr(:,2) 
       rho_vhsr(:,2) = rmx_this(2) *dout_vhsr(:,2) + ( 1.0D0 -rmx_this(2) )* din_vhsr(:,2)
       din_vhsr(:,3)  = rhoo_vhsr(:,3);     dout_vhsr(:,3)  =  rho_vhsr(:,3) 
       rho_vhsr(:,3) = rmx_this(3) *dout_vhsr(:,3) + ( 1.0D0 -rmx_this(3) )* din_vhsr(:,3)
       din_vhsr(:,4)  = rhoo_vhsr(:,4);     dout_vhsr(:,4)  =  rho_vhsr(:,4) 
       rho_vhsr(:,4) = rmx_this(4) *dout_vhsr(:,4) + ( 1.0D0 -rmx_this(4) )* din_vhsr(:,4)
    endif
! ========================================================================== 11.0

  end subroutine simple_mix2_kt

  subroutine mix_dealloc_previous_vhsr()
    if(previous_waymix == BROYD2) then
       call mix_broyden_deallocate_vhsr()
    else if(previous_waymix == PULAY) then
       call mix_PULAY_deallocate_vhsr()
    end if
  end subroutine mix_dealloc_previous_vhsr

  subroutine mix_broyden_allocate_vhsr
! ========================= modified by K. Tagami =================== 11.0
!    nspin_m  = nspin/(af+1)
!
    if ( noncol ) then
       nspin_m  = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ====================================================================== 11.0
    allocate( din_vhsr(nsize_rho_vhsr,nspin_m) )
    allocate( dout_vhsr(nsize_rho_vhsr,nspin_m))
    allocate( dF_vhsr(nsize_rho_vhsr,nspin_m))
    allocate( urec_vhsr(nsize_rho_vhsr,nspin_m,nbxmix,2) )   	
!
    din_vhsr = 0.0d0; dout_vhsr = 0.0d0; dF_vhsr = 0.0d0; urec_vhsr = 0.0d0
!
  end subroutine mix_broyden_allocate_vhsr

  subroutine mix_broyden_deallocate_vhsr
    if(allocated(din_vhsr)) deallocate(din_vhsr)
    if(allocated(dout_vhsr)) deallocate(dout_vhsr)
    if(allocated(dF_vhsr)) deallocate(dF_vhsr)
    if(allocated(urec_vhsr)) deallocate(urec_vhsr)
  end subroutine mix_broyden_deallocate_vhsr

  subroutine mix_broyden_alloc2_vhsr
    allocate( d0_vhsr( nsize_rho_vhsr,nspin_m ) ); d0_vhsr = 0.0d0
    allocate(  u_vhsr( nsize_rho_vhsr,nspin_m ) );  u_vhsr = 0.0d0
    allocate(  v_vhsr( nsize_rho_vhsr,nspin_m ) );  v_vhsr = 0.0d0
  end subroutine mix_broyden_alloc2_vhsr

 subroutine mix_broyden_dealloc2_vhsr
    deallocate(d0_vhsr); deallocate(u_vhsr); deallocate(v_vhsr)
  end subroutine mix_broyden_dealloc2_vhsr

  subroutine mix_broyden_alloc3_vhsr
    allocate( d0_vhsr( nsize_rho_vhsr,nspin_m ) ); d0_vhsr = 0.0d0
    allocate(  u_vhsr( nsize_rho_vhsr,nspin_m ) );  u_vhsr = 0.0d0
    allocate(  v_vhsr( nsize_rho_vhsr,nspin_m ) );  v_vhsr = 0.0d0
    allocate( dd_vhsr( nsize_rho_vhsr,nspin_m ) ); dd_vhsr = 0.0d0
  end subroutine mix_broyden_alloc3_vhsr

  subroutine mix_broyden_dealloc3_vhsr
    deallocate(d0_vhsr); deallocate(u_vhsr); deallocate(v_vhsr); deallocate(dd_vhsr)
  end subroutine mix_broyden_dealloc3_vhsr

 subroutine mix_pulay_allocate_vhsr
! ========================= modified by K. Tagami =================== 11.0
!    nspin_m  = nspin/(af+1)
!
    if ( noncol ) then
       nspin_m  = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ====================================================================== 11.0
    allocate(  din_vhsr( nsize_rho_vhsr,nspin_m ) );  din_vhsr = 0.0d0
    allocate( dout_vhsr( nsize_rho_vhsr,nspin_m ) ); dout_vhsr = 0.0d0
    allocate(   dF_vhsr( nsize_rho_vhsr,nspin_m ) );   dF_vhsr = 0.0d0
    allocate( urec_vhsr( nsize_rho_vhsr,nspin_m,nbxmix,2) ); urec_vhsr = 0.0d0
    if(sw_gradient_simplex==ON)then
       allocate(rhoj_vhsr(nsize_rho_vhsr,nspin_m,nbxmix));rhoj_vhsr=0.d0
       allocate(Frhoj_vhsr(nsize_rho_vhsr,nspin_m,nbxmix));Frhoj_vhsr=0.d0
       allocate(rhoj_vhsro(nsize_rho_vhsr,nspin_m));rhoj_vhsro=0.d0
       allocate(Frhoj_vhsro(nsize_rho_vhsr,nspin_m));Frhoj_vhsro=0.d0
    endif
  end subroutine mix_pulay_allocate_vhsr

  subroutine mix_pulay_deallocate_vhsr
    if ( allocated( din_vhsr)) deallocate( din_vhsr)
    if ( allocated(dout_vhsr)) deallocate(dout_vhsr)
    if ( allocated(  dF_vhsr)) deallocate(  dF_vhsr)
    if ( allocated(urec_vhsr)) deallocate(urec_vhsr)
    if ( allocated(rhoj_vhsr)) deallocate(rhoj_vhsr)
    if ( allocated(Frhoj_vhsr)) deallocate(Frhoj_vhsr)
    if ( allocated(rhoj_vhsro)) deallocate(rhoj_vhsro)
    if ( allocated(Frhoj_vhsro)) deallocate(Frhoj_vhsro)
  end subroutine mix_pulay_deallocate_vhsr

  subroutine mix_pulay_alloc2_vhsr
    allocate( d0_vhsr( nsize_rho_vhsr,nspin_m) ); d0_vhsr = 0.0d0
  end subroutine mix_pulay_alloc2_vhsr

  subroutine mix_pulay_dealloc2_vhsr
    deallocate(d0_vhsr)
  end subroutine mix_pulay_dealloc2_vhsr

! ===================================================================== 5.0

  integer function nspin_for_qnewton()
! ================================= modified by K. Tagami ============= 11.0
!     nspin_for_qnewton=nspin
!     if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) nspin_for_qnewton=1
!
    if ( noncol ) then
       nspin_for_qnewton=ndim_magmom
    else
       nspin_for_qnewton=nspin
       if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) nspin_for_qnewton=1
    endif
! ========================================================================== 11.0
  end function nspin_for_qnewton

  subroutine renew_u_br(j,i)
    integer, intent(in) :: j,i

! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)      :: v_dF(nspin)
    real(DP)      :: v_dF(nspin_m)
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_sta(1113)
#endif
#ifdef _CDMIX_USE_POINTER_
    urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
    call mult1s(urec_l_3,dF_l,f_p,v_dF)!-(m_Pot);<v|dF> ->v_dF
#else
    call mult1s5(urec_l,nbxmix,2,j,iV,dF_l,f_p,v_dF)
#endif
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
      v_dF(1) = v_dF(1) + v_dF(2)
      v_df(2) = v_dF(1)
    endif

! ============================== added by K.Tagami ================= 11.0
    if ( noncol ) then
       v_dF(1) = sum( v_dF(:) )
       v_dF(:) = v_dF(1)
    endif
! ================================================================== 11.0

    call subtr_j_th_term(v_dF,iU,j,u_l)  !-(m_Pot)

    !                        |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
! === DEBUG by tkato 2011/11/24 ================================================
!   if(hownew == RENEW) f(j,i,1:nspin) = v_dF(1:nspin)
    if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m)
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_end(1113)
#endif
  end subroutine renew_u_br

  subroutine renew_d_br(j)
    integer, intent(in) :: j
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)  :: vF(nspin)
    real(DP)  :: vF(nspin_m)
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_sta(1118)
#endif
#ifdef _CDMIX_USE_POINTER_
    urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
    call mult1s(urec_l_3,F_l,f_p,vF) !-(m_Pot);<v|F>  ->vF
#else
    call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_Pot);<v|F>  ->vF
#endif
! === DEBUG by tkato 2011/11/24 ================================================
!   if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
      vF(1) = vF(1) + vF(2)
      vF(2) = vF(1)
    endif

! ================================= added by K. Tagami =============== 11.0
    if ( noncol ) then
       vF(1) = sum( vF(:) )
       vF(:) = vF(1)
    endif
! ===================================================================== 11.0

    call subtr_j_th_term(vF,iU,j,d0_l) !-(m_Pot)
    !                        |d(m)> = |d(m)> - <v(j)|F(m)>|u(j)>
#ifdef __TIMER_SUB__
    call timer_end(1118)
#endif
  end subroutine renew_d_br

  subroutine renew_d_last_br(p)
    real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
    integer   :: is, ik, i, ns
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)  :: vF(nspin)
    real(DP)  :: vF(nspin_m)
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_sta(1120)
#endif

    call mult1s(v_l,F_l,f_p,vF)              !-(m_Pot) <v|F> ->vF

! === DEBUG by tkato 2011/11/24 ================================================
!   if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
      vF(1) = vF(1) + vF(2)
      vF(2) = vF(1)
    endif

! ============================ added by K.Tagami ====================== 11.0
    if ( noncol ) then
       vF(1) = sum( vF(:) )
       vF(:) = vF(1)
    endif
! ====================================================================== 11.0

    if(kgpm == kgp .or. npes == 1) then
#ifdef __TIMER_DO__
  call timer_sta(1166)
#endif
! ===================================== modified by K. Tagami ============== 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ========================================================================== 11.0
          din (:,:,is) = vlhxco_l(ista_kgpm:iend_kgpm,:,is)
          dout(:,:,is) = vlhxc_l (ista_kgpm:iend_kgpm,:,is)
       end do
#ifdef __TIMER_DO__
  call timer_end(1166)
#endif
    else
       call scatter_chg_onto_d(vlhxco_l,din )  ! -(m_C.D.)
       call scatter_chg_onto_d(vlhxc_l, dout)  ! -(m_C.D.)
    end if

!!$    do is = 1, nspin, af+1
    ns = nspin_for_qnewton()
#ifdef __TIMER_DO__
  call timer_sta(1167)
#endif
    do is = 1, ns,af+1
       do ik = 1, kimg
          do i = ista_kgpm,iend_kgpm
             rho(i,ik,is) = d0_l(i,ik,is) - vF(is)*u_l(i,ik,is)
          end do
       end do
    end do
#ifdef __TIMER_DO__
  call timer_end(1167)
#endif

! ====================================== modified by K. Tagami ============ 11.0
!    if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) call simple_mix2(c_p)
!
    if ( .not. noncol ) then
       if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) then
          call simple_mix2(c_p)
       endif
    endif

! =========================================================================== 11.0

    if(kgpm < kgp) then
       call concentrate_d_to_chg(rho,vlhxc_l) !-(m_C.D.)
       call simple_mix_large_Gc(p)           !-(m_C.D.) vlhxc,vlhxco,p ->vlhxc
    end if
#ifdef __TIMER_SUB__
    call timer_end(1120)
#endif
  end subroutine renew_d_last_br

! =========================== added by K. Tagami ================================== 5.0
  subroutine renew_u_br_with_vhsr(j,i)
    integer, intent(in) :: j,i

    integer       :: is
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)      :: v_dF(nspin)
    real(DP)      :: v_dF(nspin_m)
! ==============================================================================

    v_dF = 0.d0

#ifdef _CDMIX_USE_POINTER_
    urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
    call mult1s(urec_l_3,dF_l,f_p,v_dF)!-(m_Pot);<v|dF> ->v_dF
#else
    call mult1s5(urec_l,nbxmix,2,j,iV,dF_l,f_p,v_dF)
#endif

! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       v_dF(is) = v_dF(is) + sum( urec_vhsr(:,is,j,iV)*dF_vhsr(:,is) )
    End do
!
! === DEBUG by tkato 2011/11/24 ================================================
!   if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
      v_dF(1) = v_dF(1) + v_dF(2)
      v_df(2) = v_dF(1)
    endif
!
! ======================== added by K. Tagami ==================== 11.0
    if ( noncol ) then
       v_dF(1) = sum( v_dF(:) )
       v_dF(:) = v_dF(1)
    endif
! ================================================================ 11.0

    call subtr_j_th_term(v_dF,iU,j,u_l)  !-(m_Pot)
    !                        |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>

! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
    do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       u_vhsr(:,is) = u_vhsr(:,is) - v_dF(is) *urec_vhsr(:,is,j,iU)
    End do
! === DEBUG by tkato 2011/11/24 ================================================
!   if(hownew == RENEW) f(j,i,1:nspin) = v_dF(1:nspin)
    if(hownew == RENEW) f(j,i,1:nspin_m) = v_dF(1:nspin_m)
! ==============================================================================

  end subroutine renew_u_br_with_vhsr

  subroutine renew_d_br_with_vhsr(j)
    integer, intent(in) :: j
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)  :: vF(nspin)
    real(DP)  :: vF(nspin_m)
! ==============================================================================
    integer :: is

    vF = 0.d0

#ifdef _CDMIX_USE_POINTER_
    urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,j,iV)
    call mult1s(urec_l_3,F_l,f_p,vF) !-(m_Pot);<v|F>  ->vF
#else
    call mult1s5(urec_l,nbxmix,2,j,iV,F_l,f_p,vF) !-(m_Pot);<v|F>  ->vF
#endif

! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
      vF(is) = vF(is) + sum( urec_vhsr(:,is,j,iV)*FF_vhsr(:,is) )
    End do

! === DEBUG by tkato 2011/11/24 ================================================
!   if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
      vF(1) = vF(1) + vF(2)
      vF(2) = vF(1)
    endif

! ======================== added by K. Tagami ==================== 11.0
    if ( noncol ) then
       vF(1) = sum( vF(:) )
       vF(:) = vF(1)
    endif
! ================================================================ 11.0

    call subtr_j_th_term(vF,iU,j,d0_l) !-(m_Pot)
    !                        |d(m)> = |d(m)> - <v(j)|F(m)>|u(j)>

! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       d0_vhsr(:,is) = d0_vhsr(:,is) - vF(is) *urec_vhsr(:,is,j,iU)
    end do
  end subroutine renew_d_br_with_vhsr

  subroutine renew_d_last_br_with_vhsr( p, rmxtrc_vhsr )
    real(DP), intent(in), dimension(ista_kngp:iend_kngp) :: p
    real(DP), intent(in) :: rmxtrc_vhsr(nspin_m)

    integer   :: is, ik, i, ns
! === DEBUG by tkato 2011/11/24 ================================================
!   real(DP)  :: vF(nspin)
    real(DP)  :: vF(nspin_m)
! ==============================================================================

    vF = 0.0d0
    call mult1s(v_l,F_l,f_p,vF)              !-(m_Pot) <v|F> ->vF

! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       vF(is) = vF(is) + sum( v_vhsr(:,is)*FF_vhsr(:,is) )
    End do

! === DEBUG by tkato 2011/11/24 ================================================
!   if ( nspin==2 .and. sw_mix_bothspins_sametime == YES ) then
    if ( nspin_m==2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
      vF(1) = vF(1) + vF(2)
      vF(2) = vF(1)
    endif

! ========================== added by K. Tagami =============== 11.0
    if ( noncol ) then
       vF(1) = sum( vF(:) )
       vF(:) = vF(1)
    endif
! ============================================================= 11.0

    if(kgpm == kgp .or. npes == 1) then
! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
          din (:,:,is) = vlhxco_l(ista_kgpm:iend_kgpm,:,is)
          dout(:,:,is) = vlhxc_l (ista_kgpm:iend_kgpm,:,is)
       end do
    else
       call scatter_chg_onto_d(vlhxco_l,din )  ! -(m_C.D.)
       call scatter_chg_onto_d(vlhxc_l, dout)  ! -(m_C.D.)
    end if

! =================================== modified by K. Tagami ============ 11.0
!     do is = 1, nspin, af+1
     do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
       din_vhsr (:,is) = rhoo_vhsr(:,is) ! vlhxco
       dout_vhsr(:,is) = rho_vhsr (:,is) ! vlhxc
    end do

!!$    do is = 1, nspin, af+1
    ns = nspin_for_qnewton()
    do is = 1, ns,af+1
       do ik = 1, kimg
          do i = ista_kgpm,iend_kgpm
             rho(i,ik,is) = d0_l(i,ik,is) - vF(is)*u_l(i,ik,is)
          end do
       end do
    end do

    do is = 1, ns, af+1
       rho_vhsr(:,is) = d0_vhsr(:,is) - vF(is) *u_vhsr(:,is)
    end do

! ====================================== modified by K. Tagami ============ 11.0
!    if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) call simple_mix2(c_p)
!
!    if ( sw_force_simple_mixing_hsr==ON .and. sw_recomposing_vhsr==ON ) then
!       call simple_mix2_kt( rmxtrc_vhsr )
!    endif

    if ( .not. noncol ) then
       if (sw_force_simple_mixing==ON .and. sw_recomposing==ON) then
          call simple_mix2(c_p)
       endif
       if ( sw_force_simple_mixing_hsr==ON .and. sw_recomposing_hsr==ON ) then
          call simple_mix2_kt( rmxtrc_vhsr )
       endif
    endif
! =========================================================================== 11.0

    if(kgpm < kgp) then
       call concentrate_d_to_chg(rho,vlhxc_l) !-(m_C.D.)
       call simple_mix_large_Gc(p)           !-(m_C.D.) vlhxc,vlhxco,p ->vlhxc
    end if
  end subroutine renew_d_last_br_with_vhsr

! ============================================================================ 5.0

  subroutine simple_mix_large_Gc(p)
    real(kind=DP), intent(in), dimension(ista_kngp:iend_kngp) :: p

    integer :: istart, iend, is, ik, i
#ifdef __TIMER_SUB__
    call timer_sta(1123)
#endif
    istart = kgpm + 1; if(istart < ista_kngp) istart = ista_kngp
    iend   = kgp;      if(iend   > iend_kngp) iend   = iend_kngp
#ifdef __TIMER_DO__
  call timer_sta(1174)
#endif
    if(iend >= istart) then
! =================================== modified by K. Tagami ============ 11.0
!       do is = 1, nspin, af+1
       do is = 1, ndim_magmom, af+1
! ======================================================================= 11.0
          do ik = 1, kimg
             do i = istart, iend
                vlhxc_l(i,ik,is) = p(i)*vlhxc_l(i,ik,is) + (1.0d0-p(i))*vlhxco_l(i,ik,is)
             end do
          end do
       end do
    end if
#ifdef __TIMER_DO__
  call timer_end(1174)
#endif
#ifdef __TIMER_SUB__
    call timer_end(1123)
#endif
  end subroutine simple_mix_large_Gc

! <<< Quasi-Newton Methods >>>
!  1. Broyden's 1st method
!  2. Broyden's 2nd method
!  3. DFP method
!
! In Quasi-Newton method, following set of equations are used.
!
!\begin{equation}
!\rho^{(m+1)}  = \rho^{(m)} - \lambda^{(m)} \left[ {\bf J} ^{(m)}\right]^{-1} {\cal F}^{(m)}
!\end{equation}
!
!\begin{equation}
!  \left[ {\bf J}^{(m+1)}\right]^{-1} \Delta {\cal F}^{(m+1)} = \Delta
!  \rho ^{(m+1)}
!\end{equation}
!
! $\lambda^{(m)}$ in the first euqation is a parameter of one
! dimensional search. And ${\bf J}^{(m+1)}$ is an approximate value of
! true Jacobian{\cal J}. In this program we fix this value of
! $\lambda^{(m)}$ to be 1.
! $\Delta {\cal F}^{(m+1)}$ and $\Delta \rho^{(m+1)}$ are definded as
! follows.
!
!\begin{equation}
!  \Delta {\cal F}^{(m+1)} = {\cal F}^{(m+1)} - {\cal F}^{(m)},
!\end{equation}
! where ${\cal F}^{(m)} = \rho^{out,(m)} - \rho^{in,(m)}$.
!
!\begin{equation}
!  \Delta \rho^{(m+1)} = \rho^{(m+1)} - \rho^{(m)}
!\end{equation}
!
! Three kinds of mixing ways implemented in this program,
! i.e. Broyden's 1st, Broyden's 2nd and DFP methods, differ in the
! way of approximation of the $\left[ {\bf J} ^{(m)}\right]^{-1}$. For
! combinience, we simply this description of the inverse of Jacobian
! as to be ${\bf J}^{-1(m)}$, hereafter.
!
! <<1>> Broyden's 1st method
!\begin{equation}
!{\bf J}^{-1(m)} = {\bf J}^{-1(m-1)} + \frac{\left[ | \Delta
!    \rho^{(m)}\rangle - {\bf J}^{-1(m-1)} | \Delta {\cal
!      F}^{(m)}\rangle \right] \otimes \langle \Delta \rho^{(m)} | {\bf
!    J}^{-1(m-1)}}{\langle\rho^{(m)}|{\bf J}^{-1(m-1)}| \Delta {\cal
!    F}^{(m)}\rangle}
!\end{equation}
!
! <<2>> Broyden's 2nd method
!\begin{equation}
!  {\bf J}^{-1(m)} = {\bf J}^{-1(m-1)} + \left[ |\Delta \rho^{(m)}
!    \rangle - {\bf J}^{-1(m-1)} | \Delta {\cal F}^{(m)} \right]
!  \otimes \frac{\langle \Delta {\cal F}^{(m)}|}{\| \Delta {\cal
!      F}^{(m)}\|^2}
!\end{equation}
!
! <<3>> DFP method
!DFP(Davidon-Fletcher-Powell) algorithm
!\begin{equation}
!  {\bf J}^{-1(m)} = {\bf J}^{-1(m-1)} + \frac{| \Delta
!    \rho^{(m)}\rangle \otimes \langle \Delta \rho^{(m)} |}
!   {\langle\rho^{(m)}|\Delta {\cal F}^{(m)}\rangle}
!   - \frac{|{\bf J}^{-1(m-1)}\Delta {\cal F}^{(m)}\rangle \otimes
!   \langle \Delta {\cal F}^{(m)}{\bf J}^{-1(m-1)}|}{\langle \Delta
!   {\cal F}^{(m)}|{\bf J}^{-1(m-1)}|\Delta {\cal F}^{(m)}\rangle}
!\end{equation}
!
! For reduction of memory space, we rewrite the Jacobian as linear
! combination of dyadic products.
!\begin{equation}
!  {\bf J}^{-1(m)} = -\alpha{\bf 1} + \sum_{i=2}^{m}|u^{(i)}\rangle
!  \otimes \langle v^{(i)}|
!\label{eq:JQN}
!\end{equation}
!Here, we used diagonal form for ${\bf J}^{-1(1)}$.
!\begin{equation}
!  {\bf J}^{-1(1)} = -\alpha {\bf 1}
!\end{equation}
!We can easily obtain $u^{(m)}$ and $v^{(m)}$ for the Broyden's 2nd
!method formula (eq.(\ref{eq:broyden2})).
!\begin{equation}
!  u^{(m)} = \Delta \rho^{(m)} + \alpha \Delta {\cal F}^{(m)} -
!  \sum_{i=2}^{m-1}\langle v^{(i)}|\Delta {\cal F}^{(m)}\rangle u^{(i)}
!\end{equation}
!\begin{equation}
!  v^{(m)} = \frac{1}{\parallel \Delta {\cal F}^{(m)}\parallel^2}
!  \Delta {\cal F}^{(m)}
!\end{equation}
!
!    a     : $\alpha$
!    d     : $\rho$
!    dd    : $\Delta \rho$
!    F     : $\cal F$
!    dF    : $\Delta F$
!

! dF_l   = dF  : $\Delta {\cal F}^{(m)}$
! d0_l    = d(m) + aF(m) - sum(i=2,m-1)<u(i)|F(m)>u(i)
! u_l      = u(m)
!          : $ u^{(m)} = \Delta \rho^{(m)} + \alpha \Delta {\cal F}^{(m)} -
!  \sum_{i=2}^{m-1}\langle v^{(i)}|\Delta {\cal F}^{(m)}\rangle u^{(i)}$
! v        = v(m)
!          : $ v^{(m)} = \frac{1}{\parallel \Delta {\cal F}^{(m)}\parallel^2}$
! din    = d(input,(m-1))   : $ \rho^{in, (m-1)}$ (:first and last),
!         or F(m)             : ${\cal F}^{(m)}$ (: as a transient array)
! dout    = d(output,(m-1))  : $ \rho^{out,(m-1)}$
!
!  J(m) = a + sum_{i=2}^m |u(i)><v(i)|
!  u(m) = dd(m) + a dF(m) - sum_{i=2}^{m-1} <v(i)|dF(m)>|u(i)>
!  v(m) = dF(m)/||dF(m)||
!
  subroutine m_Pot_mix_broyden2(rmx)
    real(DP),intent(in) :: rmx
    integer   :: iter,j,mxiter,icr,jcr
!!$    real(DP)  :: v_dF(nspin),vF(nspin)
    integer   :: id_sname = -1
! --> T. Yamasaki  03 Aug. 2009
    real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
!   real(kind=DP), allocatable, dimension(:,:,:) :: vlhxcstore_l, vlhxcostore_l
! <--
#ifdef __TIMER_SUB__
    call timer_sta(1124)
#endif
    call tstatc0_begin('m_Pot_mix_broyden2 ',id_sname,1)

    if(previous_waymix /= BROYD2.or.force_dealloc) then
       call mix_dealloc_previous()
       call mix_broyden_allocate();    F_l => din
       force_dealloc = .false.
    end if

    allocate(rmxtrc(nspin_m))
    if ( noncol ) then
       rmxtrc(1:nspin_m) = rmx
    else
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vlhxcstore_recompos_vlhxc(rmx,rmxtrc) ! --> vlhxc_l, vlhxco_l, rmxtrc
       else
          rmxtrc(1:nspin_m) = rmx
       end if
    endif
! ======================================================================== 11.0

! ====================== Modified by K. Tagami =========
!    allocate(c_p(ista_kngp:iend_kngp)); call precon_4_pot_mix(rmx,c_p)
! --> T. Yamasaki, 03rd Aug. 2009
!!$    allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_pot_mix(rmx,c_p)
    allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
! =======================================================


! ============================== modified by K. Tagami ================== 11.0
!    call precon_4_pot_mix(rmxtrc,c_p)
!
    if ( noncol ) then
       call precon_4_pot_mix_noncl(rmxtrc,c_p)
    else
       call precon_4_pot_mix(rmxtrc,c_p)
    endif
! ======================================================================== 11.0

    iter = iter_from_reset()                 !-(m_Pot)

    if((iter-istrbr+1) <= 1) then
       call simple_mix1(c_p)                 !-(m_Pot)
       !   din=vlhxco_l; dout=vlhxc_l; (din,dout,c_p)->vlhxc_l
    else
!!$       stop ' -- iter-istrbr+1 > 1 (m_Pot_mix_broyden2) --'
       call mix_broyden_alloc2   !-(m_Pot) d0_l,u_l, and v_l are allocated
       call dF_F_d0_u_and_v      !-(c.h.)   dF_l, F_l, initial u_l,v_l,d0_l

       call set_ncrspd_mxiter_etc(iter,iU,mxiter) !-(m_Pot) ->mxiter,ncrspd
       !                  when hownew == RENEW: f,g,ncrspd, and urec_l are reset.
       icr = icrspd_is(iter)                 !-(m_Pot) function
       do j = 2, mxiter
          jcr = ncrspd(j)
          call renew_u_br(jcr,icr) !-(m_Pot) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
          call renew_d_br(jcr)     !-(m_Pot) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
       enddo!j-loop

       urec_l(:,:,:,icr,iU) = u_l(:,:,:)  ! storing
       urec_l(:,:,:,icr,iV) = v_l(:,:,:)  ! storing

       call renew_d_last_br(c_p)       !-(m_Pot) vlhxc_l(|d(m)>) = |d(m)>-<v(m)|F(m)>|u(m)>
       call mix_broyden_dealloc2                      !-(m_Pot)
    endif

    if ( .not. noncol ) then
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call compos_vlhxc_dealloc_vlhxcstore()
       end if
    endif
    deallocate(rmxtrc)

    deallocate(c_p)
    previous_waymix = BROYD2
    call tstatc0_end(id_sname)
#ifdef __TIMER_SUB__
    call timer_end(1124)
#endif
  contains
    subroutine dF_F_d0_u_and_v
      !   dF_l(=deltaF) = (rho - dout) - (rhoo - din)
      !   F_l = rho - rhoo (=\cal F^{m}); u_l  = (rhoo - din) + c_p*dF_l;
      !   d0_l = rhoo+c_p* F_l;              v_l = dF_l/( |dF_l| )

      integer                      :: is,k,i
      real(DP), dimension(nspin_m) :: fff
#ifdef __TIMER_SUB__
    call timer_sta(1125)
#endif
#ifdef __TIMER_DO__
  call timer_sta(1175)
#endif
! ======================================= modified by K. Tagami =========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ========================================================================= 11.0

         do k = 1, kimg
            do i = ista_kgpm,iend_kgpm
!  Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
!!$               dF_l(i,k,is) = (rho (i,k,is)-rhoo(i,k,is)) - (dout(i,k,is)-din(i,k,is))
!!$               d0_l(i,k,is) = rhoo(i,k,is) + c_pm(i)*(rho(i,k,is) - rhoo(i,k,is))
!!$               u_l(i,k,is)  = c_pm(i)*dF_l(i,k,is) + (rhoo(i,k,is) - din(i,k,is))
               dF_l(i,k,is) = (rho (i,k,is)-rhoo(i,k,is)) - (dout(i,k,is)-F_l(i,k,is))
               d0_l(i,k,is) = rhoo(i,k,is) + c_pm(i,is)*(rho(i,k,is) - rhoo(i,k,is))
               u_l(i,k,is)  = c_pm(i,is)*dF_l(i,k,is) + (rhoo(i,k,is) - F_l(i,k,is))
! ----
               F_l(i,k,is)  = rho(i,k,is) - rhoo(i,k,is)
            end do
            if(mype == 0) u_l(1,k,is) = 0.d0
         end do
      end do
#ifdef __TIMER_DO__
  call timer_end(1175)
#endif

      call mult1s(dF_l,dF_l,f_p,fff)
      if(sum(fff) < 1.d-40)  stop ' fmult is too small'

! === DEBUG by tkato 2011/11/24 ================================================
!     if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
      if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
        fff(1) = fff(1) + fff(2)
        fff(2) = fff(1)
      endif

! ========================= added by K. Tagami =========================== 11.0
      if ( noncol ) then
         fff(1) = sum( fff(:) )
         fff(:) = fff(1)
      endif
! ======================================================================== 11.0

#ifdef __TIMER_DO__
  call timer_sta(1176)
#endif
! ========================================= modified by K. Tagami ========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! =========================================================================== 11.0
         v_l(:,:,is) = dF_l(:,:,is)/fff(is)
      end do
#ifdef __TIMER_DO__
  call timer_end(1176)
#endif

#ifdef __TIMER_SUB__
    call timer_end(1125)
#endif
    end subroutine dF_F_d0_u_and_v

  end subroutine m_Pot_mix_broyden2

! ===================== added by K. Tagami ============================== 5.0
  subroutine m_Pot_mix_broyden2_with_vhsr(rmx)
    real(DP),intent(in) :: rmx
    integer   :: iter,j,mxiter,icr,jcr
!!$    real(DP)  :: v_dF(nspin),vF(nspin)
    integer   :: id_sname = -1
! --> T. Yamasaki  03 Aug. 2009
    real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
    real(kind=DP), allocatable, dimension(:,:,:) :: vlhxcstore_l, vlhxcostore_l
! <--

    call tstatc0_begin('m_Pot_mix_broyden2_vhsr ',id_sname,1)

    if (previous_waymix /= BROYD2.or.force_dealloc) then
       force_dealloc = .false.
       if ( first ) then
          call create_map_func(.true.)
          call alloc_rho_vhsr
          call create_map_func(.false.)
          first = .false.
       endif
       call mix_dealloc_previous()
       call mix_dealloc_previous_vhsr()
       call mix_broyden_allocate();        F_l => din
       call mix_broyden_allocate_vhsr();    FF_vhsr => din_vhsr
    end if

    if ( noncol ) then
       if ( flg_paw ) then
          call map_vhsr_to_rho_noncl( rho_vhsr,  vnonlocal_r,     vnonlocal_i, &
               &                      dion_paw )
          call map_vhsr_to_rho_noncl( rhoo_vhsr, vnonlocal_r_old, vnonlocal_i_old, &
               &                      dion_paw_old )
       else
          call map_vhsr_to_rho_noncl( rho_vhsr,  vnonlocal_r,     vnonlocal_i )
          call map_vhsr_to_rho_noncl( rhoo_vhsr, vnonlocal_r_old, vnonlocal_i_old )
       endif
    else
       if ( flg_paw ) then
          call map_vhsr_to_rho( rho_vhsr,  vnonlocal_r,     dion_paw )
          call map_vhsr_to_rho( rhoo_vhsr, vnonlocal_r_old, dion_paw_old )
       else
          call map_vhsr_to_rho( rho_vhsr,  vnonlocal_r )
          call map_vhsr_to_rho( rhoo_vhsr, vnonlocal_r_old )
       endif
    endif

    allocate(rmxtrc(nspin_m))
    if ( noncol ) then
       rmxtrc(1:nspin_m) = rmx
    else
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vlhxcstore_recompos_vlhxc(rmx,rmxtrc) ! --> vlhxc_l,vlhxco_l, rmxtrc
       else
          rmxtrc(1:nspin_m) = rmx
       end if
    endif

    if ( noncol ) then
       rmxtrc = rmx
    else
       if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
          call alloc_rhostore_recomp( rmx, rmxtrc )
       else
          rmxtrc = rmx
       endif
    endif

! ====================== Modified by K. Tagami =========
!    allocate(c_p(ista_kngp:iend_kngp)); call precon_4_pot_mix(rmx,c_p)
! --> T. Yamasaki, 03rd Aug. 2009
!!$    allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_pot_mix(rmx,c_p)
    allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
! =======================================================


! ============================= modiifed by K. Tagami =================== 11.0
!    call precon_4_pot_mix(rmxtrc,c_p)
!
    if ( noncol ) then
       call precon_4_pot_mix_noncl(rmxtrc,c_p)
    else
       call precon_4_pot_mix(rmxtrc,c_p)
    endif
! ====================================================================== 11.0

    iter = iter_from_reset()                 !-(m_Pot)

    if((iter-istrbr+1) <= 1) then
       call simple_mix1(c_p)                 !-(m_Pot)
       !   din=vlhxco_l; dout=vlhxc_l; (din,dout,c_p)->vlhxc_l
       call simple_mix_kt( rmxtrc )
    else
!!$       stop ' -- iter-istrbr+1 > 1 (m_Pot_mix_broyden2) --'

       call mix_broyden_alloc2   !-(m_Pot) d0_l,u_l, and v_l are allocated
       call mix_broyden_alloc2_vhsr

       call dF_F_d0_u_and_v_with_vhsr

       call set_ncrspd_mxiter_etc(iter,iU,mxiter) !-(m_Pot) ->mxiter,ncrspd
       !                  when hownew == RENEW: f,g,ncrspd, and urec_l are reset.
       icr = icrspd_is(iter)                 !-(m_Pot) function
       do j = 2, mxiter
          jcr = ncrspd(j)
          call renew_u_br_with_vhsr(jcr,icr) !-(m_Pot) |u(m)> = |u(m)> - <v(j)|dF(m)>|u(j)>
          call renew_d_br_with_vhsr(jcr)     !-(m_Pot) |d(m)> = |d(m)> - <v(j)|F(m)> |u(j)>
       enddo!j-loop

       urec_l(:,:,:,icr,iU) = u_l(:,:,:)  ! storing
       urec_l(:,:,:,icr,iV) = v_l(:,:,:)  ! storing

       urec_vhsr(:,:,icr,iU) = u_vhsr(:,:)  ! storing
       urec_vhsr(:,:,icr,iV) = v_vhsr(:,:)  ! storing

       call renew_d_last_br_with_vhsr( c_p, rmxtrc )  
                                !-(m_Pot) vlhxc_l(|d(m)>) = |d(m)>-<v(m)|F(m)>|u(m)>

       call mix_broyden_dealloc2                      !-(m_Pot)
       call mix_broyden_dealloc2_vhsr

    endif

    if ( .not. noncol ) then
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call compos_vlhxc_dealloc_vlhxcstore()
       end if
       if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
          call compose_rho_dealloc_store
       end if
    endif

    if ( noncol ) then
       if ( flg_paw ) then
          call map_rho_to_vhsr_noncl( rho_vhsr, vnonlocal_r, vnonlocal_i, dion_paw )
       else
          call map_rho_to_vhsr_noncl( rho_vhsr, vnonlocal_r, vnonlocal_i )
       endif
    else
       if ( flg_paw ) then
          call map_rho_to_vhsr( rho_vhsr, vnonlocal_r, dion_paw )
       else
          call map_rho_to_vhsr( rho_vhsr, vnonlocal_r )
       endif
    endif

    deallocate(rmxtrc)

    deallocate(c_p)

    previous_waymix = BROYD2
    call tstatc0_end(id_sname)
  contains

    subroutine dF_F_d0_u_and_v_with_vhsr
      !   dF_l(=deltaF) = (rho - dout) - (rhoo - din)
      !   F_l = rho - rhoo (=\cal F^{m}); u_l  = (rhoo - din) + c_p*dF_l; 
      !   d0_l = rhoo+c_p* F_l;              v_l = dF_l/( |dF_l| )

      integer                      :: is,k,i
      real(DP), dimension(nspin_m) :: fff

! ======================================= modified by K. Tagami =========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ========================================================================= 11.0
         do k = 1, kimg
            do i = ista_kgpm,iend_kgpm
!  Revised by T. Yamasaki, 2009/05/28 (Pointed out by Fukata-san (NEC))
!!$               dF_l(i,k,is) = (rho (i,k,is)-rhoo(i,k,is)) - (dout(i,k,is)-din(i,k,is))
!!$               d0_l(i,k,is) = rhoo(i,k,is) + c_pm(i)*(rho(i,k,is) - rhoo(i,k,is))
!!$               u_l(i,k,is)  = c_pm(i)*dF_l(i,k,is) + (rhoo(i,k,is) - din(i,k,is))
               dF_l(i,k,is) = (rho (i,k,is)-rhoo(i,k,is)) - (dout(i,k,is)-F_l(i,k,is))
               d0_l(i,k,is) = rhoo(i,k,is) + c_pm(i,is)*(rho(i,k,is) - rhoo(i,k,is))
               u_l(i,k,is)  = c_pm(i,is)*dF_l(i,k,is) + (rhoo(i,k,is) - F_l(i,k,is))
! ----
               F_l(i,k,is)  = rho(i,k,is) - rhoo(i,k,is)
            end do
            if(mype == 0) u_l(1,k,is) = 0.d0
         end do
      end do
!
! ======================================= modified by K. Tagami =========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ========================================================================= 11.0
         dF_vhsr(:,is) = ( rho_vhsr(:,is)-rhoo_vhsr(:,is)) - ( dout_vhsr(:,is)-FF_vhsr(:,is))
         d0_vhsr(:,is) = rhoo_vhsr(:,is) + rmxtrc(is) *( rho_vhsr(:,is) - rhoo_vhsr(:,is))
          u_vhsr(:,is) = rmxtrc(is) *dF_vhsr(:,is) + ( rhoo_vhsr(:,is) - FF_vhsr(:,is) )
         FF_vhsr(:,is) = rho_vhsr(:,is) - rhoo_vhsr(:,is)
      end do

      call mult1s(dF_l,dF_l,f_p,fff)

! ======================================= modified by K. Tagami =========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ========================================================================= 11.0
         fff(is) = fff(is) + sum( dF_vhsr(:,is)*dF_vhsr(:,is) )
      end do

      if(sum(fff) < 1.d-40)  stop ' fmult is too small'

!!!!!!!!
! === DEBUG by tkato 2011/11/24 ================================================
!     if ( nspin == 2 .and. sw_mix_bothspins_sametime == YES ) then
      if ( nspin_m == 2 .and. sw_mix_bothspins_sametime == YES ) then
! ==============================================================================
	fff(1) = fff(1) + fff(2)
        fff(2) = fff(1)
      endif

! ========================= added by K. Tagami =========================== 11.0
      if ( noncol ) then
         fff(1) = sum( fff(:) )
         fff(:) = fff(1)
      endif
! ======================================================================== 11.0

! ========================================= modified by K. Tagami ========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! =========================================================================== 11.0
         v_l(:,:,is) = dF_l(:,:,is)/fff(is)
      end do

! ========================================= modified by K. Tagami ========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! =========================================================================== 11.0
         do i=1,nsize_rho_vhsr
            v_vhsr(i,is) = dF_vhsr(i,is)/fff(is)
         end do
      end do

    end subroutine dF_F_d0_u_and_v_with_vhsr

  end subroutine m_Pot_mix_broyden2_with_vhsr
! ==================================================================== 5.0

  subroutine mix_pulay_allocate
!!$    if(allocated(f_p)) return

! =============================== modified by K. Tagami ========== 11.0
!    nspin_m  = nspin/(af+1)
!
    if ( noncol ) then
       nspin_m  = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ================================================================= 11.0

! =========================================== Modified by K. Tagami =========
!    allocate(f_p(ista_kgpm:iend_kgpm)); call precon_4_mult(f_p) !-(m_Pot)
    allocate(f_p(ista_kgpm:iend_kgpm)); f_p = 0; call precon_4_mult(f_p) !-(m_Pot)
! ============================================================================

    allocate(din(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(dout(ista_kgpm:iend_kgpm,kimg,nspin_m))
    allocate(urec_l(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix,2))
    allocate(uuf_p(nbxmix,nspin_m))
    allocate(f(nbxmix,nbxmix,nspin_m))
    allocate(g_p(nbxmix,nspin_m))
    allocate(prj_wk(mp_kngp*kimg*nspin_m))
    allocate(ncrspd(nbxmix))

    if(sw_gradient_simplex==ON)then
       allocate(rhoj(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix));rhoj=0.d0
       allocate(Frhoj(ista_kgpm:iend_kgpm,kimg,nspin_m,nbxmix));Frhoj=0.d0
       allocate(rhojo(ista_kgpm:iend_kgpm,kimg,nspin_m));rhojo=0.d0
       allocate(Frhojo(ista_kgpm:iend_kgpm,kimg,nspin_m));Frhojo=0.d0
    endif

! ======================================= Added by K. Tagami ===========
    din = 0.0d0; dout = 0.0d0; urec_l = 0.0d0; uuf_p = 0.0d0; f = 0.0d0
    g_p = 0.0d0; prj_wk = 0.0d0; ncrspd = 0
! ======================================================================
  end subroutine mix_pulay_allocate

  subroutine mix_pulay_deallocate
    if(allocated(f_p)) deallocate(f_p)
    if(allocated(din)) deallocate(din)
    if(allocated(dout)) deallocate(dout)
    if(allocated(urec_l)) deallocate(urec_l)
    if(allocated(uuf_p)) deallocate(uuf_p)
    if(allocated(f)) deallocate(f)
    if(allocated(g_p)) deallocate(g_p)
    if(allocated(prj_wk)) deallocate(prj_wk)
    if(allocated(ncrspd)) deallocate(ncrspd)
    if(allocated(rhoj)) deallocate(rhoj)
    if(allocated(Frhoj)) deallocate(Frhoj)
    if(allocated(rhojo)) deallocate(rhojo)
    if(allocated(Frhojo)) deallocate(Frhojo)
  end subroutine mix_pulay_deallocate

  subroutine mix_pulay_alloc2
    allocate(d0_l(ista_kgpm:iend_kgpm,kimg,nspin_m))
! =========================================== Added by K. Tagami ========
    d0_l = 0.0d0
! =======================================================================
    call alloc_rho_rhoo_and_cpm
  end subroutine mix_pulay_alloc2

  subroutine mix_pulay_dealloc2
    deallocate(d0_l)
    call dealloc_rho_rhoo_and_cpm
  end subroutine mix_pulay_dealloc2

  subroutine m_Pot_mix_pulay(nfout,rmx)
    integer, parameter  :: iRho = 1, iResid = 2
    integer, intent(in) :: nfout
    real(DP),intent(in) :: rmx
    integer   :: iter, mxiter
    real(DP),pointer,dimension(:)  :: e_wk, f_wk, ww1, finv
    integer, pointer,dimension(:)  :: ip
! --> T. Yamasaki  03 Aug. 2009
    real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
!   real(kind=DP), allocatable, dimension(:,:,:) :: vlhxcstore_l, vlhxcostore_l
! <--
    integer   :: id_sname = -1
#ifdef __TIMER_SUB__
    call timer_sta(1131)
#endif
    call tstatc0_begin('m_Pot_mix_pulay ',id_sname,1)

    if(previous_waymix /= PULAY.or.force_dealloc) then
       force_dealloc = .false.
       call mix_dealloc_previous()
       call mix_pulay_allocate()
    end if

    allocate(rmxtrc(nspin_m))
    if ( noncol ) then
       rmxtrc(1:nspin_m) = rmx
    else
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vlhxcstore_recompos_vlhxc(rmx,rmxtrc) ! --> vlhxc_l,vlhxco_l, rmxtrc
       else
          rmxtrc(1:nspin_m) = rmx
       end if
    endif
! ========================================================================= 11.0

! ====================================== Modified by K. Tagami =========
!    allocate(c_p(ista_kngp:iend_kngp)); call precon_4_pot_mix(rmx,c_p)
! --> T. Yamasaki, 03rd Aug. 2009
!!$    allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_pot_mix(rmx,c_p)
    allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
! ========================================================================


! =================================== modified by K. Tagami =============== 11.0
!    call precon_4_pot_mix(rmxtrc,c_p)
!
    if ( noncol ) then
       call precon_4_pot_mix_noncl(rmxtrc,c_p)
    else
       call precon_4_pot_mix(rmxtrc,c_p)
    endif
! ========================================================================= 11.0

    iter = iter_from_reset()                 !-(m_Pot)
    if((iter-istrbr+1) <= 1) then
       call simple_mix1(c_p)                 !-(m_Pot)
       !   din=vlhxco_l; dout=vlhxc_l; (din,dout,c_p)->vlhxc_l
    else
       call mix_pulay_alloc2   !-(m_Pot) d0_l,u_l, and w_l are allocated
       call set_ncrspd_mxiter(nbxmix,iter-istrbr,mxiter) ! -> ncrspd, mxiter
!!$       call mix_pulay_alloc3(nbxmix,iter-istrbr)   !-(c.h.) e_wk,f_wk,ww1,finv,ip
       call mix_pulay_alloc3(mxiter)   !-(c.h.) e_wk,f_wk,ww1,finv,ip

!!$       call Resid_and_dd_into_urec(iter-istrbr) !-(c.h.)
!!$       !                               dF ->urec_l; dd ->urec_l; d0_l,din,dout
!!$       call Ri_dot_Rj(iter-istrbr)          !-(c.h.) <R(i)|R(j)>->f
!!$       call get_finv(nbxmix,iter-istrbr,f)  !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}
!!$
!!$       call Rj_dot_d(iter-istrbr)           !-(c.h.) <R(j)|d>,(j=1,iter-istrb) -> uuf_p
!!$
!!$       call get_gmatrix(iter-istrbr)        !-(c.h.) (f,uuf_p)->g
!!$       call renew_d_using_g(iter-istrbr,c_pm)     !-(c.h.)
       call Resid_and_dd_into_urec(mxiter) !-(c.h.)
       !                               dF ->urec_l; dd ->urec_l; d0_l,din,dout
       call Ri_dot_Rj(mxiter)          !-(c.h.) <R(i)|R(j)>->f
!!$       call get_finv(nbxmix,mxiter,f)  !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}
       call get_finv_lapack(nbxmix,mxiter,f)  !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}

       call Rj_dot_d(mxiter)           !-(c.h.) <R(j)|d>,(j=1,iter-istrb) -> uuf_p

       call get_gmatrix(mxiter)        !-(c.h.) (f,uuf_p)->g
       call renew_d_using_g(mxiter,c_pm)     !-(c.h.)

       call mix_pulay_dealloc3                    !-(c.h.)
       call mix_pulay_dealloc2                    !-(m_Pot)
    endif

    if ( .not. noncol ) then
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) &
            & call compos_vlhxc_dealloc_vlhxcstore()
    endif
    deallocate(rmxtrc)

    deallocate(c_p)
    previous_waymix = PULAY
    call tstatc0_end(id_sname)
#ifdef __TIMER_SUB__
    call timer_end(1131)
#endif
  contains
    subroutine mix_pulay_alloc3(m)
      integer, intent(in) :: m
      allocate(e_wk(m*m)); allocate(f_wk(m*m)); allocate(ww1(m)); allocate(finv(m*m))
      allocate(ip(m))
! ===================================== Added by K. Tagami ============
      e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0
! =====================================================================
    end subroutine mix_pulay_alloc3

    subroutine set_ncrspd_mxiter(n,iter,m)
      integer, intent(in)  :: n, iter
      integer, intent(out) :: m
      integer :: i, nx
      if(hownew == ANEW) then
         m = iter
!!$         ncrspd(:) = (/(i,i=1,m)/)
         do i=1,iter
            ncrspd(i) = i
         end do
      else ! hownew == RENEW
         if(iter <= n) then
            m = iter
!!$            ncrspd(:) = (/(i,i=1,m)/)
            do i=1,iter
               ncrspd(i) = i
            end do
         else
            m = n
            nx = ncrspd(1)
            do i = 1, m-1
               ncrspd(i) = ncrspd(i+1)
            end do
            ncrspd(m) = nx
         end if
      end if
    end subroutine set_ncrspd_mxiter

    subroutine mix_pulay_dealloc3
      deallocate(e_wk); deallocate(f_wk); deallocate(ww1); deallocate(finv)
      deallocate(ip)
    end subroutine mix_pulay_dealloc3

    subroutine Resid_and_dd_into_urec(iter)
      integer, intent(in) :: iter
      integer             :: itc,itc0,itc1
      integer :: i,j,k,imix
#ifdef __TIMER_SUB__
    call timer_sta(1132)
#endif
      itc = ncrspd(iter)
      if(sw_gradient_simplex==ON)then
         do imix=2,iter-1
            itc0 = ncrspd(imix)
            itc1 = ncrspd(imix-1)
            do i=1,nspin_m
               do j=1,kimg
                  do k=ista_kgpm,iend_kgpm
                     urec_l(k,j,i,itc0,iResid) = rho(k,j,i)-rhoo(k,j,i)-(Frhoj(k,j,i,itc1)-rhoj(k,j,i,itc1))
                     urec_l(k,j,i,itc0,iRho  ) = rhoo(k,j,i)-rhoj(k,j,i,itc1)
                  enddo
               enddo
            enddo
         enddo
         do i=1,nspin_m
            do j=1,kimg
               do k=ista_kgpm,iend_kgpm
                  urec_l(k,j,i,itc,iResid) = rho(k,j,i)-rhoo(k,j,i)-(dout(k,j,i)-din(k,j,i))
                  urec_l(k,j,i,itc,iRho  ) = rhoo(k,j,i)-din(k,j,i)
                  rhoj(k,j,i,itc) = rhoo(k,j,i)
                  Frhoj(k,j,i,itc) = rho(k,j,i)
                  d0_l(k,j,i) = rho(k,j,i) - rhoo(k,j,i)
                  din(k,j,i)  = rhoo(k,j,i)
                  dout(k,j,i) = rho(k,j,i)
               enddo
            enddo
         enddo
      else
         do i=1,nspin_m
            do j=1,kimg
               do k=ista_kgpm,iend_kgpm
                  urec_l(k,j,i,itc,iResid) = rho(k,j,i) - rhoo(k,j,i) - (dout(k,j,i) - din(k,j,i)) ! =dF(=delta F^i)
                  urec_l(k,j,i,itc,iRho  ) = rhoo(k,j,i) - din(k,j,i)                ! =dd
                  d0_l(k,j,i) = rho(k,j,i) - rhoo(k,j,i)
                  din(k,j,i)  = rhoo(k,j,i)
                  dout(k,j,i) = rho(k,j,i)
               enddo
            enddo
         enddo
      endif
#ifdef __TIMER_SUB__
    call timer_end(1132)
#endif
    end subroutine Resid_and_dd_into_urec

    subroutine Ri_dot_Rj(n)
      integer, intent(in) :: n
      integer  :: it,jt,itc,jtc
! === DEBUG by tkato 2011/11/24 ================================================
!     real(DP) :: ff1(nspin),ff1tmp
      real(DP) :: ff1(nspin_m),ff1tmp
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_sta(1133)
#endif
#ifdef __TIMER_DO__
  call timer_sta(1179)
#endif
      do it = 1, n
         itc = ncrspd(it)
         do jt = it, n
            jtc = ncrspd(jt)
#ifdef _CDMIX_USE_POINTER_
            urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,itc,iResid)
            urec_l_3_2 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,jtc,iResid)
            call mult1s(urec_l_3,urec_l_3_2,f_p,ff1)   ! <delta F^i|delta F^j>
#else
            if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
               call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp)   ! <delta F^i|delta F^j>
               ff1(1)=ff1tmp;ff1(2)=ff1tmp
            else
               call mult1s10(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1)   ! <delta F^i|delta F^j>
            endif

! ============================= added by K. Tagami ======================= 11.0
            if ( noncol ) then
               call mult1s10_reduce_spin( urec_l, nbxmix, 2, itc, iResid, &
                    &                     urec_l, jtc, iResid, f_p, ff1tmp )
                                                        ! <delta F^i|delta F^j>
               ff1(:) = ff1tmp
            endif
! ======================================================================== 11.0

#endif
            f(it,jt,1:nspin_m) = ff1(1:nspin_m)
            if(jt /= it) f(jt,it,1:nspin_m) = f(it,jt,1:nspin_m)
         end do
      end do
#ifdef __TIMER_DO__
  call timer_end(1179)
#endif
#ifdef __TIMER_SUB__
    call timer_end(1133)
#endif
    end subroutine Ri_dot_Rj

    subroutine Rj_dot_d(n)
      integer, intent(in) :: n
      integer  :: jt, jtc
! === DEBUG by tkato 2011/11/24 ================================================
!     real(DP) :: ff1(nspin),ff1tmp
      real(DP) :: ff1(nspin_m),ff1tmp
! ==============================================================================
#ifdef __TIMER_SUB__
    call timer_sta(1138)
#endif
      do jt = 1, n
         jtc = ncrspd(jt)
#ifdef _CDMIX_USE_POINTER_
         urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,jtc,iResid)
         call mult1s(urec_l_3,d0_l,f_p,ff1)
#else
         if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
            call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
            ff1(1) = ff1tmp;ff1(2)=ff1tmp
         else
            call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
         endif

! ============================= added by K. Tagami ======================= 11.0
         if ( noncol ) then
            call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
            ff1(:) = ff1tmp
         endif
! ======================================================================== 11.0

#endif
         uuf_p(jt,1:nspin_m) = ff1(1:nspin_m)
      end do
#ifdef __TIMER_SUB__
    call timer_end(1138)
#endif
    end subroutine Rj_dot_d

    subroutine get_finv_lapack(m,n,f)
      integer,intent(in)                             :: m,n
      real(DP),intent(inout),dimension(m,m,nspin_m) :: f
      real(DP), allocatable,dimension(:,:) :: fwork
      integer :: is,inf,it,jt,kt,nnspin
      real(DP) :: div,tmp
      allocate(fwork(n,n))
      nnspin = nspin
      if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1

! ======================= added by K. Tagami ============= 11.0 
      if ( noncol ) then
         nnspin = 1
      end if
! ======================================================== 11.0

      do is=1,nnspin
         if(ipripulay >= 2) then
            write(nfout,600) n,(('(',it,jt,')',f(it,jt,is),jt=1,n),it=1,n)
600         format(//11x,"**input matrix**"/12x &
                 & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
         fwork=0
         do it=1,n
            do jt=1,n
               fwork(jt,it) = f(jt,it,is)
               if(it==jt) fwork(jt,it)=fwork(jt,it)+alpha_pulay
            enddo
         enddo
         call dpotrf('U',n,fwork,n,inf)
         call dpotri('U',n,fwork,n,inf)
         if(inf/=0)then
           if(printable) write(nfout,*) ' !** failed calculation of the inverse matrix for the pulay mixer'
           fwork=0
           do it=1,n
              do jt=1,n
                 fwork(jt,it) = f(jt,it,is)
                 if(it==jt) fwork(jt,it)=fwork(jt,it)+1.d-7
              enddo
           enddo
           call dpotrf('U',n,fwork,n,inf)
           call dpotri('U',n,fwork,n,inf)
         endif
         do it=1,n-1
            do jt=it+1,n
               fwork(jt,it) = fwork(it,jt)
            enddo
         enddo
         do it=1,n
            do jt=1,n
               f(jt,it,is) = fwork(jt,it)
            enddo
         enddo
         if(ipripulay >= 2) then
            write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
630         format(/11x, "**inverse matrix**" &
                 & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
      enddo
      if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
         do it=1,n
            do jt=1,n
               f(jt,it,2) = f(jt,it,1)
            enddo
         enddo
      endif
! ============================== added by K. Tagami ========== 11.0
      if ( noncol ) then
         do it=1,n
            do jt=1,n
               f(jt,it,:) = f(jt,it,1)
            enddo
         end do
      endif
! ============================================================ 11.0
      deallocate(fwork)

    end subroutine get_finv_lapack

    subroutine get_finv(m,n,f)
      integer,intent(in)                             :: m,n
      real(DP),intent(inout),dimension(m,m,nspin_m) :: f

      integer                        :: icount,is,jt,it,icon
      real(DP)                       :: div
#ifdef __TIMER_SUB__
    call timer_sta(1134)
#endif

      e_wk = 0.d0
      do it = 1, n
         e_wk(it*it) = 1.d0
      end do

! ======================================= modified by K. Tagami =========== 11.0
!      do is = 1, nspin, af+1
      do is = 1, ndim_magmom, af+1
! ========================================================================== 11.0
         div = 1.d0/f(1,1,is)
         icount = 1
#ifdef __TIMER_DO__
  call timer_sta(1180)
#endif
         do jt = 1, n
            do it = 1, n
               f_wk(icount) = f(it,jt,is)*div
               icount = icount + 1
            end do
         end do
#ifdef __TIMER_DO__
  call timer_end(1180)
#endif
         if(ipripulay >= 1) then
            write(nfout,600) n,(('(',it,jt,')',f(it,jt,is)*div,jt=1,n),it=1,n)
600         format(//11x,"**input matrix**"/12x &
                 & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
         call rdecomp(n,f_wk,ww1,ip,icon)
         if(icon /= 0) then
            stop 'LU decomposition is impossible.'
         else
            call rsolve(n,n,f_wk,e_wk,finv,ip)
         endif

         icount = 1
#ifdef __TIMER_DO__
  call timer_sta(1181)
#endif
         do jt = 1, n
            do it = 1, n
               f(it,jt,is) = finv(icount)
               icount = icount + 1
            end do
         end do
#ifdef __TIMER_DO__
  call timer_end(1181)
#endif

         if(ipripulay >= 1) then
            write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
630         format(/11x, "**inverse matrix**" &
                 & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
      end do
#ifdef __TIMER_SUB__
    call timer_end(1134)
#endif
    end subroutine get_finv

    subroutine get_gmatrix(n)
      integer,intent(in) :: n
      integer :: is, it, jt, nnspin
#ifdef __TIMER_SUB__
    call timer_sta(1139)
#endif
      nnspin = nspin
      if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1

! ============================ added by K. Tagami ============= 11.0
      if ( noncol ) nnspin = 1
! ============================================================== 11.0      

      g_p = 0.d0
      do is = 1, nnspin
#ifdef __TIMER_DO__
  call timer_sta(1188)
#endif
         do it = 1, n
            do jt = 1, n
               g_p(it,is) = g_p(it,is) - f(jt,it,is)*uuf_p(jt,is)
            end do
         end do
#ifdef __TIMER_DO__
  call timer_end(1188)
#endif
         if(ipripulay >= 2) then
            write(nfout,'(" -- g_p(1:",i3,") --")') n
            write(nfout,'(8f20.12)') (g_p(it,is),it=1,n)
         end if
      end do
      if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
         do it = 1,n
            g_p(it,2) = g_p(it,1)
         enddo
      endif
! ============================== added by K. Tagami ============ 11.0
      if ( noncol ) then
         do it = 1,n
            g_p(it,:) = g_p(it,1)
         enddo
      endif
! ============================================================== 11.0

#ifdef __TIMER_SUB__
    call timer_end(1139)
#endif
    end subroutine get_gmatrix

    subroutine renew_d_using_g(n,p)
      integer, intent(in)                                :: n
      real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,nspin_m) :: p
      integer    :: is, k, i, it, itc, ns
#ifdef __TIMER_SUB__
    call timer_sta(1140)
#endif

!!$      do is = 1, nspin, af+1
      ns = nspin_for_qnewton()
      do is = 1, ns,af+1
         do k = 1, kimg
#ifdef __TIMER_DO__
  call timer_sta(1189)
#endif
            do i = ista_kngp, iend_kngp
               rho(i,k,is)  = rhoo(i,k,is) + p(i,is)*d0_l(i,k,is)
            end do
#ifdef __TIMER_DO__
  call timer_end(1189)
#endif
#ifdef __TIMER_DO__
  call timer_sta(1190)
#endif
            do it = 1, n
               itc = ncrspd(it)
               do i = ista_kngp, iend_kngp
                  rho(i,k,is) = rho(i,k,is) + g_p(it,is)* &
                       &        (urec_l(i,k,is,itc,iRho) + p(i,is)*urec_l(i,k,is,itc,iResid))
               end do
            end do
#ifdef __TIMER_DO__
  call timer_end(1190)
#endif
         end do
      end do

! ============================== modified by K. Tagami ================ 11.0
!      if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) call simple_mix2(c_p)
!
      if ( .not. noncol ) then
         if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) then
            call simple_mix2(c_p)
         endif
      endif
! ===================================================================== 11.0

      if(kgpm < kgp) then
         call concentrate_d_to_chg(rho,vlhxc_l) !-(m_C.D.)
         call simple_mix_large_Gc(c_p)         !-(m_C.D.) vlhxc,vlhxco,c_p ->vlhxc
      end if
#ifdef __TIMER_SUB__
    call timer_end(1140)
#endif
    end subroutine renew_d_using_g
  end subroutine m_Pot_mix_pulay

!!$ 11.07 AS Pulay version of 'sw_mix_potentiae_hardpart'
  subroutine m_Pot_mix_pulay_with_vhsr(nfout,rmx)
    integer, parameter  :: iRho = 1, iResid = 2
    integer, intent(in) :: nfout
    real(DP),intent(in) :: rmx
    integer   :: iter, mxiter
    real(DP),pointer,dimension(:)  :: e_wk, f_wk, ww1, finv
    integer, pointer,dimension(:)  :: ip
! --> T. Yamasaki  03 Aug. 2009
    real(kind=DP), allocatable, dimension(:):: rmxtrc ! d(nspin_m)
    real(kind=DP), allocatable, dimension(:,:,:) :: vlhxcstore_l, vlhxcostore_l
! <--
    integer   :: id_sname = -1

    call tstatc0_begin('m_Pot_mix_pulay_with_vhsr ',id_sname,1)

    if(previous_waymix /= PULAY.or.force_dealloc) then
       force_dealloc = .false.
       if ( first ) then
          call create_map_func(.true.)
          call alloc_rho_vhsr
          call create_map_func(.false.)
          first = .false.
       endif
       call mix_dealloc_previous()
       call mix_dealloc_previous_vhsr()
       call mix_pulay_allocate()
       call mix_pulay_allocate_vhsr()
    end if

    if ( noncol ) then
       if ( flg_paw ) then
          call map_vhsr_to_rho_noncl( rho_vhsr,  vnonlocal_r,     vnonlocal_i, &
               &                      dion_paw )
          call map_vhsr_to_rho_noncl( rhoo_vhsr, vnonlocal_r_old, vnonlocal_i_old, &
               &                      dion_paw_old )
       else
          call map_vhsr_to_rho_noncl( rho_vhsr,  vnonlocal_r,     vnonlocal_i )
          call map_vhsr_to_rho_noncl( rhoo_vhsr, vnonlocal_r_old, vnonlocal_i_old )
       endif
    else
       if ( flg_paw ) then
          call map_vhsr_to_rho( rho_vhsr,  vnonlocal_r,     dion_paw )
          call map_vhsr_to_rho( rhoo_vhsr, vnonlocal_r_old, dion_paw_old )
       else
          call map_vhsr_to_rho( rho_vhsr,  vnonlocal_r )
          call map_vhsr_to_rho( rhoo_vhsr, vnonlocal_r_old )
       endif
    endif

    allocate(rmxtrc(nspin_m))
    if ( noncol ) then
       rmxtrc(1:nspin_m) = rmx
    else
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vlhxcstore_recompos_vlhxc(rmx,rmxtrc) ! --> vlhxc_l,vlhxco_l, rmxtrc
       else
          rmxtrc(1:nspin_m) = rmx
       end if
    endif
! ========================================================================= 11.0

    if ( noncol ) then
       rmxtrc = rmx
    else
       if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
          call alloc_rhostore_recomp( rmx, rmxtrc )
       else
          rmxtrc = rmx
       endif
    endif

! ====================================== Modified by K. Tagami =========
!    allocate(c_p(ista_kngp:iend_kngp)); call precon_4_pot_mix(rmx,c_p)
! --> T. Yamasaki, 03rd Aug. 2009
!!$    allocate(c_p(ista_kngp:iend_kngp)); c_p = 0; call precon_4_pot_mix(rmx,c_p)
    allocate(c_p(ista_kngp:iend_kngp,nspin_m)); c_p = 0
! ========================================================================


! ============================= modiifed by K. Tagami =================== 11.0
!    call precon_4_pot_mix(rmxtrc,c_p)
!
    if ( noncol ) then
       call precon_4_pot_mix_noncl(rmxtrc,c_p)
    else
       call precon_4_pot_mix(rmxtrc,c_p)
    endif
! ====================================================================== 11.0

    iter = iter_from_reset()                 !-(m_Pot)

    if((iter-istrbr+1) <= 1) then
       call simple_mix1(c_p)                 !-(m_Pot)
       call simple_mix_kt( rmxtrc )
       !   din=vlhxco_l; dout=vlhxc_l; (din,dout,c_p)->vlhxc_l
    else
       call mix_pulay_alloc2   !-(m_Pot) d0_l,u_l, and w_l are allocated
       call mix_pulay_alloc2_vhsr()
       call set_ncrspd_mxiter(nbxmix,iter-istrbr,mxiter) ! -> ncrspd, mxiter
!!$       call mix_pulay_alloc3(mxiter)   !-(c.h.) e_wk,f_wk,ww1,finv,ip

       call Resid_and_dd_into_urec_with_vhsr(mxiter) !-(c.h.)
       call Ri_dot_Rj_with_vhsr(mxiter)          !-(c.h.) <R(i)|R(j)>->f
       call get_finv_lapack_with_vhsr(nbxmix,mxiter,f)  !-(c.h.) f -> f^{-1}= <R(i)|R(j)>^{-1}
       call Rj_dot_d_with_vhsr(mxiter)           !-(c.h.) <R(j)|d>,(j=1,iter-istrb) -> uuf_p
       call get_gmatrix_with_vhsr(mxiter)        !-(c.h.) (f,uuf_p)->g
       call renew_d_using_g_with_vhsr(mxiter,c_pm)     !-(c.h.)

!!$       call mix_pulay_dealloc3                    !-(c.h.)
       call mix_pulay_dealloc2                    !-(m_Pot)
       call mix_pulay_dealloc2_vhsr                    !-(m_Pot)
    endif

    if ( .not. noncol ) then
       if(sw_recomposing == YES .and. af == 0 .and. nspin == 2) then
          call compos_vlhxc_dealloc_vlhxcstore()
       end if
       if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2 ) then
          call compose_rho_dealloc_store
       end if
    endif

    if ( noncol ) then
       if ( flg_paw ) then
          call map_rho_to_vhsr_noncl( rho_vhsr, vnonlocal_r, vnonlocal_i, dion_paw )
       else
          call map_rho_to_vhsr_noncl( rho_vhsr, vnonlocal_r, vnonlocal_i )
       endif
    else
       if ( flg_paw ) then
          call map_rho_to_vhsr( rho_vhsr, vnonlocal_r, dion_paw )
       else
          call map_rho_to_vhsr( rho_vhsr, vnonlocal_r )
       endif
    endif

    deallocate(rmxtrc)
    deallocate(c_p)

    previous_waymix = PULAY
    call tstatc0_end(id_sname)
  contains
    subroutine mix_pulay_alloc3(m)
      integer, intent(in) :: m
      allocate(e_wk(m*m)); allocate(f_wk(m*m)); allocate(ww1(m)); allocate(finv(m*m))
      allocate(ip(m))
! ===================================== Added by K. Tagami ============
      e_wk = 0; f_wk = 0; ww1 = 0; finv = 0; ip = 0
! =====================================================================
    end subroutine mix_pulay_alloc3

    subroutine set_ncrspd_mxiter(n,iter,m)
      integer, intent(in)  :: n, iter
      integer, intent(out) :: m
      integer :: i, nx
      if(hownew == ANEW) then
         m = iter
         ncrspd(:) = (/(i,i=1,m)/)
      else ! hownew == RENEW
         if(iter <= n) then
            m = iter
            ncrspd(:) = (/(i,i=1,m)/)
         else
            m = n
            nx = ncrspd(1)
            do i = 1, m-1
               ncrspd(i) = ncrspd(i+1)
            end do
            ncrspd(m) = nx
         end if
      end if
    end subroutine set_ncrspd_mxiter

    subroutine mix_pulay_dealloc3
      deallocate(e_wk); deallocate(f_wk); deallocate(ww1); deallocate(finv)
      deallocate(ip)
    end subroutine mix_pulay_dealloc3

    subroutine Resid_and_dd_into_urec_with_vhsr(iter)
      integer, intent(in) :: iter
      integer             :: itc,itc0,itc1
      integer :: i,j,k,nmix,imix
      itc = ncrspd(iter)
      if(sw_gradient_simplex==ON)then
         do imix=2,iter-1
            itc0 = ncrspd(imix)
            itc1 = ncrspd(imix-1)
            do i=1,nspin_m
               do j=1,kimg
                  do k=ista_kgpm,iend_kgpm
                     urec_l(k,j,i,itc0,iResid) = rho(k,j,i)-rhoo(k,j,i)-(Frhoj(k,j,i,itc1)-rhoj(k,j,i,itc1))
                     urec_l(k,j,i,itc0,iRho  ) = rhoo(k,j,i)-rhoj(k,j,i,itc1)
                  enddo
               enddo
            enddo
            do i=1,nspin_m
               do j=1,nsize_rho_vhsr
                  urec_vhsr(j,i,itc0,iResid) = rho_vhsr(j,i) - rhoo_vhsr(j,i) - (Frhoj_vhsr(j,i,itc1) - rhoj_vhsr(j,i,itc1))
                  urec_vhsr(j,i,itc0,iRho  ) = rhoo_vhsr(j,i) - rhoj_vhsr(j,i,itc1)
               enddo
            enddo
         enddo
         do i=1,nspin_m
            do j=1,kimg
               do k=ista_kgpm,iend_kgpm
                  urec_l(k,j,i,itc,iResid) = rho(k,j,i)-rhoo(k,j,i)-(dout(k,j,i)-din(k,j,i))
                  urec_l(k,j,i,itc,iRho  ) = rhoo(k,j,i)-din(k,j,i)
                  rhoj(k,j,i,itc) = rhoo(k,j,i)
                  Frhoj(k,j,i,itc) = rho(k,j,i)
                  d0_l(k,j,i) = rho(k,j,i) - rhoo(k,j,i)
                  din(k,j,i)  = rhoo(k,j,i)
                  dout(k,j,i) = rho(k,j,i)
               enddo
            enddo
         enddo
         do i=1,nspin_m
            do j=1,nsize_rho_vhsr
               urec_vhsr(j,i,itc,iResid) = rho_vhsr(j,i) - rhoo_vhsr(j,i) - (dout_vhsr(j,i) - din_vhsr(j,i)) ! =dF(=delta F^i)
               urec_vhsr(j,i,itc,iRho  ) = rhoo_vhsr(j,i) - din_vhsr(j,i)                ! =dd
               d0_vhsr(j,i) = rho_vhsr(j,i) - rhoo_vhsr(j,i)
               din_vhsr(j,i) = rhoo_vhsr(j,i)
               dout_vhsr(j,i) = rho_vhsr(j,i)
               rhoj_vhsr(j,i,itc) = rhoo_vhsr(j,i)
               Frhoj_vhsr(j,i,itc) = rho_vhsr(j,i)
            enddo
         enddo
      else
         do i=1,nspin_m
            do j=1,kimg
               do k=ista_kgpm,iend_kgpm
                  urec_l(k,j,i,itc,iResid) = rho(k,j,i) - rhoo(k,j,i) - (dout(k,j,i) - din(k,j,i)) ! =dF(=delta F^i)
                  urec_l(k,j,i,itc,iRho  ) = rhoo(k,j,i) - din(k,j,i)                ! =dd
                  d0_l(k,j,i) = rho(k,j,i) - rhoo(k,j,i)
                  din(k,j,i)  = rhoo(k,j,i)
                  dout(k,j,i) = rho(k,j,i)
               enddo
            enddo
         enddo
         do i=1,nspin_m
            do j=1,nsize_rho_vhsr
               urec_vhsr(j,i,itc,iResid) = rho_vhsr(j,i) - rhoo_vhsr(j,i) - (dout_vhsr(j,i) - din_vhsr(j,i)) ! =dF(=delta F^i)
               urec_vhsr(j,i,itc,iRho  ) = rhoo_vhsr(j,i) - din_vhsr(j,i)                ! =dd
               d0_vhsr(j,i) = rho_vhsr(j,i) - rhoo_vhsr(j,i)
               din_vhsr(j,i) = rhoo_vhsr(j,i)
               dout_vhsr(j,i) = rho_vhsr(j,i)
            enddo
         enddo
      endif
    end subroutine Resid_and_dd_into_urec_with_vhsr

    subroutine Ri_dot_Rj_with_vhsr(n)
      integer, intent(in) :: n
      integer  :: it,jt,itc,jtc,is
! === DEBUG by tkato 2011/11/24 ================================================
!     real(DP) :: ff1(nspin),ff2(nspin),ff1tmp
      real(DP) :: ff1(nspin_m),ff2(nspin_m),ff1tmp
! ==============================================================================
      do it = 1, n
         itc = ncrspd(it)
         do jt = it, n
            jtc = ncrspd(jt)
#ifdef _CDMIX_USE_POINTER_
            urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,itc,iResid)
            urec_l_3_2 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,jtc,iResid)
            call mult1s(urec_l_3,urec_l_3_2,f_p,ff1)   ! <delta F^i|delta F^j>
#else
            if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
               ff1tmp=0.d0
               call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp)   ! <delta F^i|delta F^j>
               do is=1,nspin_m,af+1
                  ff1tmp = ff1tmp+sum(urec_vhsr(:,is,itc,iResid) * urec_vhsr(:,is,jtc,iResid))
               enddo
               ff1(1) = ff1tmp
               ff1(2) = ff1tmp
            else
               call mult1s10(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1)   ! <delta F^i|delta F^j>
               do is=1,nspin_m,(af+1)
                  ff1(is) = ff1(is)+sum(urec_vhsr(:,is,itc,iResid) * urec_vhsr(:,is,jtc,iResid))
               enddo
            endif

! ============================= added by K. Tagami ======================= 11.0
            if ( noncol ) then
               ff1tmp=0.d0
               call mult1s10_reduce_spin(urec_l,nbxmix,2,itc,iResid,urec_l,jtc,iResid,f_p,ff1tmp)   ! <delta F^i|delta F^j>
               do is=1,ndim_magmom
                  ff1tmp = ff1tmp+sum(urec_vhsr(:,is,itc,iResid) * urec_vhsr(:,is,jtc,iResid))
               enddo
               ff1(:) = ff1tmp
            endif
! ======================================================================== 11.0
#endif
            f(it,jt,1:nspin_m) = ff1(1:nspin_m)
            if(jt /= it) f(jt,it,1:nspin_m) = f(it,jt,1:nspin_m)
         end do
      end do
    end subroutine Ri_dot_Rj_with_vhsr

    subroutine Rj_dot_d_with_vhsr(n)
      integer, intent(in) :: n
      integer  :: jt, jtc, is
! === DEBUG by tkato 2011/11/24 ================================================
!     real(DP) :: ff1(nspin),ff2(nspin)
      real(DP) :: ff1(nspin_m),ff2(nspin_m)
! ==============================================================================
      real(DP) :: ff1tmp
      do jt = 1, n
         jtc = ncrspd(jt)
#ifdef _CDMIX_USE_POINTER_
         urec_l_3 => urec_l(ista_kgpm:iend_kgpm,1:kimg,1:nspin_m,jtc,iResid)
         call mult1s(urec_l_3,d0_l,f_p,ff1)
#else
         if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
            ff1tmp=0.d0
            call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
            do is=1,nspin_m,af+1
               ff1tmp = ff1tmp+sum(urec_vhsr(:,is,jtc,iResid) * d0_vhsr(:,is))
            enddo
            ff1(1) = ff1tmp;ff1(2) = ff1tmp
         else
            call mult1s5(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1)
            ff2=0.d0
            do is=1,nspin_m,af+1
               ff2(is) = ff2(is)+sum(urec_vhsr(:,is,jtc,iResid) * d0_vhsr(:,is))
            enddo
            ff1(:) = ff1(:)+ff2(:)
         endif

! =========================== added by K. Tagami ================== 11.0
         if ( noncol ) then
            ff1tmp=0.d0
            call mult1s5_reduce_spin(urec_l,nbxmix,2,jtc,iResid,d0_l,f_p,ff1tmp)
            do is=1,ndim_magmom
               ff1tmp = ff1tmp+sum(urec_vhsr(:,is,jtc,iResid) * d0_vhsr(:,is))
            enddo
            ff1(:) = ff1tmp
         endif
! ================================================================ 11.0         

#endif
         uuf_p(jt,1:nspin_m) = ff1(1:nspin_m)
      end do
    end subroutine Rj_dot_d_with_vhsr

    subroutine get_finv_lapack_with_vhsr(m,n,f)
      integer,intent(in)                             :: m,n
      real(DP),intent(inout),dimension(m,m,nspin_m) :: f
      real(DP), allocatable,dimension(:,:) :: fwork
      integer :: is,inf,it,jt,kt,nnspin
      real(DP) :: div,tmp
      allocate(fwork(n,n))
      nnspin = nspin
      if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1

! ============================== added by K. Tagami ============== 11.0
      if ( noncol )  nnspin = 1 
! ================================================================ 11.0

      do is=1,nnspin
         if(ipripulay >= 2) then
            write(nfout,600) n,(('(',it,jt,')',f(it,jt,is),jt=1,n),it=1,n)
600         format(//11x,"**input matrix**"/12x &
                 & ,"horder=",I5/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
         fwork=0
         do it=1,n
            do jt=1,n
               fwork(jt,it) = f(jt,it,is)
               if(it==jt) fwork(jt,it)=fwork(jt,it)+alpha_pulay
            enddo
         enddo
         call dpotrf('U',n,fwork,n,inf)
         call dpotri('U',n,fwork,n,inf)
         do it=1,n-1
            do jt=it+1,n
               fwork(jt,it) = fwork(it,jt)
            enddo
         enddo
         do it=1,n
            do jt=1,n
               f(jt,it,is) = fwork(jt,it)
            enddo
         enddo
         if(ipripulay >= 2) then
            write(nfout,630) (('(',it,jt,')',f(it,jt,is),it=1,n),jt=1,n)
630         format(/11x, "**inverse matrix**" &
                 & ,/(2x,4(1x,1a,i2,",",i2,1a,e14.6)))
         end if
      enddo
      if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
         do it=1,n
            do jt=1,n
               f(jt,it,2) = f(jt,it,1)
            enddo
         enddo
      endif

! ================================= added by K. Tagami ================= 11.0
      if ( noncol ) then
         do it=1,n
            do jt=1,n
               f(jt,it,:) = f(jt,it,1)
            enddo
         end do
      endif
! ====================================================================== 11.0
      deallocate(fwork)
    end subroutine get_finv_lapack_with_vhsr

    subroutine get_gmatrix_with_vhsr(n)
      integer,intent(in) :: n
      integer :: is, it, jt, nnspin
      nnspin = nspin
      if(sw_mix_bothspins_sametime==ON .or. af==1) nnspin=1

! ============================== added by K. Tagami ============== 11.0
      if ( noncol )  nnspin = 1 
! ================================================================ 11.0

      g_p = 0.d0
      do is = 1, nnspin
         do it = 1, n
            do jt = 1, n
               g_p(it,is) = g_p(it,is) - f(jt,it,is)*uuf_p(jt,is)
            end do
         end do
         if(ipripulay >= 2) then
            write(nfout,'(" -- g_p(1:",i3,") --")') n
            write(nfout,'(8f20.12)') (g_p(it,is),it=1,n)
         end if
      end do
      if(sw_mix_bothspins_sametime==ON .and. nspin_m>1)then
         do it = 1,n
            g_p(it,2) = g_p(it,1)
         enddo
      endif
! ================================= added by K. Tagami ================= 11.0
      if ( noncol ) then
         do it = 1,n
            g_p(it,:) = g_p(it,1)
         end do
      end if
! ====================================================================== 11.0
    end subroutine get_gmatrix_with_vhsr

    subroutine renew_d_using_g_with_vhsr(n,p)
      integer, intent(in)                                :: n
      real(DP),intent(in),dimension(ista_kgpm:iend_kgpm,nspin_m) :: p
      integer    :: is, k, i, it, itc, ns

!!$      do is = 1, nspin, af+1
      ns = nspin_for_qnewton()
      do is = 1, ns,af+1
         do k = 1, kimg
            do i = ista_kngp, iend_kngp
               rho(i,k,is)  = rhoo(i,k,is) + p(i,is)*d0_l(i,k,is)
            end do
            do it = 1, n
               itc = ncrspd(it)
               do i = ista_kngp, iend_kngp
                  rho(i,k,is) = rho(i,k,is) + g_p(it,is)* &
                       &        (urec_l(i,k,is,itc,iRho) + p(i,is)*urec_l(i,k,is,itc,iResid))
               end do
            end do
         end do
      end do
      do is=1,ns,af+1
         rho_vhsr(:,is) = rhoo_vhsr(:,is) + rmxtrc(is) * d0_vhsr(:,is)
         do it = 1, n
            itc = ncrspd(it)
            rho_vhsr(:,is) = rho_vhsr(:,is) + g_p(it,is) * &
          & (urec_vhsr(:,is,itc,iRho) + rmxtrc(is)*urec_vhsr(:,is,itc,iResid))
         enddo
      enddo

! ============================== modified by K. Tagami ================ 11.0
!      if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) call simple_mix2(c_p)
!      if(sw_force_simple_mixing_hsr==ON .and. sw_recomposing_vhsr==ON ) call simple_mix2_kt( rmxtrc )
!
      if ( .not. noncol ) then
         if(sw_force_simple_mixing==ON .and. sw_recomposing==ON) then
            call simple_mix2(c_p)
         endif
         if(sw_force_simple_mixing_hsr==ON .and. sw_recomposing_hsr==ON ) then
            call simple_mix2_kt( rmxtrc )
         endif
      endif
! ===================================================================== 11.0

      if(kgpm < kgp) then
         call concentrate_d_to_chg(rho,vlhxc_l) !-(m_C.D.)
         call simple_mix_large_Gc(c_p)         !-(m_C.D.) vlhxc,vlhxco,c_p ->vlhxc
      end if
    end subroutine renew_d_using_g_with_vhsr
  end subroutine m_Pot_mix_pulay_with_vhsr
!!$ 11.07 AS Pulay version of 'sw_mix_potential_hardpart'

! ========================= added by K. Tagami ===================== 5.0
  subroutine create_map_func(paramset)
    logical :: paramset
    integer :: n, ia, it
    integer :: lmt1, lmt2

    if ( noncol ) then
       n=0
       do ia=1,natm
          it = ityp(ia)
          do lmt1=1, ilmt(it)
             do lmt2 = lmt1, ilmt(it)
                n=n+1
                if(.not.paramset) &
                     & imap_vhsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
             end do
          end do
       end do
       nsize_rho_vhsr = n;   nsize_rho_vhsr_unit = n

       if ( sw_mix_imaginary_hardpart == ON ) then
          do ia=1,natm
             it = ityp(ia)
             do lmt1=1, ilmt(it)
                do lmt2 = lmt1 +1, ilmt(it)
                   n=n+1
                   if(.not.paramset) &
                        & imap_vhsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
                end do
             end do
          end do
          nsize_rho_vhsr = n
       endif

       if ( flg_paw ) then
          do ia=1,natm
             it = ityp(ia)
             do lmt1=1, ilmt(it)
                do lmt2 = lmt1 +1, ilmt(it)
                   n=n+1
                   if(.not.paramset) &
                        & imap_vhsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
                end do
             end do
          end do
          nsize_rho_vhsr = n
       endif

    else
       n=0
       do ia=1,natm
          it = ityp(ia)
          do lmt1=1, ilmt(it)
             do lmt2 = lmt1, ilmt(it)
                n=n+1
                if(.not.paramset) &
                     & imap_vhsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
             end do
          end do
       end do
       nsize_rho_vhsr = n;   nsize_rho_vhsr_unit = n

       if ( flg_paw ) then
          do ia=1,natm
             it = ityp(ia)
             do lmt1=1, ilmt(it)
                do lmt2 = lmt1 +1, ilmt(it)
                   n=n+1
                   if(.not.paramset) &
                        & imap_vhsr(n) = ia + natm *(lmt1-1) + natm*nlmt*( lmt2 -1 )
                end do
             end do
          end do
          nsize_rho_vhsr = n
       endif

    endif
! ================================================================= 11.0
  end subroutine create_map_func

  subroutine alloc_rho_vhsr
! ================================ modified by K. Tagami ============== 11.0
!    allocate( rho_vhsr( nsize_rho_vhsr,nspin)); rho_vhsr = 0.0d0
!    allocate( rhoo_vhsr(nsize_rho_vhsr,nspin));rhoo_vhsr = 0.0d0
    allocate( rho_vhsr( nsize_rho_vhsr,ndim_magmom)); rho_vhsr = 0.0d0
    allocate( rhoo_vhsr(nsize_rho_vhsr,ndim_magmom));rhoo_vhsr = 0.0d0
! ====================================================================== 11.0
    allocate( imap_vhsr(nsize_rho_vhsr) ); imap_vhsr = 0
  end subroutine alloc_rho_vhsr

  subroutine dealloc_rho_vhsr
    deallocate(rho_vhsr)
    deallocate(rhoo_vhsr)
    deallocate(imap_vhsr)
  end subroutine dealloc_rho_vhsr

  subroutine map_vhsr_to_rho( rho, vnonlocal, dion_paw )
    real(kind=DP), intent(out) :: rho( nsize_rho_vhsr,nspin)
    real(kind=DP), intent(in) :: vnonlocal( nlmt, nlmt, natm, nspin )
    real(kind=DP), optional, intent(in) :: dion_paw( nlmt, nlmt, nspin, natm )

    integer :: i, it, is, ia, ilmt1, ilmt2, n, icount

    real(kind=DP), allocatable :: vhsr(:,:)

    allocate( vhsr( natm*nlmt*nlmt, nspin ) )

    vhsr = 0.0d0;   n=0;   icount = 0
    do ia=1,natm
       it = ityp(ia)
       do ilmt1=1, ilmt(it)
          do ilmt2 = 1, ilmt(it)
             n = n +1
             Do is=1, nspin
                vhsr(n,is) = vnonlocal( ilmt1,ilmt2,ia,is )
             End do
          End do
       End do
    End Do
    do is=1,nspin,(af+1)
       do i=1, nsize_rho_vhsr_unit
          rho(i,is) = vhsr(imap_vhsr(i),is)
       end do
    end do

    if ( flg_paw ) then
       vhsr = 0.0d0;   n=0;   icount = icount+1
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, nspin
                   vhsr( n,is ) = dion_paw( ilmt1,ilmt2,is,ia )
                End do
             End do
          End do
       End Do
       do is=1,nspin,(af+1)
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             rho(i,is) = vhsr(imap_vhsr(i),is)
          end do
       end do
    endif

    deallocate( vhsr )

  end subroutine map_vhsr_to_rho

! ============================================ added by K. Tagami ======== 11.0
  subroutine map_vhsr_to_rho_noncl( rho, vnonlocal_r, vnonlocal_i, dion_paw )
    real(kind=DP), intent(out) :: rho( nsize_rho_vhsr,ndim_magmom )
    real(kind=DP), intent(in) :: vnonlocal_r( nlmt, nlmt, natm, nspin )
    real(kind=DP), intent(in) :: vnonlocal_i( nlmt, nlmt, natm, nspin )
    real(kind=DP), optional, intent(in) :: dion_paw( nlmt, nlmt, nspin, natm )

    integer :: i, n, is, ia, ilmt1, ilmt2, it, icount
    real(kind=DP), allocatable :: vhsr(:,:), vhsi(:,:)

    allocate( vhsr( natm*nlmt*nlmt, ndim_magmom ) )
    allocate( vhsi( natm*nlmt*nlmt, ndim_magmom ) )

    vhsr = 0.0d0;  n = 0;  icount = 0
    Do ia=1, natm
       it = ityp(ia)
       Do ilmt1=1, ilmt(it)
          Do ilmt2=1, ilmt(it)
             n = n +1
             Do is=1, ndim_magmom
                vhsr( n,is ) = vnonlocal_r(ilmt1,ilmt2,ia,is)
             End do
          End do
       End do
    End Do
    do is=1,ndim_magmom
       do i=1,nsize_rho_vhsr_unit
          rho(i,is) = vhsr( imap_vhsr(i),is )
       end do
    end do

    if ( sw_mix_imaginary_hardpart == ON ) then
       vhsi = 0.0d0;  n = 0;  icount = icount +1
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, ndim_magmom
                   vhsi( n,is ) = vnonlocal_i(ilmt1,ilmt2,ia,is)
                End do
             End do
          End do
       End Do
       do is=1,ndim_magmom
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             rho(i,is) = vhsi( imap_vhsr(i),is )
          end do
       end do
    end if

    if ( flg_paw ) then
       vhsr = 0.0d0;   n=0;   icount = icount+1
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, ndim_magmom
                   vhsr( n,is ) = dion_paw( ilmt1,ilmt2,is,ia )
                End do
             End do
          End do
       End Do
       do is=1,ndim_magmom
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             rho(i,is) = vhsr( imap_vhsr(i),is )
          end do
       end do
    endif

    deallocate( vhsr )
    if ( allocated( vhsi ) ) deallocate( vhsi )

  end subroutine map_vhsr_to_rho_noncl
! ===================================================================== 11.0

  subroutine map_rho_to_vhsr( rho, vnonlocal, dion_paw )
    real(kind=DP), intent(in) :: rho( nsize_rho_vhsr,nspin )
    real(kind=DP), intent(out) :: vnonlocal( nlmt, nlmt, natm, nspin )
    real(kind=DP), optional, intent(out) :: dion_paw( nlmt, nlmt, nspin, natm )

    integer :: i, is, ia, ilmt1, ilmt2, n, it, icount
    real(kind=DP), allocatable :: vhsr(:,:)

    allocate( vhsr( natm*nlmt*nlmt, nspin ) )

    vhsr = 0.0d0; icount = 0
    do is=1,nspin,(af+1)
       do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
          vhsr(imap_vhsr(i),is) = rho(i,is)
       end do
    end do
    call symmetrize(vhsr)

    n = 0
    Do ia=1, natm
       it = ityp(ia)
       Do ilmt1=1, ilmt(it)
          Do ilmt2=1, ilmt(it)
             n = n +1
             Do is=1, nspin
                vnonlocal( ilmt1,ilmt2,ia,is ) = vhsr( n,is )
             End do
          End do
       End do
    End Do

    if (flg_paw) then
       vhsr = 0.0d0; icount = icount +1
       do is=1,nspin,(af+1)
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             vhsr(imap_vhsr(i),is) = rho(i,is)
          end do
       end do
       call symmetrize(vhsr)
!
       n = 0
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, nspin
                   dion_paw( ilmt1,ilmt2,is,ia ) = vhsr( n,is )
                End do
             End do
          End do
       End Do
    endif

    deallocate( vhsr )

  contains

    subroutine symmetrize(vhsr)
      real(kind=DP), intent(inout) :: vhsr( natm, nlmt, nlmt, nspin )

      integer :: is, lmt1, lmt2, ia

      do is=1,nspin,(af+1)
         do ia=1,natm
            do lmt1=1, nlmt
               do lmt2=lmt1, nlmt
                  if ( lmt1/=lmt2 ) vhsr(ia,lmt2,lmt1,is) = vhsr(ia,lmt1,lmt2,is)
               end do
            end do
         end do
      end do
    end subroutine symmetrize
  end subroutine map_rho_to_vhsr
! ========================================================================= 5.0

  subroutine map_rho_to_vhsr_noncl( rho, vnonlocal_r, vnonlocal_i, dion_paw )
    real(kind=DP), intent(in) :: rho( nsize_rho_vhsr, ndim_magmom )
    real(kind=DP), intent(out) :: vnonlocal_r( nlmt, nlmt, natm, nspin )
    real(kind=DP), intent(out) :: vnonlocal_i( nlmt, nlmt, natm, nspin )
    real(kind=DP), optional, intent(out) :: dion_paw( nlmt, nlmt, nspin, natm )

    integer :: i, is, ia, ilmt1, ilmt2, n, it, icount
    real(kind=DP), allocatable :: vhsr(:,:), vhsi(:,:)

    allocate( vhsr( natm*nlmt*nlmt, ndim_magmom ) )
    allocate( vhsi( natm*nlmt*nlmt, ndim_magmom ) )

    vhsr = 0.0d0;  icount = 0
    do is=1,ndim_magmom
       do i=1,nsize_rho_vhsr_unit
          vhsr(imap_vhsr(i),is) = rho(i,is)
       end do
    end do
    call symmetrize_r(vhsr)
!
    n = 0
    Do ia=1, natm
       it = ityp(ia)
       Do ilmt1=1, ilmt(it)
          Do ilmt2=1, ilmt(it)
             n = n +1
             Do is=1, nspin
                vnonlocal_r( ilmt1,ilmt2,ia,is ) = vhsr( n,is )
             End do
          End do
       End do
    End Do
    
    if ( sw_mix_imaginary_hardpart == ON ) then
       vhsi = 0.0d0;  icount = icount +1
       do is=1,ndim_magmom
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             vhsi(imap_vhsr(i),is) = rho(i,is)
          end do
       end do
       call symmetrize_i(vhsi)
!
       n = 0
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, nspin
                   vnonlocal_i( ilmt1,ilmt2,ia,is ) = vhsi( n,is )
                End do
             End do
          End do
       End Do
    endif

    if ( flg_paw ) then
       vhsr = 0.0d0;  icount = icount +1
       do is=1,ndim_magmom
          do i=nsize_rho_vhsr_unit*icount +1, nsize_rho_vhsr_unit*( icount+1 )
             vhsr(imap_vhsr(i),is) = rho(i,is)
          end do
       end do
       call symmetrize_r(vhsi)
!
       n = 0
       Do ia=1, natm
          it = ityp(ia)
          Do ilmt1=1, ilmt(it)
             Do ilmt2=1, ilmt(it)
                n = n +1
                Do is=1, ndim_magmom
                   dion_paw( ilmt1,ilmt2,is,ia ) = vhsr( n,is )
                End do
             End do
          End do
       End Do
    endif

    deallocate( vhsr )
    if ( allocated( vhsi ) ) deallocate( vhsi )

  contains
    subroutine symmetrize_r(vhsr)
      real(kind=DP), intent(inout) :: vhsr( natm, nlmt, nlmt, ndim_magmom )

      integer :: is, ia, lmt1, lmt2

      do is=1,ndim_magmom
         do ia=1,natm
            do lmt1=1, nlmt
               do lmt2=lmt1, nlmt
                  if ( lmt1/=lmt2 ) then
                     vhsr(ia,lmt2,lmt1,is) = vhsr(ia,lmt1,lmt2,is)
                  endif
               end do
            end do
         end do
      end do
    end subroutine symmetrize_r

    subroutine symmetrize_i(vhsi)
      real(kind=DP), intent(inout) :: vhsi( natm, nlmt, nlmt, ndim_magmom )

      integer :: is, ia, lmt1, lmt2

      do is=1,ndim_magmom
         do ia=1,natm
            do lmt1=1, nlmt
               do lmt2=lmt1, nlmt
                  if ( lmt1/=lmt2 ) then
                     vhsi(ia,lmt2,lmt1,is) = -vhsi(ia,lmt1,lmt2,is)
                  endif
               end do
            end do
         end do
      end do
    end subroutine symmetrize_i
    
  end subroutine map_rho_to_vhsr_noncl
! ========================================================================= 11.0

! ========================= added by K. Tagami========================== 5.0
  subroutine m_Pot_simple_mixing_hard( nfout,rmxt )
    integer, intent(in) :: nfout
    real(kind=DP), intent(in) :: rmxt

    integer :: is

! =============================== modified by K.Tagami ================ 11.0
!    nspin_m  = nspin/(af+1)
    if ( noncol ) then
       nspin_m = ndim_magmom
    else
       nspin_m  = nspin/(af+1)
    endif
! ====================================================================== 11.0

    allocate( rmxtrc(nspin_m) )

! ============================= modified by K. Tagami =============== 11.0
!    if ( sw_recomposing_vhsr == YES .and. af == 0 .and. nspin == 2 ) then
!       call alloc_vhsrstore_recomp( rmxt, rmxtrc )
!    else
!       rmxtrc = rmxt
!    endif

    if ( noncol ) then
       rmxtrc = rmxt
    else
       if( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2) then
          call alloc_vhsrstore_recomp(rmxt,rmxtrc)
       else
          rmxtrc = rmxt
       endif
    end if
! ==================================================================== 11.0

    if ( noncol ) then
       Do is=1, ndim_magmom
          vnonlocal_r(:,:,:,is) = rmxtrc(is) *vnonlocal_r(:,:,:,is) &
            &              + ( 1.d0-rmxtrc(is) ) *vnonlocal_r_old(:,:,:,is)
       End do

       if ( sw_mix_imaginary_hardpart == ON ) then
          Do is=1, ndim_magmom
             vnonlocal_i(:,:,:,is) = rmxtrc(is) *vnonlocal_i(:,:,:,is) &
                  &              + ( 1.d0-rmxtrc(is) ) *vnonlocal_i_old(:,:,:,is)
          End do
       endif

       if ( flg_paw ) then
          Do is=1, ndim_magmom
             dion_paw(:,:,is,:) = rmxtrc(is) *dion_paw(:,:,is,:) &
                  &              + ( 1.d0-rmxtrc(is) ) *dion_paw_old(:,:,is,:)
          End do
       endif

       stop "kt: under construction, 100"

    else
       Do is=1, nspin, af+1
          vnonlocal_r(:,:,:,is) = rmxtrc(is) *vnonlocal_r(:,:,:,is) &
            &              + ( 1.d0-rmxtrc(is) ) *vnonlocal_r_old(:,:,:,is)
       End do
       if ( flg_paw ) then
          Do is=1, nspin, af+1
             dion_paw(:,:,is,:) = rmxtrc(is) *dion_paw(:,:,is,:) &
                  &              + ( 1.d0-rmxtrc(is) ) *dion_paw_old(:,:,is,:)
          End do
       endif
    endif

    if ( .not. noncol ) then
       if ( sw_recomposing_hsr == YES .and. af == 0 .and. nspin == 2) then
          call compose_vhsr_dealloc_store
       end if
    endif

    deallocate(rmxtrc)

  end subroutine m_Pot_simple_mixing_hard
! ============================================================== 5.0

  subroutine m_Pot_simple_mixing_vhsr(nfout,rmxt)
    integer ,intent(in)      :: nfout
    real(kind=DP),intent(in) :: rmxt

    integer:: ia,it,is,lmt1,lmt2
#ifdef __TIMER_SUB__
    call timer_sta(1144)
#endif

#ifdef __TIMER_DO__
    call timer_sta(1192)
#endif
    if ( noncol ) then
       do ia = 1, natm
          it = ityp(ia)
          do is = 1, ndim_magmom
             do lmt1 = 1, ilmt(it)
                do lmt2 = 1, ilmt(it)
                   vnonlocal_r(lmt1,lmt2,ia,is) &
                        &   = rmxt *vnonlocal_r(lmt1,lmt2,ia,is) &
                        &    +(1-rmxt) *vnonlocal_r_old(lmt1,lmt2,ia,is)
                end do
             end do
          end do
       end do

       if ( sw_mix_imaginary_hardpart == ON ) then
          do ia = 1, natm
             it = ityp(ia)
             do is = 1, ndim_magmom
                do lmt1 = 1, ilmt(it)
                   do lmt2 = 1, ilmt(it)
                      vnonlocal_i(lmt1,lmt2,ia,is) &
                           &   = rmxt *vnonlocal_i(lmt1,lmt2,ia,is) &
                           &    +(1-rmxt) *vnonlocal_i_old(lmt1,lmt2,ia,is)
                   end do
                end do
             end do
          end do
       endif

    else
       do ia = 1, natm
          it = ityp(ia)
          
          do is = 1, nspin, af+1
             do lmt1 = 1, ilmt(it)
                do lmt2 = lmt1, ilmt(it)
                   vnonlocal_r(lmt1,lmt2,ia,is) &
                        &   = rmxt *vnonlocal_r(lmt1,lmt2,ia,is) &
                        &    +(1-rmxt) *vnonlocal_r_old(lmt1,lmt2,ia,is)
                end do
             end do
          end do

          if ( ipaw(it) == 0 ) cycle

          do is = 1, nspin, af+1
             do lmt1 = 1, ilmt(it)
                do lmt2 = lmt1, ilmt(it)
                   dion_paw(lmt1,lmt2,is,ia) = rmxt *dion_paw(lmt1,lmt2,is,ia) &
                        &                  + (1-rmxt) *dion_paw_old(lmt1,lmt2,is,ia)
                end do
             end do
          end do

       end do
    end if
#ifdef __TIMER_DO__
    call timer_end(1192)
#endif

#ifdef __TIMER_SUB__
    call timer_end(1144)
#endif
  end subroutine m_Pot_simple_mixing_vhsr

end module m_Potential_mixing
