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

subroutine selfenergy_r(descCC, descCR, descRR, 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
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: descRR, descCR, descCC
  integer, intent(in) :: iw_do,ispin,kt
  integer, intent(in) :: qx,qy
  complex(8), intent(in) :: w

  integer :: ier
  integer :: i, j
  complex(8), allocatable :: bmat_temp1(:,:),bmat_temp2(:,:)
  complex(8), allocatable :: bmat_temp3(:,:),bmat_temp4(:,:)
  complex(8), allocatable :: bmat_temp5(:,:)

  complex(8) :: trace
  allocate(bmat_temp1(descCR%nrow,descCR%scol:descCR%ecol),stat=ier)
  allocate(bmat_temp2(descRR%nrow,descRR%scol:descRR%ecol),stat=ier)
  allocate(bmat_temp4(descCR%nrow,descCR%scol:descCR%ecol),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: selfenergy_r'
     stop
  end if

  call surf_gf_r(descRR,w,bmat_temp2,qx,qy,ispin)

  if( gra_onoff /= 'off') then
     call MPI__ZLATRA_ASCOT( descRR, bmat_temp2, trace )
     call cal_print_text12(iw_do,trace,ispin,kt)
  end if

  call alo_hami_c2(descCR)

  if( ham_model_ini == 'input' .or. ham_model_ini == 'scf_accel') then
     call set_hami_c_rr_input(descCR,descRR,ispin)
  else
     call set_hami_c_rr(descCR,qx,qy)
  end if

  bmat_temp1(:,:) = w*scr_mat(:,:) - hcr_mat(:,:) 
  bmat_temp4(:,:) = dconjg(w)*scr_mat(:,:) - hcr_mat(:,:) 

  call unset_hami_c2

  allocate(bmat_temp3(descCR%nrow,descCR%scol:descCR%ecol),stat=ier)
  allocate(bmat_temp5(descCC%nrow,descCC%scol:descCC%ecol),stat=ier)

  call MPI__ZGEMM2_ASCOT( 'N', 'N', descCR, descRR, descCR, &
       C1, bmat_temp1, bmat_temp2, C0, bmat_temp3 )
  call MPI__ZGEMM2_ASCOT( 'N', 'C', descCR, descCR, descCC, &
       C1, bmat_temp3, bmat_temp4, C0, bmat_temp5 )

  se_r_mat_per(:,:,qx,qy) = bmat_temp5(:,:) 

  deallocate(bmat_temp1,bmat_temp2,bmat_temp3,bmat_temp4,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(descRR,w,bmat_temp2,kx,ky,ispin)

  use condition_ini
  use surface_green_function
  use hamiltonian_sgf
  use hamiltonian_e
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: descRR
  complex(8), intent(in) :: w
  complex(8), intent(out) :: bmat_temp2(descRR%nrow,descRR%scol:descRR%ecol)
  integer, intent(in) :: kx,ky,ispin

  integer :: i, j

  mat_max=mat_max_rr

  call set_condition_r
  call set_hamiltonian_r(descRR,kx,ky,ispin)

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

  if( sgf_method_ini == 'transfer' ) then
     call su_gf_trans(descRR,iteration_max_ini,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(descRR,iteration_max_ini,eps_ini, &
             h00_mat,h01_mat,h10_mat,s00_mat,s01_mat,s10_mat,w) 
     end if
  end if

  bmat_temp2(:,:) = gr00(:,:)

  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
