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

  use surface_green_function

  implicit none
  integer, intent(in) :: iteration_max,mat_max
  real(8), intent(in) :: eps
  complex(8), intent(in) :: h00_mat(mat_max,mat_max)
  complex(8), intent(in) :: h01_mat(mat_max,mat_max)
  complex(8), intent(in) :: h10_mat(mat_max,mat_max)
  complex(8), intent(in) :: s00_mat(mat_max,mat_max)
  complex(8), intent(in) :: s01_mat(mat_max,mat_max)
  complex(8), intent(in) :: s10_mat(mat_max,mat_max)
  complex(8), intent(in) :: w
  integer :: i_do,mat1_do,mat2_do
  integer :: i1_do,i2_do
  real(8) :: del_gr00_temp

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr01(i1_do,i2_do)=w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do)
     end do
  end do
  call inverse_mat1(mat_max,gr01,gr02)

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr01(i1_do,i2_do)=-w*s10_mat(i1_do,i2_do)+h10_mat(i1_do,i2_do)
     end do
  end do
  call mat_mul(mat_max,gr02,gr01,tr1)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr01(i1_do,i2_do)=-w*s01_mat(i1_do,i2_do)+h01_mat(i1_do,i2_do)
     end do
  end do
  call mat_mul(mat_max,gr02,gr01,tr2)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        tm(i1_do,i2_do)=tr1(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        tm_temp(i1_do,i2_do)=tr2(i1_do,i2_do)
     end do
  end do

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr02(i1_do,i2_do)=-w*s01_mat(i1_do,i2_do)+h01_mat(i1_do,i2_do)
     end do
  end do
  call mat_mul(mat_max,gr02,tm,gr01)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr01(i1_do,i2_do)=(w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do))          &
             -gr01(i1_do,i2_do)
     end do
  end do
  call inverse_mat1(mat_max,gr01,gr00)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        temp(i1_do,i2_do)=gr00(i1_do,i2_do)
     end do
  end do

  do i_do=1,iteration_max

     call mat_mul(mat_max,tr1,tr2,gr01)
     call mat_mul(mat_max,tr2,tr1,gr02)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           gr01(i1_do,i2_do)=-gr01(i1_do,i2_do)-gr02(i1_do,i2_do)
        end do
        gr01(i2_do,i2_do)=dcmplx(1.d0,0.d0)+gr01(i2_do,i2_do)
     end do
     call inverse_mat1(mat_max,gr01,gr02)

     call mat_mul(mat_max,tr1,tr1,gr01)
     call mat_mul(mat_max,gr02,gr01,tr1)
     call mat_mul(mat_max,tr2,tr2,gr01)
     call mat_mul(mat_max,gr02,gr01,tr2)

     call mat_mul(mat_max,tm_temp,tr1,gr01)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           tm(i1_do,i2_do)=tm(i1_do,i2_do)+gr01(i1_do,i2_do)
        end do
     end do
     call mat_mul(mat_max,tm_temp,tr2,gr01)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           tm_temp(i1_do,i2_do)=gr01(i1_do,i2_do)
        end do
     end do

     do i2_do=1,mat_max
        do i1_do=1,mat_max
           gr02(i1_do,i2_do)=-w*s01_mat(i1_do,i2_do)+h01_mat(i1_do,i2_do)
        end do
     end do
     call mat_mul(mat_max,gr02,tm,gr01)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           gr01(i1_do,i2_do)=(w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do))        &
                -gr01(i1_do,i2_do)
        end do
     end do
     call inverse_mat1(mat_max,gr01,gr00)

     del_gr00_temp=0.d0
     do mat2_do=1,mat_max
        do mat1_do=1,mat_max
           del_gr00_temp=max(del_gr00_temp                                        &
                ,cdabs(temp(mat1_do,mat2_do)-gr00(mat1_do,mat2_do)))
        end do
     end do
     if( del_gr00_temp < eps ) then
        exit
     else
        do i2_do=1,mat_max
           do i1_do=1,mat_max
              temp(i1_do,i2_do)=gr00(i1_do,i2_do)
           end do
        end do
     end if
     if( i_do == iteration_max ) then
        write(16,*) 'error transfer_su-gr-fu'
     end if

  end do

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr02(i1_do,i2_do)=-w*s01_mat(i1_do,i2_do)+h01_mat(i1_do,i2_do)
     end do
  end do
  call mat_mul(mat_max,gr02,tm,gr01)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        gr01(i1_do,i2_do)=(w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do))          &
             -gr01(i1_do,i2_do)
     end do
  end do
  call inverse_mat1(mat_max,gr01,gr00)

  return
