! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       PROGRAM  ASCOT 2014.440 (ver.4.53)                       @@ !
! @@     "Abinitio Simulation Code for Quantum Transport"           @@ !
! @@                                                                @@ !
! @@                                                                @@ !
! @@  AUTHOR(S): Hisashi KONDO (Univ. Tokyo)                        @@ !
! @@             Nobutaka NISHIKAWA (Mizuho I.R.)                   @@ !
! @@                                                09/May/2014     @@ !
! @@                                                                @@ !
! @@  Contact address: Phase System Consortium                      @@ !
! @@                                                                @@ !
! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !

subroutine set_scf_accel

  use scf_negf
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use mod_mpi


  implicit none
  real(8) :: tempr,tempi,tempr1,tempi1
  real(8) :: temp,omega_del_temp,omega_ef_temp,min_level_temp
  integer :: i_do,i1_do,i2_do,i3_do,i_hartree_temp,ispin_pol_scf_temp
  integer :: i_bios_minomega,i_omega_switch,i_omega_switch2
  integer :: itemp_ka_l,itemp_kb_l,itemp_ka_r,itemp_kb_r

  call set_scf_general(i_omega_switch,i_omega_switch2,omega_del_temp           &
       ,omega_ef_temp)


  call Param__read__ASCOT(file_parameter_ham_pot)

  call alo_scf_negf_parameter_1
  call Param__setup(1)
  call Param__setup__ASCOT

  call MPI__setup_ASCOT

  call Base__setup
  call Base__setup__ASCOT
  call alo_scf_accel_parameter
  call alo_potential

  call Param__show__ASCOT

  call Density__setup
  call Density__setup__ASCOT

  call Potential__setup
  call Potential__setup__ASCOT

  call h_v_atom
  call Hamiltonian__setup
  call Hamiltonian__setup__ASCOT                                               &
       (num_atom_scf,param_cell_nl,hv_atom_matrix,n_v_atom_matrix,n_v_nim_max)
  call Hamiltonian__loadAM_ASCOT

  call set_ham_negf_c1(file_parameter_hc_scf)
  call set_ham_negf_l(file_parameter_hl_scf,v_scf_l,i_rotspin_l)
  call set_ham_negf_r(file_parameter_hr_scf,v_scf_r,i_rotspin_r)

  open(unit=16,file=file_tempout,position='append')
  write(16,*)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '++++++++++++ calculating overlap and kinetic matrices ...'
  close(16)

  call AtomMatrix__calcSK

  if( param_option_projection == 'on' ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,*) '++++++++++++ calculating local pseudo potential matrices ...'
     close(16)
     call AtomMatrix__calcL
  end if
  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++ calculating nonlocal psudo potential matrices ...'
  close(16)
  call AtomMatrix__calcN
  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*)
  close(16)

  if( (i_rotspin_l == 1 .or. i_rotspin_r == 1) .and. ispin_pol_scf == 2 ) then
     call Hamiltonian__rotAM_ASCOT
  end if

  call Potential__deallocate2
  call Base__deallocate2

  do i1_do=1, num_atom_scf
     sum_charge(i1_do)=vatom_q(i1_do)
  end do

  if( spin_ll /= ispin_pol_scf ) then
     write(6,*) 'error: spin_ll(set_scf_accel)',spin_ll,ispin_pol_scf
     stop
  end if
  if( spin_rr /= ispin_pol_scf ) then
     write(6,*) 'error: spin_rr(set_scf_accel)',spin_rr,ispin_pol_scf
     stop
  end if


  open(unit=19,file=file_parameter_cv1_pot)

  read(19,*) ispin_pol_scf_temp
  read(19,*)
  read(19,*)
  read(19,*)
  read(19,*)
  read(19,*)
  read(19,*)

  if( ispin_pol_scf_temp+1 /= ispin_pol_scf ) then
     write(*,*) 'error: spin_vh'
     close(19)
     stop
  end if

  read(19,*)
  read(19,*) cp_scf_c
  read(19,*) min_level_c
  read(19,*)
  do i1_do=0,n_a-1
     do i2_do=0,n_b-1
        do i3_do=0,n_c-1
           read(19,*) v_hartree(i1_do*n_b*n_c+i2_do*n_c+i3_do+1)
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a-1
     do i2_do=0,n_b-1
        do i3_do=0,n_c-1
           if( ispin_pol_scf == 1 ) then
              read(19,*) temp
              v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=temp
           else
              if( ispin_pol_scf == 2 ) then
                 read(19,*) tempr,tempi
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempr
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempi
                 if( i_rotspin_l /= 0                                             &
                      .and. i3_do < n_c*shift_cell_l1/shift_cell_l2 ) then
                    v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempr
                    v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempi
                 end if
                 if( i_rotspin_r /= 0                                             &
                      .and. i3_do >= n_c*shift_cell_l1/shift_cell_l2 ) then
                    v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempr
                    v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempi
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempr
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempi
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,3)=tempr1
                 v_tot(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,4)=tempi1
              end if
           end if
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a-1
     do i2_do=0,n_b-1
        do i3_do=0,n_c-1
           if( ispin_pol_scf == 1 ) then
              read(19,*) temp
              rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=temp
           else
              if( ispin_pol_scf == 2 ) then
                 read(19,*) tempr,tempi
                 rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempr
                 rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempi
                 if( i_rotspin_l /= 0                                             &
                      .and. i3_do < n_c*shift_cell_l1/shift_cell_l2 ) then
                    rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempr
                    rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempi
                 end if
                 if( i_rotspin_r /= 0                                             &
                      .and. i3_do >= n_c*shift_cell_l1/shift_cell_l2 ) then
                    rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)=tempr
                    rho_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)=tempi
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 rhols_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,1)                    &
                      =dcmplx(tempr,tempi)
                 rhols_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,2)                    &
                      =dcmplx(tempr1,tempi1)
                 read(19,*) tempr,tempi,tempr1,tempi1
                 rhols_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,3)                    &
                      =dcmplx(tempr,tempi)
                 rhols_temp(i1_do*n_b*n_c+i2_do*n_c+i3_do+1,4)                    &
                      =dcmplx(tempr1,tempi1)
              end if
           end if
        end do
     end do
  end do

  close(19)


  open(unit=19,file=file_parameter_lv1_scf,status='old')

  read(19,*) ispin_pol_scf_l,itemp_ka_l,itemp_kb_l
  read(19,*)
  read(19,*) n_a_l,n_b_l,n_c_l
  read(19,*)

  ispin_pol_scf_l=ispin_pol_scf_l+1

  if( ispin_pol_scf_l /= ispin_pol_scf ) then
     write(*,*) 'error: spin_vh_l'
     close(19)
     stop
  end if

  if( n_a_l /= n_a ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,*) '          n_a_l /= n_a:'
     write(36,*) '               n_a_l=',n_a_l,'n_a=',n_a
     close(36)
  end if
  if( n_b_l /= n_b ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,*) '          n_b_l /= n_b:'
     write(36,*) '               n_b_l=',n_b_l,'n_b=',n_b
     close(36)
  end if

  call alo_potential_l

  read(19,*) cell_labc_l(1,1),cell_labc_l(1,2),cell_labc_l(1,3)
  read(19,*) cell_labc_l(2,1),cell_labc_l(2,2),cell_labc_l(2,3)
  read(19,*) cell_labc_l(3,1),cell_labc_l(3,2),cell_labc_l(3,3)

  call bound_cell_lr_l

  i_hartree_temp=l_cell_l_bound_l-1

  read(19,*)
  read(19,*) cp_scf_l
  read(19,*) min_level_l

  read(19,*)
  do i1_do=0,n_a_l-1
     do i2_do=0,n_b_l-1
        do i3_do=0,n_c_l-1
           read(19,*) tempr
           if( scf_bias /= 'off' ) then
              tempr=tempr+v_scf_l/ene_scale
           end if
           vh_temp_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1)=tempr
           if( i3_do == i_hartree_temp ) then
              vh_l(i1_do*n_b_l+i2_do+1)=tempr
           end if
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a_l-1
     do i2_do=0,n_b_l-1
        do i3_do=0,n_c_l-1
           if( ispin_pol_scf_l == 1 ) then
              read(19,*) tempr
              if( scf_bias /= 'off' ) then
                 tempr=tempr+v_scf_l/ene_scale
              end if
              v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempr
              if( i3_do == i_hartree_temp ) then
                 v0_l(i1_do*n_b_l+i2_do+1,1)=tempr
              end if
           else
              if( ispin_pol_scf_l == 2 ) then
                 read(19,*) tempr,tempi
                 if( scf_bias /= 'off' ) then
                    tempr=tempr+v_scf_l/ene_scale
                    tempi=tempi+v_scf_l/ene_scale
                 end if
                 if( i_rotspin_l == 0 ) then
                    v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempr
                    v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)=tempi
                    if( i3_do == i_hartree_temp ) then
                       v0_l(i1_do*n_b_l+i2_do+1,1)=tempr
                       v0_l(i1_do*n_b_l+i2_do+1,2)=tempi
                    end if
                 else
                    v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)=tempr
                    v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempi
                    if( i3_do == i_hartree_temp ) then
                       v0_l(i1_do*n_b_l+i2_do+1,2)=tempr
                       v0_l(i1_do*n_b_l+i2_do+1,1)=tempi
                    end if
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 if( scf_bias /= 'off' ) then
                    tempr=tempr+v_scf_l/ene_scale
                    tempi1=tempi1+v_scf_l/ene_scale
                 end if
                 v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempr
                 v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)=tempi
                 v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,3)=tempr1
                 v_tot_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,4)=tempi1
                 if( i3_do == i_hartree_temp ) then
                    v0_l(i1_do*n_b_l+i2_do+1,1)=tempr
                    v0_l(i1_do*n_b_l+i2_do+1,2)=tempi
                    v0_l(i1_do*n_b_l+i2_do+1,3)=tempr1
                    v0_l(i1_do*n_b_l+i2_do+1,4)=tempi1
                 end if
              end if
           end if
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a_l-1
     do i2_do=0,n_b_l-1
        do i3_do=0,n_c_l-1
           if( ispin_pol_scf_l == 1 ) then
              read(19,*) tempr
              den_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempr
           else
              if( ispin_pol_scf_l == 2 ) then
                 read(19,*) tempr,tempi
                 if( i_rotspin_l == 0 ) then
                    den_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempr
                    den_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)=tempi
                 else
                    den_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)=tempr
                    den_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)=tempi
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 denls_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,1)                 &
                      =dcmplx(tempr,tempi)
                 denls_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,2)                 &
                      =dcmplx(tempr1,tempi1)
                 read(19,*) tempr,tempi,tempr1,tempi1
                 denls_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,3)                 &
                      =dcmplx(tempr,tempi)
                 denls_l(i1_do*n_b_l*n_c_l+i2_do*n_c_l+i3_do+1,4)                 &
                      =dcmplx(tempr1,tempi1)
              end if
           end if
        end do
     end do
  end do

  close(19)

  open(unit=19,file=file_parameter_rv1_scf,status='old')

  read(19,*) ispin_pol_scf_r,itemp_ka_r,itemp_kb_r
  read(19,*)
  read(19,*) n_a_r,n_b_r,n_c_r
  read(19,*)

  ispin_pol_scf_r=ispin_pol_scf_r+1

  if( ispin_pol_scf_r /= ispin_pol_scf ) then
     write(*,*) 'error: spin_vh_r'
     close(19)
     stop
  end if

  if( n_a_r /= n_a ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,*) '          n_a_r /= n_a:'
     write(36,*) '               n_a_r=',n_a_r,'n_a=',n_a
     close(36)
  end if
  if( n_b_r /= n_b ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,*) '          n_b_r /= n_b:'
     write(36,*) '               n_b_r=',n_b_r,'n_b=',n_b
     close(36)
  end if

  call alo_potential_r

  read(19,*) cell_labc_r(1,1),cell_labc_r(1,2),cell_labc_r(1,3)
  read(19,*) cell_labc_r(2,1),cell_labc_r(2,2),cell_labc_r(2,3)
  read(19,*) cell_labc_r(3,1),cell_labc_r(3,2),cell_labc_r(3,3)

  call bound_cell_lr_r

  i_hartree_temp=r_cell_l_bound_r-1

  read(19,*)
  read(19,*) cp_scf_r
  read(19,*) min_level_r

  read(19,*)
  do i1_do=0,n_a_r-1
     do i2_do=0,n_b_r-1
        do i3_do=0,n_c_r-1
           read(19,*) tempr
           if( scf_bias /= 'off' ) then
              tempr=tempr+v_scf_r/ene_scale
           end if
           vh_temp_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1)=tempr
           if( i3_do == i_hartree_temp ) then
              vh_r(i1_do*n_b_r+i2_do+1)=tempr
           end if
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a_r-1
     do i2_do=0,n_b_r-1
        do i3_do=0,n_c_r-1
           if( ispin_pol_scf_r == 1 ) then
              read(19,*) tempr
              if( scf_bias /= 'off' ) then
                 tempr=tempr+v_scf_r/ene_scale
              end if
              v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempr
              if( i3_do == i_hartree_temp ) then
                 v0_r(i1_do*n_b_r+i2_do+1,1)=tempr
              end if
           else
              if( ispin_pol_scf_r == 2 ) then
                 read(19,*) tempr,tempi
                 if( scf_bias /= 'off' ) then
                    tempr=tempr+v_scf_r/ene_scale
                    tempi=tempi+v_scf_r/ene_scale
                 end if
                 if( i_rotspin_r == 0 ) then
                    v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempr
                    v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)=tempi
                    if( i3_do == i_hartree_temp ) then
                       v0_r(i1_do*n_b_r+i2_do+1,1)=tempr
                       v0_r(i1_do*n_b_r+i2_do+1,2)=tempi
                    end if
                 else
                    v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)=tempr
                    v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempi
                    if( i3_do == i_hartree_temp ) then
                       v0_r(i1_do*n_b_r+i2_do+1,2)=tempr
                       v0_r(i1_do*n_b_r+i2_do+1,1)=tempi
                    end if
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 if( scf_bias /= 'off' ) then
                    tempr=tempr+v_scf_r/ene_scale
                    tempi1=tempi1+v_scf_r/ene_scale
                 end if
                 v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempr
                 v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)=tempi
                 v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,3)=tempr1
                 v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,4)=tempi1
                 if( i3_do == i_hartree_temp ) then
                    v0_r(i1_do*n_b_r+i2_do+1,1)=tempr
                    v0_r(i1_do*n_b_r+i2_do+1,2)=tempi
                    v0_r(i1_do*n_b_r+i2_do+1,3)=tempr1
                    v0_r(i1_do*n_b_r+i2_do+1,4)=tempi1
                 end if
              end if
           end if
        end do
     end do
  end do
  read(19,*)
  do i1_do=0,n_a_r-1
     do i2_do=0,n_b_r-1
        do i3_do=0,n_c_r-1
           if( ispin_pol_scf_r == 1 ) then
              read(19,*) tempr
              den_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempr
           else
              if( ispin_pol_scf_r == 2 ) then
                 read(19,*) tempr,tempi
                 if( i_rotspin_r == 0 ) then
                    den_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempr
                    den_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)=tempi
                 else
                    den_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)=tempr
                    den_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)=tempi
                 end if
              else
                 read(19,*) tempr,tempi,tempr1,tempi1
                 denls_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,1)                 &
                      =dcmplx(tempr,tempi)
                 denls_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,2)                 &
                      =dcmplx(tempr1,tempi1)
                 read(19,*) tempr,tempi,tempr1,tempi1
                 denls_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,3)                 &
                      =dcmplx(tempr,tempi)
                 denls_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,4)                 &
                      =dcmplx(tempr1,tempi1)
              end if
           end if
        end do
     end do
  end do

  close(19)

  if( ka_scf*kb_scf == 0 ) then
     ka_scf=max0(itemp_ka_l,itemp_ka_r)
     kb_scf=max0(itemp_kb_l,itemp_kb_r)
  end if

  call make_scf_ksampling_scf


  call set_bound_cell_lr
  call make_cell_lr


  if( dabs(cp_scf_l-cp_scf_r) > 1.d-10 ) then
     open(unit=36,file=file_tempout,position='append')
     write(36,*)
     write(36,*) '         ###################################################'
     write(36,*) '         #####         cp_scf_l =',cp_scf_l
     write(36,*) '         #####         cp_scf_r =',cp_scf_r
     if( sw_shift_chem == 'on' ) then
        write(36,*) '         ##### cp_scf_r <- cp_scf_l'
        write(36,*) '         #####         shift_chem :: V & H'
        call shift_chem
     else
        if( cp_scf_l > cp_scf_r ) then
           write(36,*) '         ##### cp <- cp_scf_r'
        else
           write(36,*) '         ##### cp <- cp_scf_l'
        end if
     end if
     write(36,*) '         ###################################################'
     close(36)
  end if


  if( scf_bias /= 'off' ) then
     cp_l=cp_scf_l*ene_scale+v_scf_l
     cp_r=cp_scf_r*ene_scale+v_scf_r
  else
     cp_l=cp_scf_l*ene_scale
     cp_r=cp_scf_r*ene_scale
  end if

  if( method_sum_om_scf == 1 ) then
     min_level_temp=min_level_c
     if( min_level_temp > min_level_l ) then
        min_level_temp=min_level_l
     end if
     if( min_level_temp > min_level_r ) then
        min_level_temp=min_level_r
     end if
     if( i_omega_switch == 1 ) then
        omega_if_scf(1,1)=min_level_temp*ene_scale-dabs(omega_del_temp)
     else
        if( i_omega_switch == 0 ) then
           if( omega_del_temp > min_level_temp*ene_scale ) then
              write(*,*) 'stop: omega_del_temp',omega_del_temp                     &
                   ,min_level_temp*ene_scale
              stop
           end if
           omega_if_scf(1,1)=omega_del_temp
        else
           write(*,*) 'stop: i_omega_switch'
           stop
        end if
     end if
     i_bios_minomega=1
     do i_do=1,om_block_num_scf
        if( omega_if_scf(i_do,2) < omega_if_scf(i_do,1) ) then
           write(*,*) 'stop: omega_if_scf(2) < omega_if_scf(1)'
           stop
        end if
        if( omega_if_scf(i_bios_minomega,2) < omega_if_scf(i_do,2) ) then
           i_bios_minomega=i_do
        end if
     end do
     if( cp_l > cp_r ) then
        omega_if_scf(i_bios_minomega,2)=cp_r
     else
        omega_if_scf(i_bios_minomega,2)=cp_l
     end if
     if( scf_bias /= 'off' ) then
        omega_if_scf(i_bios_minomega,2)                                          &
             =omega_if_scf(i_bios_minomega,2)-om_del_bias
     end if
     call make_scf_omega_c1(i_bios_minomega,cp_l,cp_r)
  else
     if( method_sum_om_scf == 2 ) then
        min_level_temp=min_level_c
        if( min_level_temp > min_level_l ) then
           min_level_temp=min_level_l
        end if
        if( min_level_temp > min_level_r ) then
           min_level_temp=min_level_r
        end if
        if( i_omega_switch == 1 ) then
           omega_if_scf(1,1)=min_level_temp*ene_scale-dabs(omega_del_temp)
        else
           if( i_omega_switch == 0 ) then
              if( omega_del_temp > min_level_temp*ene_scale ) then
                 write(*,*) 'stop: omega_del_temp',omega_del_temp                   &
                      ,min_level_temp*ene_scale
                 stop
              end if
              omega_if_scf(1,1)=omega_del_temp
           else
              write(*,*) 'stop: i_omega_switch'
              stop
           end if
        end if
        if( cp_l > cp_r ) then
           min_level_temp=cp_l
        else
           min_level_temp=cp_r
        end if
        if( i_omega_switch2 == 1 ) then
           omega_if_scf(1,2)=min_level_temp+dabs(omega_ef_temp)
        else
           if( i_omega_switch2 == 0 ) then
              if( omega_ef_temp < min_level_temp ) then
                 write(*,*) 'stop: omega_ef_temp',omega_ef_temp,min_level_temp
                 stop
              end if
              omega_if_scf(1,2)=omega_ef_temp
           else
              write(*,*) 'stop: i_omega_switch2'
              stop
           end if
        end if
        i_bios_minomega=1
        call make_scf_omega_c2(cp_l,cp_r)
     else
        write(*,*) 'stop: omega method'
        stop
     end if
  end if


  open(unit=36,file=file_tempout,position='append')
  write(36,*)
  write(36,*)
  write(36,980) res_bound_l*dis_scale
  write(36,981) res_bound_r*dis_scale
  write(36,*)
  write(36,982) atom_parlay_l
  write(36,983) atom_parlay_r
  write(36,*)
  write(36,984) l_cell_l_bound
  write(36,985) r_cell_l_bound
  write(36,*)
  write(36,*)
  close(36)

