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

subroutine ep1(a,d,n,l_con)  ! l_con=0 -> only eigen values
  ! d: output -> eigen values
  ! a: input -> symmetry matrix, output -> eigen vectors

  implicit none
  integer, intent(in) :: n,l_con
  real(8), intent(inout) :: a(n,n)
  real(8), intent(out) :: d(n)
  integer :: ier,i1_do,i2_do

  character(1) :: jobz,uplo
  real(8), allocatable :: ap(:),z(:,:),w(:),work(:)
  integer :: ldz,info

  if( l_con /= 0 ) then
     jobz='V'
  else
     jobz='N'
  end if
  uplo='U'
  ldz=n
  allocate(ap(n*(n+1)/2),w(n),z(ldz,n),work(3*n),stat=ier)
  if( ier /= 0 ) then
     write(16,*) 'error allocate: cal_eigen'
     stop
  end if
  do i2_do=1,n
     do i1_do=1,n
        if( i1_do <= i2_do ) then
           ap(i1_do+(i2_do-1)*i2_do/2)=a(i1_do,i2_do)
        end if
     end do
  end do
  call dspev(jobz,uplo,n,ap,w,z,ldz,work,info)
  if( info /= 0 ) then
     write(16,*) '         info: dspev-1',info
  end if
  do i2_do=1,n
     d(i2_do)=w(i2_do)
     if( l_con /= 0 ) then
        do i1_do=1,n
           a(i1_do,i2_do)=z(i1_do,i2_do)
        end do
     end if
  end do
  deallocate(ap,w,z,work,stat=ier)
  if( ier /= 0 ) then
     write(16,*) 'error allocate: cal_eigen'
     stop
  end if

  return
end subroutine ep1

subroutine ep_as1(a,d,n,ier_ev)
  ! d: output -> eigen values
  ! a: input -> symmetry matrix, output -> eigen vectors

  implicit none
  integer, intent(in) :: n
  integer, intent(out) :: ier_ev
  real(8), intent(inout) :: a(n,n)
  complex(8), intent(out) :: d(n)
  integer :: ier,i1_do,i2_do

  character(1) :: jobvl,jobvr
  real(8), allocatable :: ap(:,:),wr(:),wi(:),vl(:,:),vr(:,:),work(:)
  integer :: lda,ldvl,ldvr,info,lwork

  jobvl='N'
  jobvr='N'
  lda=n
  ldvl=n
  ldvr=n
  lwork=3*n
  allocate(ap(lda,n),wr(n),wi(n),vl(ldvl,n),vr(ldvr,n),work(lwork),stat=ier)
  if( ier /= 0 ) then
     write(16,*) 'error allocate: cal_eigen'
     stop
  end if
  do i2_do=1,n
     do i1_do=1,n
        ap(i1_do,i2_do)=a(i1_do,i2_do)
     end do
  end do

  call dgeev(jobvl,jobvr,n,ap,lda,wr,wi,vl,ldvl,vr,ldvr,work,lwork,info)

  do i1_do=1,n
     d(i1_do)=dcmplx(wr(i1_do),wi(i1_do))
  end do
  ier_ev=info
  if( info /= 0 ) then
     write(16,*) '         info: dgeev-1',info
  end if
  deallocate(ap,wr,wi,vl,vr,work,stat=ier)
  if( ier /= 0 ) then
     write(16,*) 'error allocate: cal_eigen'
     stop
  end if

  return
end subroutine ep_as1