end subroutine su_gf_trans

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

  use surface_green_function

  implicit none
  integer, intent(in) :: iteration_max,mat_max
  real(8), intent(in) :: eps
  complex(8), intent(in) :: h00_mat(mat_max,mat_max)
  complex(8), intent(in) :: h01_mat(mat_max,mat_max)
  complex(8), intent(in) :: h10_mat(mat_max,mat_max)
  complex(8), intent(in) :: s00_mat(mat_max,mat_max)
  complex(8), intent(in) :: s01_mat(mat_max,mat_max)
  complex(8), intent(in) :: s10_mat(mat_max,mat_max)
  complex(8), intent(in) :: w
  integer :: i_do,mat1_do,mat2_do
  integer :: i1_do,i2_do
  real(8) :: del_gr00_temp

  do i2_do=1,mat_max
     do i1_do=1,mat_max
        es0(i1_do,i2_do)=w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        e00(i1_do,i2_do)=w*s00_mat(i1_do,i2_do)-h00_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        alp(i1_do,i2_do)=-w*s01_mat(i1_do,i2_do)+h01_mat(i1_do,i2_do)
     end do
  end do
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        bet(i1_do,i2_do)=-w*s10_mat(i1_do,i2_do)+h10_mat(i1_do,i2_do)
     end do
  end do

  call inverse_mat1(mat_max,es0,gr00)
  do i2_do=1,mat_max
     do i1_do=1,mat_max
        temp(i1_do,i2_do)=gr00(i1_do,i2_do)
     end do
  end do

  do i_do=1,iteration_max
     call inverse_mat1(mat_max,e00,gr02)

     call mat_mul(mat_max,gr02,bet,gr01)
     call mat_mul(mat_max,alp,gr01,gr00)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           es0(i1_do,i2_do)=es0(i1_do,i2_do)-gr00(i1_do,i2_do)
        end do
     end do

     call mat_mul(mat_max,gr02,alp,gr01)
     call mat_mul(mat_max,gr02,bet,gr00)

     call mat_mul(mat_max,bet,gr01,gr02)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           e00(i1_do,i2_do)=e00(i1_do,i2_do)-gr02(i1_do,i2_do)
        end do
     end do
     call mat_mul(mat_max,alp,gr00,gr02)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           e00(i1_do,i2_do)=e00(i1_do,i2_do)-gr02(i1_do,i2_do)
        end do
     end do

     call mat_mul(mat_max,alp,gr01,gr02)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           alp(i1_do,i2_do)=gr02(i1_do,i2_do)
        end do
     end do

     call mat_mul(mat_max,bet,gr00,gr02)
     do i2_do=1,mat_max
        do i1_do=1,mat_max
           bet(i1_do,i2_do)=gr02(i1_do,i2_do)
        end do
     end do

     call inverse_mat1(mat_max,es0,gr00)

     del_gr00_temp=0.d0
     do mat2_do=1,mat_max
        do mat1_do=1,mat_max
           del_gr00_temp=max(del_gr00_temp                                        &
                ,cdabs(temp(mat1_do,mat2_do)-gr00(mat1_do,mat2_do)))
        end do
     end do
     if( del_gr00_temp < eps ) then
        exit
     else
        do i2_do=1,mat_max
           do i1_do=1,mat_max
              temp(i1_do,i2_do)=gr00(i1_do,i2_do)
           end do
        end do
     end if
     if( i_do == iteration_max ) then
        write(16,*) 'error direct_su-gr-fu',w,del_gr00_temp
     end if

  end do

  return
end subroutine su_gf_direct
