! @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ !
! @@                                                                @@ !
! @@       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 green_function_scf(w,w_weight,iw_do,px,py,qx,qy,ispin)

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

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

  integer :: i1_do,i2_do,ier
  complex(8), allocatable :: amat_temp6(:,:),bmat_temp6(:,:),cmat_temp6(:,:)

  call alo_hami_c3
  call set_hami_c_cc_scf(ispin)

  allocate(amat_temp6(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: green_function_scf 1'
     stop
  end if

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)                                                  &
             =(w*scc_mat(i1_do,i2_do)-hcc_mat(i1_do,i2_do))
     end do
  end do
  call unset_hami_c31
  call unset_hami_c32

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)                                                  &
             =amat_temp6(i1_do,i2_do)                                           &
             -se_l_mat_per(i1_do,i2_do,px,py)-se_r_mat_per(i1_do,i2_do,qx,qy)
     end do
  end do

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

  call inverse_mat1(m_mat_max_c,amat_temp6,bmat_temp6)

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

  if( i_bios_omega_scf(iw_do) == 1 ) then

     do i2_do=1,m_mat_max_c
        do i1_do=1,m_mat_max_c
           dens(ispin,i1_do,i2_do)=dens(ispin,i1_do,i2_do)                        &
                +dreal(bmat_temp6(i1_do,i2_do)*w_weight)        &
                +dreal(dconjg(bmat_temp6(i2_do,i1_do)*w_weight))
           dens2(ispin,i1_do,i2_do)=dens2(ispin,i1_do,i2_do)                      &
                +dimag(bmat_temp6(i1_do,i2_do)*w_weight)       &
                +dimag(dconjg(bmat_temp6(i2_do,i1_do)*w_weight))
        end do
     end do

  else

     allocate(cmat_temp6(m_mat_max_c,m_mat_max_c),stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error allocate: green_function_scf 2'
        stop
     end if

     if( dreal(w) <= cp_l ) then
        do i2_do=1,m_mat_max_c
           do i1_do=1,m_mat_max_c
              cmat_temp6(i1_do,i2_do)                                              &
                   =-(se_l_mat_per(i1_do,i2_do,px,py)                              &
                   -dconjg(se_l_mat_per(i2_do,i1_do,px,py)))
           end do
        end do
     else
        do i2_do=1,m_mat_max_c
           do i1_do=1,m_mat_max_c
              cmat_temp6(i1_do,i2_do)=dcmplx(0.d0,0.d0)
           end do
        end do
     end if
     if( dreal(w) <= cp_r ) then
        do i2_do=1,m_mat_max_c
           do i1_do=1,m_mat_max_c
              cmat_temp6(i1_do,i2_do)                                              &
                   =cmat_temp6(i1_do,i2_do)                                        &
                   -(se_r_mat_per(i1_do,i2_do,qx,qy)                               &
                   -dconjg(se_r_mat_per(i2_do,i1_do,qx,qy)))
           end do
        end do
     end if

     call mat_mul(m_mat_max_c,bmat_temp6,cmat_temp6,amat_temp6)

     do i2_do=1,m_mat_max_c
        do i1_do=1,m_mat_max_c
           cmat_temp6(i1_do,i2_do)=dconjg(bmat_temp6(i2_do,i1_do))
        end do
     end do

     call mat_mul(m_mat_max_c,amat_temp6,cmat_temp6,bmat_temp6)

     deallocate(cmat_temp6,stat=ier)
     if( ier /= 0 ) then
        write(6,*) 'error deallocate: green_function_scf 2'
        stop
     end if

     do i2_do=1,m_mat_max_c
        do i1_do=1,m_mat_max_c
           dens(ispin,i1_do,i2_do)=dens(ispin,i1_do,i2_do)                        &
                +dreal(bmat_temp6(i1_do,i2_do)*w_weight)
           dens2(ispin,i1_do,i2_do)=dens2(ispin,i1_do,i2_do)                      &
                +dimag(bmat_temp6(i1_do,i2_do)*w_weight)
        end do
     end do

  end if

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

  deallocate(amat_temp6,bmat_temp6,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: green_function_scf 3'
     stop
  end if

  return
end subroutine green_function_scf

subroutine calc_edm(ispin)

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

  implicit none
  integer, intent(in) :: ispin

  integer :: i1_do,i2_do,ier
  complex(8), allocatable :: amat_temp6(:,:),bmat_temp6(:,:)
  complex(8), allocatable :: cmat_temp6(:,:),dmat_temp6(:,:)

  call alo_hami_c3
  call set_hami_c_cc_scf(ispin)

  allocate(amat_temp6(m_mat_max_c,m_mat_max_c)                                 &
       ,bmat_temp6(m_mat_max_c,m_mat_max_c)                                 &
       ,cmat_temp6(m_mat_max_c,m_mat_max_c)                                 &
       ,dmat_temp6(m_mat_max_c,m_mat_max_c),stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error allocate: green_function_scf 1'
     stop
  end if

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)=scc_mat(i1_do,i2_do)
     end do
  end do
  call inverse_mat1(m_mat_max_c,amat_temp6,bmat_temp6)

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)=hcc_mat(i1_do,i2_do)
     end do
  end do

  call unset_hami_c31
  call unset_hami_c32

  call mat_mul(m_mat_max_c,bmat_temp6,amat_temp6,cmat_temp6)
  call mat_mul(m_mat_max_c,amat_temp6,bmat_temp6,dmat_temp6)

  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        amat_temp6(i1_do,i2_do)                                                  &
             =dcmplx(dens(ispin,i1_do,i2_do),dens2(ispin,i1_do,i2_do))*.5d0
     end do
  end do

  call mat_mul(m_mat_max_c,cmat_temp6,amat_temp6,bmat_temp6)
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        edens(ispin,i1_do,i2_do)=edens(ispin,i1_do,i2_do)                        &
             +dreal(bmat_temp6(i1_do,i2_do))
        edens2(ispin,i1_do,i2_do)=edens2(ispin,i1_do,i2_do)                      &
             +dimag(bmat_temp6(i1_do,i2_do))
     end do
  end do

  call mat_mul(m_mat_max_c,amat_temp6,dmat_temp6,bmat_temp6)
  do i2_do=1,m_mat_max_c
     do i1_do=1,m_mat_max_c
        edens(ispin,i1_do,i2_do)=edens(ispin,i1_do,i2_do)                        &
             +dreal(bmat_temp6(i1_do,i2_do))
        edens2(ispin,i1_do,i2_do)=edens2(ispin,i1_do,i2_do)                      &
             +dimag(bmat_temp6(i1_do,i2_do))
     end do
  end do

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

  deallocate(amat_temp6,bmat_temp6,cmat_temp6,dmat_temp6,stat=ier)
  if( ier /= 0 ) then
     write(6,*) 'error deallocate: green_function_scf 3'
     stop
  end if

  return
end subroutine calc_edm
