! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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_l(w,iw_do,px,py,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) :: px,py
  complex(8), intent(in) :: w

  integer :: i1_do,i2_do,ier,i_smd=1,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(amat_temp2(m_mat_max_l,m_mat_max_l),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_l 1'
     stop
  end if

  call surf_gf_l(w,amat_temp2,m_mat_max_l,px,py,ispin)
  if( gra_onoff /= 'off' ) then
     call cal_print_text11(iw_do,amat_temp2,ispin,kt)
  end if

  call alo_hami_c1
  if( ham_model_ini == 'input' .or. ham_model_ini == 'scf_accel') then
     call set_hami_c_ll_input(ispin)
  else
     call set_hami_c_ll(px,py)
  end if

  allocate(amat_temp1(m_mat_max_c,m_mat_max_l)                                 &
       ,amat_temp4(m_mat_max_l,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_l 2'
     stop
  end if
  do i2_do=1,m_mat_max_l
     do i1_do=1,m_mat_max_c
        amat_temp1(i1_do,i2_do)=w*scl_mat(i1_do,i2_do)-hcl_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_l
        do i2_do=i_smd,min(i_smd+i_block-1,m_mat_max_c)
           amat_temp4(i1_do,i2_do)=w*dconjg(scl_mat(i2_do,i1_do))                 &
                -dconjg(hcl_mat(i2_do,i1_do))
        end do
     end do
  end do
  call unset_hami_c1

  allocate(amat_temp3(m_mat_max_c,m_mat_max_l),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_l 3'
     stop
  end if

  call mat_mul2(m_mat_max_c,m_mat_max_l,m_mat_max_l,m_mat_max_l               &
       ,m_mat_max_c,m_mat_max_l,amat_temp1,amat_temp2,amat_temp3)

  deallocate(amat_temp1,amat_temp2,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: selfenergy_l 1'
     stop
  end if
  allocate(amat_temp5(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_l 4'
     stop
  end if

  call mat_mul2(m_mat_max_c,m_mat_max_l,m_mat_max_l,m_mat_max_c                &
       ,m_mat_max_c,m_mat_max_c,amat_temp3,amat_temp4,amat_temp5)
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        se_l_mat_per(i1_do,i2_do,px,py)=amat_temp5(i1_do,i2_do)
     end do
  end do

  deallocate(amat_temp4,amat_temp3,amat_temp5,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: selfenergy_l 2'
     stop
  end if

  return
end subroutine selfenergy_l

subroutine surf_gf_l(w,amat_temp2,m_mat_max_l,kx,ky,ispin)

  use condition_ini
  use surface_green_function
  use hamiltonian_sgf
  use hamiltonian_e

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

  integer :: i2_do,i3_do

  mat_max=mat_max_ll

  call set_condition_l
  call set_hamiltonian_l(kx,ky,ispin)

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

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

  if( sgf_method_ini == 'transfer' ) then
     call su_gf_trans(iteration_max_ini,mat_max_ll,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_ll,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_ll
     do i2_do=1,mat_max_ll
        amat_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_l

  return
end subroutine surf_gf_l