980 format('         *****  bulk  boundary ( left):',f11.6,'  *****')
981 format('         *****  bulk  boundary (right):',f11.6,'  *****')
982 format('         *****  bulk atom num. ( left):',i11,'  *****')
983 format('         *****  bulk atom num. (right):',i11,'  *****')
984 format('         *****  bulk c_lr num. ( left):',i11,'  *****')
985 format('         *****  bulk c_lr num. (right):',i11,'  *****')

  return
end subroutine set_scf_accel

subroutine shift_chem

  use scf_negf
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use mod_mpi

  use ac_mpi_module

  implicit none
  integer :: a,b,l,i1,j1,i1_do,i2_do,i3_do,ispin

  do a=MPI%rankE+1,natom_ac_rt,MPI%sizeE
     do l=1,nl_ac_r
        do b=1,natom_ac_rt
           if( i_over_r(b,a,l) == 1 ) then
              cycle
           end if
           do i1=1,i_orb_r(a)
              do j1=1,i_orb_r(b)
                 if( spin_rr == 1 ) then
                    ht_hs_r(b,a,l)%h(1,j1,i1)=ht_hs_r(b,a,l)%h(1,j1,i1)              &
                         +(cp_scf_l-cp_scf_r)*ht_hs_r(b,a,l)%s(j1,i1)
                 else
                    ht_hs_r(b,a,l)%h(1,j1,i1)=ht_hs_r(b,a,l)%h(1,j1,i1)              &
                         +(cp_scf_l-cp_scf_r)*ht_hs_r(b,a,l)%s(j1,i1)
                    ht_hs_r(b,a,l)%h(2,j1,i1)=ht_hs_r(b,a,l)%h(2,j1,i1)              &
                         +(cp_scf_l-cp_scf_r)*ht_hs_r(b,a,l)%s(j1,i1)
                 end if
              end do
           end do
        end do
     end do
  end do

  do i1_do=0,n_a_r-1
     do i2_do=0,n_b_r-1
        do i3_do=0,n_c_r-1
           vh_temp_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1)                       &
                =vh_temp_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1)             &
                +(cp_scf_l-cp_scf_r)
           if( i3_do == r_cell_l_bound_r-1 ) then
              vh_r(i1_do*n_b_r+i2_do+1)                                            &
                   =vh_temp_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1)
           end if
        end do
     end do
  end do
  do i1_do=0,n_a_r-1
     do i2_do=0,n_b_r-1
        do i3_do=0,n_c_r-1
           do ispin=1,ispin_pol_scf_r
              v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,ispin)                 &
                   =v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,ispin)         &
                   +(cp_scf_l-cp_scf_r)
              if( i3_do == r_cell_l_bound_r-1 ) then
                 v0_r(i1_do*n_b_r+i2_do+1,ispin)                                    &
                      =v_tot_r(i1_do*n_b_r*n_c_r+i2_do*n_c_r+i3_do+1,ispin)
              end if
           end do
        end do
     end do
  end do

  min_level_r=min_level_r+(cp_scf_l-cp_scf_r)
  cp_scf_r=cp_scf_l

  return
end subroutine shift_chem
