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

subroutine set_hamiltonian_temp(file_parameter1,file_parameter2,file_parameter3)

  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp

  implicit none
  include 'mpif.h'
  character(50), intent(in) :: file_parameter1,file_parameter2,file_parameter3
  real(8) :: vv_temp
  integer :: i_spin_temp

  vv_temp=0.d0
  i_spin_temp=0

  call set_ham_negf_c(file_parameter1)
  call set_ham_negf_l(file_parameter2,vv_temp,i_spin_temp)
  call set_ham_negf_r(file_parameter3,vv_temp,i_spin_temp)

  if( spin_ll /= spin_cc .or. spin_cc /= spin_rr ) then
     write(6,*) 'error: spin1',spin_ll,spin_cc,spin_rr
     stop
  end if

  return
end subroutine set_hamiltonian_temp

subroutine set_ham_negf_c1(file_parameter)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use scf_negf
  use mod_mpi

  implicit none
  character(50), intent(in) :: file_parameter

  logical :: ex
  integer :: l
  character(55) :: fname1

  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '+++++++++++        loading hamiltonian matrices: scattering'
  write(16,999) trim(file_parameter)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
999 format(' +++++++++++        read file:: ',a)
  close(16)

  fname1=trim(file_parameter)//'_0001'
  inquire(file=fname1,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname1
     close(16)
     stop
  end if
  inquire(file=fname1,exist=ex)
  open(unit=19,file=fname1,status='old')
  read(19,*) natom_ac_ct,natom_ac_cl,natom_ac_cr,nl_ac_c,spin_cc             &
       ,m_mat_max_l,m_mat_max_c,m_mat_max_r
  read(19,*) cell_tempabc(1,1),cell_tempabc(1,2),cell_tempabc(1,3)
  read(19,*) cell_tempabc(2,1),cell_tempabc(2,2),cell_tempabc(2,3)
  read(19,*) cell_tempabc(3,1),cell_tempabc(3,2),cell_tempabc(3,3)
  close(19)
  spin_cc=spin_cc+1
  spin_switch_cc=spin_cc

  if( ispin_pol_scf /= spin_switch_cc ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,'(a,a)') '      ++++++ Error!: spin ...'                        &
          ,ispin_pol_scf,spin_switch_cc
     close(16)
     stop
  end if

  call alo_ham_negf_type_c1

  do l=1,param_cell_nl
     rac_c(1,l)=param_cell_vl(l,1)
     rac_c(2,l)=param_cell_vl(l,2)
     rac_c(3,l)=param_cell_vl(l,3)
  end do

  return
end subroutine set_ham_negf_c1

subroutine set_ham_negf_c(file_parameter)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use mod_mpi

  implicit none
  character(50), intent(in) :: file_parameter

  logical :: ex

  integer :: l,a,b,l_t,a_t,b_t,i1,j1
  integer :: i2,i_temp1,i_temp2
  real(8) :: temp1,temp2,temp3,temp4
  character(1) :: character_temp(4),a_c(10)
  character(55) :: fname,fname1

  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '+++++++++++        loading hamiltonian matrices: scattering'
  write(16,999) trim(file_parameter)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
999 format(' +++++++++++        read file:: ',a)
  close(16)

  fname1=trim(file_parameter)//'_0001'
  inquire(file=fname1,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname1
     close(16)
     stop
  end if
  inquire(file=fname1,exist=ex)
  open(unit=19,file=fname1,status='old')
  read(19,*) natom_ac_ct,natom_ac_cl,natom_ac_cr,nl_ac_c,spin_cc             &
       ,m_mat_max_l,m_mat_max_c,m_mat_max_r
  read(19,*) cell_tempabc(1,1),cell_tempabc(1,2),cell_tempabc(1,3)
  read(19,*) cell_tempabc(2,1),cell_tempabc(2,2),cell_tempabc(2,3)
  read(19,*) cell_tempabc(3,1),cell_tempabc(3,2),cell_tempabc(3,3)
  close(19)
  spin_cc=spin_cc+1
  spin_switch_cc=spin_cc
  call alo_ham_negf_type_c1

  a_c(1)='0'
  a_c(2)='1'
  a_c(3)='2'
  a_c(4)='3'
  a_c(5)='4'
  a_c(6)='5'
  a_c(7)='6'
  a_c(8)='7'
  a_c(9)='8'
  a_c(10)='9'

  do a=myrank+1,natom_ac_ct,nprocs

     i_temp1=a
     do i2=1,4
        i_temp2=i_temp1/(10**(4-i2))
        character_temp(i2)=a_c(i_temp2+1)
        i_temp1=i_temp1-(10**(4-i2))*i_temp2
     end do
     fname=trim(file_parameter)//'_'//character_temp(1)//character_temp(2)     &
          //character_temp(3)//character_temp(4)
     inquire(file=fname,exist=ex)
     if( .not. ex ) then
        open(unit=16,file=file_tempout,position='append')
        write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname
        close(16)
        stop
     end if

     open(unit=19,file=fname,status='old')
     read(19,*) 
     read(19,*) 
     read(19,*) 
     read(19,*) 
     do l=1,nl_ac_c
        do b=1,natom_ac_ct
           read(19,*)
           read(19,*) a_t,l_t,b_t,i_over_c(b,a,l),i_orb_c(a),i_orb_c(b)
           read(19,*) rac_c(1,l),rac_c(2,l),rac_c(3,l)

           if(l/=l_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: l ', fname
              close(16)
              stop
           end if
           if(a/=a_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: a ', fname
              close(16)
              stop
           end if
           if(b/=b_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: b ', fname
              close(16)
              stop
           end if

           if( i_over_c(b,a,l) == 1 ) then
              cycle
           end if

           call alo_ham_negf_type_c2(a,b,l,i_orb_c(a),i_orb_c(b))

           do i1=1,i_orb_c(a)
              do j1=1,i_orb_c(b)
                 if( spin_cc == 1 ) then
                    read(19,*) ht_hs_c(b,a,l)%s(j1,i1),temp2                       &
                         ,ht_hs_c(b,a,l)%h(1,j1,i1) 
                 else
                    if( spin_cc == 2 ) then
                       read(19,*) ht_hs_c(b,a,l)%s(j1,i1),temp2                     &
                            ,ht_hs_c(b,a,l)%h(1,j1,i1),ht_hs_c(b,a,l)%h(2,j1,i1)
                    else
                       read(19,*) ht_hs_c(b,a,l)%s(j1,i1)
                       read(19,*)
                       read(19,*)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_c(b,a,l)%hls(1,j1,i1)=dcmplx(temp1,temp2)
                       ht_hs_c(b,a,l)%hls(2,j1,i1)=dcmplx(temp3,temp4)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_c(b,a,l)%hls(3,j1,i1)=dcmplx(temp1,temp2)
                       ht_hs_c(b,a,l)%hls(4,j1,i1)=dcmplx(temp3,temp4)
                       read(19,*)
                       read(19,*)
                    end if
                 end if
              end do
           end do
        end do
     end do
     close(19)
  end do

  return
end subroutine set_ham_negf_c

subroutine set_ham_negf_l(file_parameter,vv_temp,i_rotspin_l)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use mod_mpi

  implicit none
  character(50), intent(in) :: file_parameter
  integer, intent(in) :: i_rotspin_l
  real(8), intent(in) :: vv_temp

  logical :: ex

  integer :: l,a,b,l_t,a_t,b_t,i1,j1
  integer :: i2,i_temp1,i_temp2
  real(8) :: temp1,temp2,temp3,temp4
  character(1) :: character_temp(4),a_c(10)
  character(55) :: fname,fname1

  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '+++++++++++        loading hamiltonian matrices: left lead'
  write(16,999) trim(file_parameter)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
999 format(' +++++++++++        read file:: ',a)
  close(16)

  fname1=trim(file_parameter)//'_0001'
  inquire(file=fname1,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname1
     close(16)
     stop
  end if
  open(unit=19,file=fname1,status='old')
  read(19,*) natom_ac_lt,natom_ac_ll,natom_ac_lr,nl_ac_l,spin_ll             &
       ,mat_max_ll,i_temp1,i_temp2,ele_num_ll,temp1
  spin_ll=spin_ll+1
  close(19)
  call alo_ham_negf_type_l1

  a_c(1)='0'
  a_c(2)='1'
  a_c(3)='2'
  a_c(4)='3'
  a_c(5)='4'
  a_c(6)='5'
  a_c(7)='6'
  a_c(8)='7'
  a_c(9)='8'
  a_c(10)='9'

  do a=myrank+1,natom_ac_lt,nprocs

     i_temp1=a
     do i2=1,4
        i_temp2=i_temp1/(10**(4-i2))
        character_temp(i2)=a_c(i_temp2+1)
        i_temp1=i_temp1-(10**(4-i2))*i_temp2
     end do
     fname=trim(file_parameter)//'_'//character_temp(1)//character_temp(2)     &
          //character_temp(3)//character_temp(4)
     inquire(file=fname,exist=ex)
     if( .not. ex ) then
        open(unit=16,file=file_tempout,position='append')
        write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname
        close(16)
        stop
     end if

     open(unit=19,file=fname,status='old')
     read(19,*)
     read(19,*) 
     read(19,*) 
     read(19,*) 

     do l=1,nl_ac_l
        do b=1,natom_ac_lt
           read(19,*)
           read(19,*) a_t,l_t,b_t,i_over_l(b,a,l),i_orb_l(a),i_orb_l(b)
           read(19,*) rac_l(1,l),rac_l(2,l),rac_l(3,l)

           if(l/=l_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: l ', fname
              close(16)
              stop
           end if
           if(a/=a_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: a ', fname
              close(16)
              stop
           end if
           if(b/=b_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: b ', fname
              close(16)
              stop
           end if

           if( i_over_l(b,a,l) == 1 ) then
              cycle
           end if

           call alo_ham_negf_type_l2(a,b,l,i_orb_l(a),i_orb_l(b))

           do i1=1,i_orb_l(a)
              do j1=1,i_orb_l(b)
                 if( spin_ll == 1 ) then
                    read(19,*) ht_hs_l(b,a,l)%s(j1,i1),temp2                       &
                         ,ht_hs_l(b,a,l)%h(1,j1,i1)
                    ht_hs_l(b,a,l)%h(1,j1,i1)=ht_hs_l(b,a,l)%h(1,j1,i1)            &
                         +vv_temp*ht_hs_l(b,a,l)%s(j1,i1)/ene_scale
                 else
                    if( spin_cc == 2 ) then
                       if( i_rotspin_l == 0 ) then
                          read(19,*) ht_hs_l(b,a,l)%s(j1,i1),temp2                   &
                               ,ht_hs_l(b,a,l)%h(1,j1,i1),ht_hs_l(b,a,l)%h(2,j1,i1)
                       else
                          read(19,*) ht_hs_l(b,a,l)%s(j1,i1),temp2                   &
                               ,ht_hs_l(b,a,l)%h(2,j1,i1),ht_hs_l(b,a,l)%h(1,j1,i1)
                       end if
                       ht_hs_l(b,a,l)%h(1,j1,i1)=ht_hs_l(b,a,l)%h(1,j1,i1)          &
                            +vv_temp*ht_hs_l(b,a,l)%s(j1,i1)/ene_scale
                       ht_hs_l(b,a,l)%h(2,j1,i1)=ht_hs_l(b,a,l)%h(2,j1,i1)          &
                            +vv_temp*ht_hs_l(b,a,l)%s(j1,i1)/ene_scale
                    else
                       read(19,*) ht_hs_l(b,a,l)%s(j1,i1)
                       read(19,*)
                       read(19,*)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_l(b,a,l)%hls(1,j1,i1)                                  &
                            =dcmplx(temp1+vv_temp*ht_hs_l(b,a,l)%s(j1,i1)/ene_scale &
                            ,temp2)
                       ht_hs_l(b,a,l)%hls(2,j1,i1)=dcmplx(temp3,temp4)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_l(b,a,l)%hls(3,j1,i1)=dcmplx(temp1,temp2)
                       ht_hs_l(b,a,l)%hls(4,j1,i1)                                  &
                            =dcmplx(temp3+vv_temp*ht_hs_l(b,a,l)%s(j1,i1)/ene_scale &
                            ,temp4)
                       read(19,*)
                       read(19,*)
                    end if
                 end if
              end do
           end do
        end do
     end do

     close(19)
  end do

  return
end subroutine set_ham_negf_l

subroutine set_ham_negf_r(file_parameter,vv_temp,i_rotspin_r)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use mod_mpi

  implicit none
  character(50), intent(in) :: file_parameter
  integer, intent(in) :: i_rotspin_r
  real(8), intent(in) :: vv_temp

  logical :: ex

  integer :: l,a,b,l_t,a_t,b_t,i1,j1
  integer :: i2,i_temp1,i_temp2
  real(8) :: temp1,temp2,temp3,temp4
  character(1) :: character_temp(4),a_c(10)
  character(55) :: fname,fname1

  open(unit=16,file=file_tempout,position='append')
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
  write(16,*) '+++++++++++        loading hamiltonian matrices: right lead'
  write(16,999) trim(file_parameter)
  write(16,*) '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
999 format(' +++++++++++        read file:: ',a)
  close(16)

  fname1=trim(file_parameter)//'_0001'
  inquire(file=fname1,exist=ex)
  if( .not. ex ) then
     open(unit=16,file=file_tempout,position='append')
     write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname1
     close(16)
     stop
  end if
  open(unit=19,file=fname1,status='old')
  read(19,*) natom_ac_rt,natom_ac_rl,natom_ac_rr,nl_ac_r,spin_rr             &
       ,i_temp1,i_temp2,mat_max_rr,temp1,ele_num_rr
  spin_rr=spin_rr+1
  close(19)
  call alo_ham_negf_type_r1

  a_c(1)='0'
  a_c(2)='1'
  a_c(3)='2'
  a_c(4)='3'
  a_c(5)='4'
  a_c(6)='5'
  a_c(7)='6'
  a_c(8)='7'
  a_c(9)='8'
  a_c(10)='9'

  do a=myrank+1,natom_ac_rt,nprocs

     i_temp1=a
     do i2=1,4
        i_temp2=i_temp1/(10**(4-i2))
        character_temp(i2)=a_c(i_temp2+1)
        i_temp1=i_temp1-(10**(4-i2))*i_temp2
     end do
     fname=trim(file_parameter)//'_'//character_temp(1)//character_temp(2)     &
          //character_temp(3)//character_temp(4)
     inquire(file=fname,exist=ex)
     if( .not. ex ) then
        open(unit=16,file=file_tempout,position='append')
        write(16,'(a,a)') '      ++++++ Error!: can not open file ', fname
        close(16)
        stop
     end if

     open(unit=19,file=fname,status='old')
     read(19,*) 
     read(19,*) 
     read(19,*) 
     read(19,*) 

     do l=1,nl_ac_r
        do b=1,natom_ac_rt
           read(19,*)
           read(19,*) a_t,l_t,b_t,i_over_r(b,a,l),i_orb_r(a),i_orb_r(b)
           read(19,*) rac_r(1,l),rac_r(2,l),rac_r(3,l)

           if(l/=l_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: l ', fname
              close(16)
              stop
           end if
           if(a/=a_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: a ', fname
              close(16)
              stop
           end if
           if(b/=b_t+1) then
              open(unit=16,file=file_tempout,position='append')
              write(16,'(a,a)') '      ++++++ Error!: b ', fname
              close(16)
              stop
           end if

           if( i_over_r(b,a,l) == 1 ) then
              cycle
           end if

           call alo_ham_negf_type_r2(a,b,l,i_orb_r(a),i_orb_r(b))

           do i1=1,i_orb_r(a)
              do j1=1,i_orb_r(b)
                 if( spin_rr == 1 ) then
                    read(19,*) ht_hs_r(b,a,l)%s(j1,i1),temp2                       &
                         ,ht_hs_r(b,a,l)%h(1,j1,i1)
                    ht_hs_r(b,a,l)%h(1,j1,i1)=ht_hs_r(b,a,l)%h(1,j1,i1)            &
                         +vv_temp*ht_hs_r(b,a,l)%s(j1,i1)/ene_scale
                 else
                    if( spin_cc == 2 ) then
                       if( i_rotspin_r == 0 ) then
                          read(19,*) ht_hs_r(b,a,l)%s(j1,i1),temp2                   &
                               ,ht_hs_r(b,a,l)%h(1,j1,i1),ht_hs_r(b,a,l)%h(2,j1,i1)
                       else
                          read(19,*) ht_hs_r(b,a,l)%s(j1,i1),temp2                   &
                               ,ht_hs_r(b,a,l)%h(2,j1,i1),ht_hs_r(b,a,l)%h(1,j1,i1)
                       end if
                       ht_hs_r(b,a,l)%h(1,j1,i1)=ht_hs_r(b,a,l)%h(1,j1,i1)          &
                            +vv_temp*ht_hs_r(b,a,l)%s(j1,i1)/ene_scale
                       ht_hs_r(b,a,l)%h(2,j1,i1)=ht_hs_r(b,a,l)%h(2,j1,i1)          &
                            +vv_temp*ht_hs_r(b,a,l)%s(j1,i1)/ene_scale
                    else
                       read(19,*) ht_hs_r(b,a,l)%s(j1,i1)
                       read(19,*)
                       read(19,*)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_r(b,a,l)%hls(1,j1,i1)                                  &
                            =dcmplx(temp1+vv_temp*ht_hs_r(b,a,l)%s(j1,i1)/ene_scale &
                            ,temp2)
                       ht_hs_r(b,a,l)%hls(2,j1,i1)=dcmplx(temp3,temp4)
                       read(19,*) temp1,temp2,temp3,temp4
                       ht_hs_r(b,a,l)%hls(3,j1,i1)=dcmplx(temp1,temp2)
                       ht_hs_r(b,a,l)%hls(4,j1,i1)                                  &
                            =dcmplx(temp3+vv_temp*ht_hs_r(b,a,l)%s(j1,i1)/ene_scale &
                            ,temp4)
                       read(19,*)
                       read(19,*)
                    end if
                 end if
              end do
           end do
        end do
     end do

     close(19)
  end do

  return
end subroutine set_ham_negf_r

subroutine set_ham_temp_ham_c(qx_st,qy_st)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use mod_mpi

  implicit none
  include 'mpif.h'
  real(8), intent(in) :: qx_st,qy_st

  integer, allocatable :: i_orb_lr(:)
  complex(8), allocatable :: h_cc(:,:,:)
  complex(8), allocatable :: s_cc(:,:)
  complex(8), allocatable :: temp_sen(:)
  complex(8), allocatable :: temp_rec(:)

  integer :: i1,j1,ier,a,b,l,ispin,i1_do,i2_do,i3_do,num_sum_mat,i_cou,ls_spin
  complex(8) :: const
  real(8) :: co,sn

  allocate(i_orb_lr(natom_ac_ct+1),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  i_orb_lr(1)=0
  do i1=1,natom_ac_ct
     i_orb_lr(i1+1)=i_orb_lr(i1)+i_orb_c(i1)
  end do


  if( spin_cc /= 2 ) then
     ls_spin=1
  else
     ls_spin=2
  end if

  allocate(h_cc(ls_spin,m_mat_max_c,m_mat_max_c),s_cc(m_mat_max_c,m_mat_max_c) &
       ,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  do i1_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        do i3_do=1,ls_spin
           h_cc(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
        end do
        s_cc(i2_do,i1_do)=dcmplx(0.d0,0.d0)
     end do
  end do


  do a=1,natom_ac_ct
     do b=1,natom_ac_ct
        if( a <= natom_ac_cl .and. b > natom_ac_ct-natom_ac_cr ) then
           cycle
        end if
        if( b <= natom_ac_cl .and. a > natom_ac_ct-natom_ac_cr ) then
           cycle
        end if
        do l=1,nl_ac_c
           if( i_over_c(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_c(2,l)+qy_st*rac_c(3,l))
           sn=dsin(qx_st*rac_c(2,l)+qy_st*rac_c(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_c(a)
              do j1=1,i_orb_c(b)
                 if( spin_cc /= 4 ) then
                    do ispin=1,ls_spin
                       h_cc(ispin,i_orb_lr(a)+i1,i_orb_lr(b)+j1)                      &
                            =h_cc(ispin,i_orb_lr(a)+i1,i_orb_lr(b)+j1)                 &
                            +const*dcmplx(ht_hs_c(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_cc(i_orb_lr(a)+i1,i_orb_lr(b)+j1)                              &
                         =s_cc(i_orb_lr(a)+i1,i_orb_lr(b)+j1)                       &
                         +const*dcmplx(ht_hs_c(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_cc(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)                &
                         =h_cc(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)         &
                         +const*ht_hs_c(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_cc(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2)                  &
                         =h_cc(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2)           &
                         +const*ht_hs_c(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_cc(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2-1)                  &
                         =h_cc(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2-1)           &
                         +const*ht_hs_c(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_cc(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)                    &
                         =h_cc(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)             &
                         +const*ht_hs_c(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_cc((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)                  &
                         =s_cc((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)           &
                         +const*dcmplx(ht_hs_c(a,b,l)%s(i1,j1),0.d0)
                    s_cc((i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)                      &
                         =s_cc((i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)               &
                         +const*dcmplx(ht_hs_c(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do


  num_sum_mat=(ls_spin+1)*m_mat_max_c*m_mat_max_c

  allocate(temp_sen(num_sum_mat),temp_rec(num_sum_mat),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if
  do i1_do=1,num_sum_mat
     temp_sen(i1_do)=dcmplx(0.d0,0.d0)
  end do
  do i1_do=1,num_sum_mat
     temp_rec(i1_do)=dcmplx(0.d0,0.d0)
  end do

  i_cou=0
  do i1_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_cc(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        i_cou=i_cou+1
        temp_sen(i_cou)=s_cc(i2_do,i1_do)
     end do
  end do

  call MPI_ALLREDUCE(temp_sen,temp_rec,num_sum_mat,MPI_DOUBLE_COMPLEX          &
       ,MPI_SUM,mpi_comm_world,ierr)

  i_cou=0
  do i1_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_cc(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        i_cou=i_cou+1
        s_cc(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do

  do i3_do=1,m_mat_max_c
     do i2_do=i3_do,m_mat_max_c
        do i1_do=1,ls_spin
           h_cc(i1_do,i2_do,i3_do)=h_cc(i1_do,i2_do,i3_do)                        &
                +dconjg(h_cc(i1_do,i3_do,i2_do))
           h_cc(i1_do,i3_do,i2_do)=dconjg(h_cc(i1_do,i2_do,i3_do))
        end do
        s_cc(i2_do,i3_do)=s_cc(i2_do,i3_do)+dconjg(s_cc(i3_do,i2_do))
        s_cc(i3_do,i2_do)=dconjg(s_cc(i2_do,i3_do))
     end do
  end do

  deallocate(temp_sen,temp_rec,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if


  do i3_do=1,m_mat_max_c
     do i2_do=1,m_mat_max_c
        do i1_do=1,ls_spin
           hcc_t(i1_do,i2_do,i3_do)=h_cc(i1_do,i2_do,i3_do)
        end do
        scc_t(i2_do,i3_do)=s_cc(i2_do,i3_do)
     end do
  end do


  deallocate(i_orb_lr,h_cc,s_cc,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  return
end subroutine set_ham_temp_ham_c

subroutine set_ham_temp_ham_l(qx_st,qy_st)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use scf_negf
  use mod_mpi

  implicit none
  include 'mpif.h'
  real(8), intent(in) :: qx_st,qy_st

  integer, allocatable :: i_orb_lr(:)
  complex(8), allocatable :: h_00l(:,:,:)
  complex(8), allocatable :: s_00l(:,:)
  complex(8), allocatable :: h_01l(:,:,:)
  complex(8), allocatable :: s_01l(:,:)
  complex(8), allocatable :: h_10l(:,:,:)
  complex(8), allocatable :: s_10l(:,:)
  complex(8), allocatable :: temp_sen(:)
  complex(8), allocatable :: temp_rec(:)

  integer :: i1,j1,ier,a,b,l,ispin,i1_do,i2_do,i3_do,num_sum_mat,i_cou,ls_spin
  complex(8) :: const
  real(8) :: co,sn

  allocate(i_orb_lr(natom_ac_lt+1),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  i_orb_lr(1)=0
  do i1=1, natom_ac_lt
     i_orb_lr(i1+1)=i_orb_lr(i1)+i_orb_l(i1)
  end do


  if( spin_ll /= 2 ) then
     ls_spin=1
  else
     ls_spin=2
  end if

  allocate(h_00l(ls_spin,mat_max_ll,mat_max_ll),s_00l(mat_max_ll,mat_max_ll)   &
       ,h_01l(ls_spin,mat_max_ll,mat_max_ll),s_01l(mat_max_ll,mat_max_ll)   &
       ,h_10l(ls_spin,mat_max_ll,mat_max_ll),s_10l(mat_max_ll,mat_max_ll)   &
       ,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           h_00l(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
           h_01l(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
           h_10l(i3_do,i2_do,i1_do)=dcmplx(0.d0,0.d0)
        end do
        s_00l(i2_do,i1_do)=dcmplx(0.d0,0.d0)
        s_01l(i2_do,i1_do)=dcmplx(0.d0,0.d0)
        s_10l(i2_do,i1_do)=dcmplx(0.d0,0.d0)
     end do
  end do


  do a=1,natom_ac_ll
     do b=1,natom_ac_ll
        do l=1,nl_ac_l
           if( i_over_l(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           sn=dsin(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_l(a)
              do j1=1,i_orb_l(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_00l(ispin,i_orb_lr(a)+i1,i_orb_lr(b)+j1)                     &
                            =h_00l(ispin,i_orb_lr(a)+i1,i_orb_lr(b)+j1)                &
                            +const*dcmplx(ht_hs_l(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_00l(i_orb_lr(a)+i1,i_orb_lr(b)+j1)                             &
                         =s_00l(i_orb_lr(a)+i1,i_orb_lr(b)+j1)                      &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_00l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)               &
                         =h_00l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)        &
                         +const*ht_hs_l(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_00l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2)                 &
                         =h_00l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2)          &
                         +const*ht_hs_l(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_00l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2-1)                 &
                         =h_00l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2-1)          &
                         +const*ht_hs_l(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_00l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)                   &
                         =h_00l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)            &
                         +const*ht_hs_l(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_00l((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)                 &
                         =s_00l((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)+j1)*2-1)          &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                    s_00l((i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)                     &
                         =s_00l((i_orb_lr(a)+i1)*2,(i_orb_lr(b)+j1)*2)              &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do

  i1_do=i_orb_lr(natom_ac_lt-natom_ac_ll+1)
  do a=1,natom_ac_ll
     do b=natom_ac_lt-natom_ac_ll+1,natom_ac_lt
        do l=1,nl_ac_l
           if( i_over_l(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           sn=dsin(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_l(a)
              do j1=1,i_orb_l(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_01l(ispin,i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)               &
                            =h_01l(ispin,i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)          &
                            +const*dcmplx(ht_hs_l(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_01l(i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)                       &
                         =s_01l(i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)                &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_01l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)         &
                         =h_01l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)  &
                         +const*ht_hs_l(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_01l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)           &
                         =h_01l(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)    &
                         +const*ht_hs_l(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_01l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)           &
                         =h_01l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)    &
                         +const*ht_hs_l(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_01l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)             &
                         =h_01l(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)      &
                         +const*ht_hs_l(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_01l((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)           &
                         =s_01l((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)    &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                    s_01l((i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)               &
                         =s_01l((i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)        &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do

  i1_do=i_orb_lr(natom_ac_lt-natom_ac_ll+1)
  do a=natom_ac_lt-natom_ac_ll+1,natom_ac_lt
     do b=1,natom_ac_ll
        do l=1,nl_ac_l
           if( i_over_l(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           sn=dsin(qx_st*rac_l(2,l)+qy_st*rac_l(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_l(a)
              do j1=1,i_orb_l(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_10l(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)               &
                            =h_10l(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)          &
                            +const*dcmplx(ht_hs_l(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_10l(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)                       &
                         =s_10l(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)                &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_10l(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)         &
                         =h_10l(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)  &
                         +const*ht_hs_l(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_10l(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2)           &
                         =h_10l(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2)    &
                         +const*ht_hs_l(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_10l(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2-1)           &
                         =h_10l(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2-1)    &
                         +const*ht_hs_l(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_10l(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)             &
                         =h_10l(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)      &
                         +const*ht_hs_l(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_10l((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)           &
                         =s_10l((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)    &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                    s_10l((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)               &
                         =s_10l((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)        &
                         +const*dcmplx(ht_hs_l(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do


  num_sum_mat=3*(ls_spin+1)*mat_max_ll*mat_max_ll

  allocate(temp_sen(num_sum_mat),temp_rec(num_sum_mat),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if
  do i1_do=1,num_sum_mat
     temp_sen(i1_do)=dcmplx(0.0d0,0.d0)
  end do
  do i1_do=1,num_sum_mat
     temp_rec(i1_do)=dcmplx(0.0d0,0.d0)
  end do

  i_cou=0
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_00l(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        temp_sen(i_cou)=s_00l(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_01l(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        temp_sen(i_cou)=s_01l(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_10l(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        temp_sen(i_cou)=s_10l(i2_do,i1_do)
     end do
  end do

  call MPI_ALLREDUCE(temp_sen,temp_rec,num_sum_mat,MPI_DOUBLE_COMPLEX          &
       ,MPI_SUM,mpi_comm_world,ierr)

  i_cou=0
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_00l(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        s_00l(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_01l(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        s_01l(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_10l(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        i_cou=i_cou+1
        s_10l(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do

  do i3_do=1,mat_max_ll
     do i2_do=i3_do,mat_max_ll
        do i1_do=1,ls_spin
           h_00l(i1_do,i2_do,i3_do)=h_00l(i1_do,i2_do,i3_do)                      &
                +dconjg(h_00l(i1_do,i3_do,i2_do))
           h_00l(i1_do,i3_do,i2_do)=dconjg(h_00l(i1_do,i2_do,i3_do))
        end do
        s_00l(i2_do,i3_do)=s_00l(i2_do,i3_do)+dconjg(s_00l(i3_do,i2_do))
        s_00l(i3_do,i2_do)=dconjg(s_00l(i2_do,i3_do))
     end do
  end do
  do i3_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i1_do=1,ls_spin
           h_10l(i1_do,i2_do,i3_do)=h_10l(i1_do,i2_do,i3_do)                      &
                +dconjg(h_01l(i1_do,i3_do,i2_do))
           h_01l(i1_do,i3_do,i2_do)=dconjg(h_10l(i1_do,i2_do,i3_do))
        end do
        s_10l(i2_do,i3_do)=s_10l(i2_do,i3_do)+dconjg(s_01l(i3_do,i2_do))
        s_01l(i3_do,i2_do)=dconjg(s_10l(i2_do,i3_do))
     end do
  end do

  deallocate(temp_sen,temp_rec,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if


  do i3_do=1,mat_max_ll
     do i2_do=1,mat_max_ll
        do i1_do=1,ls_spin
           h00_l_t(i1_do,i2_do,i3_do)=h_00l(i1_do,i2_do,i3_do)
           h01_l_t(i1_do,i2_do,i3_do)=h_01l(i1_do,i2_do,i3_do)
           h10_l_t(i1_do,i2_do,i3_do)=h_10l(i1_do,i2_do,i3_do)
        end do
        s00_l_t(i2_do,i3_do)=s_00l(i2_do,i3_do)
        s01_l_t(i2_do,i3_do)=s_01l(i2_do,i3_do)
        s10_l_t(i2_do,i3_do)=s_10l(i2_do,i3_do)
     end do
  end do


  deallocate(i_orb_lr,h_00l,s_00l,h_01l,s_01l,h_10l,s_10l,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  return
end subroutine set_ham_temp_ham_l

subroutine set_ham_temp_ham_r(qx_st,qy_st)
  use hamiltonian_sgf
  use hamiltonian_c
  use hamiltonian_temp
  use constant
  use scf_negf
  use mod_mpi

  implicit none
  include 'mpif.h'
  real(8), intent(in) :: qx_st,qy_st

  integer, allocatable :: i_orb_lr(:)
  complex(8), allocatable :: h_00r(:,:,:)
  complex(8), allocatable :: s_00r(:,:)
  complex(8), allocatable :: h_01r(:,:,:)
  complex(8), allocatable :: s_01r(:,:)
  complex(8), allocatable :: h_10r(:,:,:)
  complex(8), allocatable :: s_10r(:,:)
  complex(8), allocatable :: temp_sen(:)
  complex(8), allocatable :: temp_rec(:)

  integer :: i1,j1,ier,a,b,l,ispin,i1_do,i2_do,i3_do,num_sum_mat,i_cou,ls_spin
  complex(8) :: const
  real(8) :: co,sn

  allocate(i_orb_lr(natom_ac_rt+1),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  i_orb_lr(1)=0
  do i1=1, natom_ac_rt
     i_orb_lr(i1+1)=i_orb_lr(i1)+i_orb_r(i1)
  end do


  if( spin_rr /= 2 ) then
     ls_spin=1
  else
     ls_spin=2
  end if

  allocate(h_00r(ls_spin,mat_max_rr,mat_max_rr),s_00r(mat_max_rr,mat_max_rr)   &
       ,h_01r(ls_spin,mat_max_rr,mat_max_rr),s_01r(mat_max_rr,mat_max_rr)   &
       ,h_10r(ls_spin,mat_max_rr,mat_max_rr),s_10r(mat_max_rr,mat_max_rr)   &
       ,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if

  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           h_00r(i3_do,i2_do,i1_do)=dcmplx(0.0d0,0.d0)
           h_01r(i3_do,i2_do,i1_do)=dcmplx(0.0d0,0.d0)
           h_10r(i3_do,i2_do,i1_do)=dcmplx(0.0d0,0.d0)
        end do
        s_00r(i2_do,i1_do)=dcmplx(0.0d0,0.d0)
        s_01r(i2_do,i1_do)=dcmplx(0.0d0,0.d0)
        s_10r(i2_do,i1_do)=dcmplx(0.0d0,0.d0)
     end do
  end do


  i1_do=i_orb_lr(natom_ac_rt-natom_ac_rr+1)
  do a=natom_ac_rt-natom_ac_rr+1,natom_ac_rt
     do b=natom_ac_rt-natom_ac_rr+1,natom_ac_rt
        do l=1,nl_ac_r
           if( i_over_r(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           sn=dsin(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_r(a)
              do j1=1,i_orb_r(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_00r(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)-i1_do+j1)         &
                            =h_00r(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)-i1_do+j1)    &
                            +const*dcmplx(ht_hs_r(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_00r(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)-i1_do+j1)                 &
                         =s_00r(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)-i1_do+j1)          &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_00r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)   &
                         =h_00r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1) &
                         +const*ht_hs_r(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_00r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)     &
                         =h_00r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)   &
                         +const*ht_hs_r(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_00r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)     &
                         =h_00r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)   &
                         +const*ht_hs_r(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_00r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)       &
                         =h_00r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)     &
                         +const*ht_hs_r(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_00r((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)     &
                         =s_00r((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)   &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                    s_00r((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)         &
                         =s_00r((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)       &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do

  i1_do=i_orb_lr(natom_ac_rt-natom_ac_rr+1)
  do a=natom_ac_rt-natom_ac_rr+1,natom_ac_rt
     do b=1,natom_ac_rr
        do l=1,nl_ac_r
           if( i_over_r(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           sn=dsin(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_r(a)
              do j1=1,i_orb_r(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_01r(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)               &
                            =h_01r(ispin,i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)          &
                            +const*dcmplx(ht_hs_r(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_01r(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)                       &
                         =s_01r(i_orb_lr(a)-i1_do+i1,i_orb_lr(b)+j1)                &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_01r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)         &
                         =h_01r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)  &
                         +const*ht_hs_r(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_01r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2)           &
                         =h_01r(1,(i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2)    &
                         +const*ht_hs_r(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_01r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2-1)           &
                         =h_01r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2-1)    &
                         +const*ht_hs_r(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_01r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)             &
                         =h_01r(1,(i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)      &
                         +const*ht_hs_r(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_01r((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)           &
                         =s_01r((i_orb_lr(a)-i1_do+i1)*2-1,(i_orb_lr(b)+j1)*2-1)    &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                    s_01r((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)               &
                         =s_01r((i_orb_lr(a)-i1_do+i1)*2,(i_orb_lr(b)+j1)*2)        &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do

  i1_do=i_orb_lr(natom_ac_rt-natom_ac_rr+1)
  do a=1,natom_ac_rr
     do b=natom_ac_rt-natom_ac_rr+1,natom_ac_rt
        do l=1,nl_ac_r
           if( i_over_r(a,b,l) == 1 ) then
              cycle
           end if
           co=dcos(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           sn=dsin(qx_st*rac_r(2,l)+qy_st*rac_r(3,l))
           if( l /= 1 ) then
              const=dcmplx(co,sn)
           else
              const=dcmplx(.5d0*co,.5d0*sn)
           end if
           do i1=1,i_orb_r(a)
              do j1=1,i_orb_r(b)
                 if( spin_ll < 4 ) then
                    do ispin=1,ls_spin
                       h_10r(ispin,i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)               &
                            =h_10r(ispin,i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)          &
                            +const*dcmplx(ht_hs_r(a,b,l)%h(ispin,i1,j1)*ene_scale,0.d0)
                    end do
                    s_10r(i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)                       &
                         =s_10r(i_orb_lr(a)+i1,i_orb_lr(b)-i1_do+j1)                &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 else
                    h_10r(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)         &
                         =h_10r(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)  &
                         +const*ht_hs_r(a,b,l)%hls(1,i1,j1)*ene_scale
                    h_10r(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)           &
                         =h_10r(1,(i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2)    &
                         +const*ht_hs_r(a,b,l)%hls(2,i1,j1)*ene_scale
                    h_10r(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)           &
                         =h_10r(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2-1)    &
                         +const*ht_hs_r(a,b,l)%hls(3,i1,j1)*ene_scale
                    h_10r(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)             &
                         =h_10r(1,(i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)      &
                         +const*ht_hs_r(a,b,l)%hls(4,i1,j1)*ene_scale
                    s_10r((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)           &
                         =s_10r((i_orb_lr(a)+i1)*2-1,(i_orb_lr(b)-i1_do+j1)*2-1)    &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                    s_10r((i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)               &
                         =s_10r((i_orb_lr(a)+i1)*2,(i_orb_lr(b)-i1_do+j1)*2)        &
                         +const*dcmplx(ht_hs_r(a,b,l)%s(i1,j1),0.d0)
                 end if
              end do
           end do
        end do
     end do
  end do


  num_sum_mat=3*(ls_spin+1)*mat_max_rr*mat_max_rr

  allocate(temp_sen(num_sum_mat),temp_rec(num_sum_mat),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: alo_ham_negf_type_c1'
     stop
  end if
  do i1_do=1,num_sum_mat
     temp_sen(i1_do)=dcmplx(0.d0,0.d0)
  end do
  do i1_do=1,num_sum_mat
     temp_rec(i1_do)=dcmplx(0.d0,0.d0)
  end do

  i_cou=0
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_00r(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        temp_sen(i_cou)=s_00r(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_01r(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        temp_sen(i_cou)=s_01r(i2_do,i1_do)
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           temp_sen(i_cou)=h_10r(i3_do,i2_do,i1_do)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        temp_sen(i_cou)=s_10r(i2_do,i1_do)
     end do
  end do

  call MPI_ALLREDUCE(temp_sen,temp_rec,num_sum_mat,MPI_DOUBLE_COMPLEX          &
       ,MPI_SUM,mpi_comm_world,ierr)

  i_cou=0
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_00r(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        s_00r(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_01r(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        s_01r(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i3_do=1,ls_spin
           i_cou=i_cou+1
           h_10r(i3_do,i2_do,i1_do)=temp_rec(i_cou)
        end do
     end do
  end do
  do i1_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        i_cou=i_cou+1
        s_10r(i2_do,i1_do)=temp_rec(i_cou)
     end do
  end do

  do i3_do=1,mat_max_rr
     do i2_do=i3_do,mat_max_rr
        do i1_do=1,ls_spin
           h_00r(i1_do,i2_do,i3_do)=h_00r(i1_do,i2_do,i3_do)                      &
                +dconjg(h_00r(i1_do,i3_do,i2_do))
           h_00r(i1_do,i3_do,i2_do)=dconjg(h_00r(i1_do,i2_do,i3_do))
        end do
        s_00r(i2_do,i3_do)=s_00r(i2_do,i3_do)+dconjg(s_00r(i3_do,i2_do))
        s_00r(i3_do,i2_do)=dconjg(s_00r(i2_do,i3_do))
     end do
  end do
  do i3_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i1_do=1,ls_spin
           h_10r(i1_do,i2_do,i3_do)=h_10r(i1_do,i2_do,i3_do)                      &
                +dconjg(h_01r(i1_do,i3_do,i2_do))
           h_01r(i1_do,i3_do,i2_do)=dconjg(h_10r(i1_do,i2_do,i3_do))
        end do
        s_10r(i2_do,i3_do)=s_10r(i2_do,i3_do)+dconjg(s_01r(i3_do,i2_do))
        s_01r(i3_do,i2_do)=dconjg(s_10r(i2_do,i3_do))
     end do
  end do

  deallocate(temp_sen,temp_rec,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: alo_ham_negf_type_r1'
     stop
  end if


  do i3_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        do i1_do=1,ls_spin
           h00_r_t(i1_do,i2_do,i3_do)=h_00r(i1_do,i2_do,i3_do)
           h01_r_t(i1_do,i2_do,i3_do)=h_01r(i1_do,i2_do,i3_do)
           h10_r_t(i1_do,i2_do,i3_do)=h_10r(i1_do,i2_do,i3_do)
        end do
        s00_r_t(i2_do,i3_do)=s_00r(i2_do,i3_do)
        s01_r_t(i2_do,i3_do)=s_01r(i2_do,i3_do)
        s10_r_t(i2_do,i3_do)=s_10r(i2_do,i3_do)
     end do
  end do


  deallocate(i_orb_lr,h_00r,s_00r,h_01r,s_01r,h_10r,s_10r,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: alo_ham_negf_type_r1'
     stop
  end if

  return
end subroutine set_ham_temp_ham_r
