! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 su_gf_trans(desc,iteration_max,eps, &
     h00_mat,h01_mat,h10_mat,s00_mat,s01_mat,s10_mat,w)

  use surface_green_function
  use ac_mpi_module

  implicit none
  type(MPI_MatDesc), intent(in) :: desc 
  integer, intent(in) :: iteration_max
  real(8), intent(in) :: eps
  complex(8), intent(in) :: h00_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: h01_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: h10_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s00_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s01_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s10_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: w

  integer :: i_do
  integer :: i, j
  real(8) :: del_gr00, del_gr00_mpi

  gr02(:,:) =  w*s00_mat(:,:) - h00_mat(:,:) 

  call MPI__ZGETRI_ASCOT( desc, gr02 )

  gr01(:,:) = -w*s10_mat(:,:) + h10_mat(:,:) 

  call MPI__ZGEMM_ASCOT( 'N', 'N', desc, &
       C1, gr02, gr01, C0, tr1 )

  gr01(:,:) = -w*s01_mat(:,:) + h01_mat(:,:) 

  call MPI__ZGEMM_ASCOT( 'N', 'N', desc, &
       C1, gr02, gr01, C0, tr2 )

  tm(:,:) = tr1(:,:)

  tm_temp(:,:) = tr2(:,:)

  gr02(:,:) = -w*s01_mat(:,:) + h01_mat(:,:) 

  call MPI__ZGEMM_ASCOT( 'N', 'N', desc, &
       C1, gr02, tm, C0, gr01 )

  gr00(:,:) = w*s00_mat(:,:) - h00_mat(:,:) - gr01(:,:) 

  call MPI__ZGETRI_ASCOT( desc, gr00 )

  temp(:,:) = gr00(:,:)

  do i_do=1,iteration_max

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tr1, tr2, C0, gr01 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tr2, tr1, C0, gr02 )

     gr01(:,:) = -gr01(:,:) - gr02(:,:)

     gr02(:,:) = gr01(:,:)
     do j=desc%scol,desc%ecol
        gr02(j,j) = gr01(j,j) + dcmplx(1.d0,0.d0)
     end do

     call MPI__ZGETRI_ASCOT( desc, gr02 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tr1, tr1, C0, gr01 )
     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, gr01, C0, tr1 )
     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tr2, tr2, C0, gr01 )
     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, gr01, C0, tr2 )
     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tm_temp, tr1, C0, gr01 )

     tm(:,:) = tm(:,:) + gr01(:,:)

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, tm_temp, tr2, C0, gr01 )

     tm_temp(:,:) = gr01(:,:)

     gr02(:,:) = -w*s01_mat(:,:) + h01_mat(:,:) 

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, tm, C0, gr01 )

     gr00(:,:) = w*s00_mat(:,:) - h00_mat(:,:) - gr01(:,:) 

     call MPI__ZGETRI_ASCOT( desc, gr00 )


     del_gr00_mpi = maxval(cdabs(temp(:,:)-gr00(:,:)))
     call MPI_Allreduce( del_gr00_mpi, del_gr00, 1, &
          MPI_DOUBLE_PRECISION, MPI_MAX, MPI%commM, MPI%info )
     if( del_gr00 < eps ) then
        exit
     else
        temp(:,:)=gr00(:,:)
     end if

     if( i_do == iteration_max ) then
        write(16,*) 'error transfer_su-gr-fu',w,del_gr00
     end if

  end do

  gr02(:,:) = -w*s01_mat(:,:) + h01_mat(:,:) 

  call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, tm, C0, gr01 )

  gr00(:,:) = w*s00_mat(:,:) - h00_mat(:,:) - gr01(:,:) 

  call MPI__ZGETRI_ASCOT( desc, gr00 )

  return
end subroutine su_gf_trans

subroutine su_gf_direct(desc,iteration_max,eps, &
     h00_mat,h01_mat,h10_mat,s00_mat,s01_mat,s10_mat,w)

  use surface_green_function
  use ac_mpi_module
  implicit none

  type(MPI_MatDesc), intent(in) :: desc 
  integer, intent(in) :: iteration_max
  real(8), intent(in) :: eps
  complex(8), intent(in) :: h00_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: h01_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: h10_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s00_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s01_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: s10_mat(desc%nrow, desc%scol:desc%ecol) 
  complex(8), intent(in) :: w

  integer :: i_do
  integer :: i, j
  real(8) :: del_gr00, del_gr00_mpi


  es0(:,:) =  w*s00_mat(:,:) - h00_mat(:,:) 
  e00(:,:) =  w*s00_mat(:,:) - h00_mat(:,:) 
  alp(:,:) = -w*s01_mat(:,:) + h01_mat(:,:) 
  bet(:,:) = -w*s10_mat(:,:) + h10_mat(:,:) 

  gr00(:,:) = es0(:,:)
  call MPI__ZGETRI_ASCOT( desc, gr00 )

  temp(:,:)=gr00(:,:)

  do i_do=1,iteration_max
     gr02(:,:) = e00(:,:)
     call MPI__ZGETRI_ASCOT( desc, gr02 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, bet, C0, gr01 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, alp, gr01, C0, gr00 )

     es0(:,:) = es0(:,:) - gr00(:,:)

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, alp, C0, gr01 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, gr02, bet, C0, gr00 )

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, bet, gr01, C0, gr02 )

     e00(:,:) = e00(:,:) - gr02(:,:)

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, alp, gr00, C0, gr02 )

     e00(:,:) = e00(:,:) - gr02(:,:)

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, alp, gr01, C0, gr02 )

     alp(:,:) = gr02(:,:)

     call MPI__ZGEMM_ASCOT( 'N', 'N', desc, C1, bet, gr00, C0, gr02 )

     bet(:,:) = gr02(:,:)

     gr00(:,:) = es0(:,:)
     call MPI__ZGETRI_ASCOT( desc, gr00 )

     del_gr00_mpi = maxval(cdabs(temp(:,:)-gr00(:,:)))
     call MPI_Allreduce( del_gr00_mpi, del_gr00, 1, &
          MPI_DOUBLE_PRECISION, MPI_MAX, MPI%commM, MPI%info )
     if( del_gr00 < eps ) then
        exit
     else
        temp(:,:) = gr00(:,:)
     end if

     if( i_do == iteration_max ) then
        write(16,*) 'error direct_su-gr-fu',w,del_gr00
     end if

  end do

  return
end subroutine su_gf_direct
