! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 selfenergy_r(w,iw_do,qx,qy,ispin,kt)

  use hamiltonian_sgf
  use hamiltonian_c
  use gf_se_c
  use constant
  use condition_ini
  use scf_negf

  implicit none
  integer, intent(in) :: iw_do,ispin,kt
  integer, intent(in) :: qx,qy
  complex(8) :: w

  integer :: i1_do,i2_do,ier,i_smd,i_block
  complex(8), allocatable :: amat_temp1(:,:),amat_temp2(:,:)
  complex(8), allocatable :: amat_temp3(:,:),amat_temp4(:,:)
  complex(8), allocatable :: amat_temp5(:,:)
  complex(8), allocatable :: bmat_temp1(:,:),bmat_temp2(:,:)
  complex(8), allocatable :: bmat_temp3(:,:),bmat_temp4(:,:)
  complex(8), allocatable :: bmat_temp5(:,:)

  allocate(bmat_temp2(m_mat_max_r,m_mat_max_r),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_r 1'
     stop
  end if

  call surf_gf_r(w,bmat_temp2,m_mat_max_r,qx,qy,ispin)
  if( gra_onoff /= 'off') then
     call cal_print_text12(iw_do,bmat_temp2,ispin,kt)
  end if

  call alo_hami_c2
  if( ham_model_ini == 'input' .or. ham_model_ini == 'scf_accel') then
     call set_hami_c_rr_input(ispin)
  else
     call set_hami_c_rr(qx,qy)
  end if
  allocate(bmat_temp1(m_mat_max_c,m_mat_max_r)                                 &
       ,bmat_temp4(m_mat_max_r,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_r 2'
     stop
  end if
  do i2_do=1,m_mat_max_r
     do i1_do=1,m_mat_max_c
        bmat_temp1(i1_do,i2_do)=w*scr_mat(i1_do,i2_do)-hcr_mat(i1_do,i2_do)
     end do
  end do
  if( m_mat_max_c .ge. 8 ) then
     i_block=m_mat_max_c/4
  else
     i_block=1
  end if
  do i_smd=1,m_mat_max_c,i_block
     do i1_do=1,m_mat_max_r
        do i2_do=i_smd,min(i_smd+i_block-1,m_mat_max_c)
           bmat_temp4(i1_do,i2_do)=w*dconjg(scr_mat(i2_do,i1_do))                 &
                -dconjg(hcr_mat(i2_do,i1_do))
        end do
     end do
  end do
  call unset_hami_c2

  allocate(bmat_temp3(m_mat_max_c,m_mat_max_r),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_r 3'
     stop
  end if

  call mat_mul2(m_mat_max_c,m_mat_max_r,m_mat_max_r,m_mat_max_r                &
       ,m_mat_max_c,m_mat_max_r,bmat_temp1,bmat_temp2,bmat_temp3)

  deallocate(bmat_temp1,bmat_temp2,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: selfenergy_r 1'
     stop
  end if
  allocate(bmat_temp5(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_r 4'
     stop
  end if

  call mat_mul2(m_mat_max_c,m_mat_max_r,m_mat_max_r,m_mat_max_c                &
       ,m_mat_max_c,m_mat_max_c,bmat_temp3,bmat_temp4,bmat_temp5)
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        se_r_mat_per(i1_do,i2_do,qx,qy)=bmat_temp5(i1_do,i2_do)
     end do
  end do

  deallocate(bmat_temp4,bmat_temp3,bmat_temp5,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: selfenergy_r 2'
     stop
  end if

  return
end subroutine selfenergy_r

subroutine surf_gf_r(w,bmat_temp2,m_mat_max_r,kx,ky,ispin)

  use condition_ini
  use surface_green_function
  use hamiltonian_sgf
  use hamiltonian_e

  implicit none
  integer, intent(in) :: m_mat_max_r,kx,ky,ispin
  complex(8), intent(in) :: w
  complex(8), intent(out) :: bmat_temp2(m_mat_max_r,m_mat_max_r)

  integer :: i2_do,i3_do

  mat_max=mat_max_rr

  call set_condition_r
  call set_hamiltonian_r(kx,ky,ispin)

  if( sgf_method_ini == 'transfer' ) then
     call alo_surface_gf_transefer(mat_max_rr)
  else
     if( sgf_method_ini == 'direct' ) then
        call alo_surface_gf_direct(mat_max_rr)
     else
        write(6,*) 'error - sgf_method_r'
     end if
  end if

  !                       ------------------------------------                       !

  if( sgf_method_ini == 'transfer' ) then
     call su_gf_trans(iteration_max_ini,mat_max_rr,eps_ini                      &
          ,h00_mat,h01_mat,h10_mat,s00_mat,s01_mat,s10_mat,w)
  else
     if( sgf_method_ini == 'direct' ) then
        call su_gf_direct(iteration_max_ini,mat_max_rr,eps_ini                   &
             ,h00_mat,h01_mat,h10_mat,s00_mat,s01_mat,s10_mat,w)
     end if
  end if
  do i3_do=1,mat_max_rr
     do i2_do=1,mat_max_rr
        bmat_temp2(i2_do,i3_do)=gr00(i2_do,i3_do)
     end do
  end do

  !                       ------------------------------------                       !

  if( sgf_method_ini == 'transfer' ) then
     call unset_surface_gf_transefer
  else
     if( sgf_method_ini == 'direct' ) then
        call unset_surface_gf_direct
     end if
  end if

  call unset_hamiltonian
  call unset_condition_r

  return
end subroutine surf_gf_r
