hsein Interface

public interface hsein

HSEIN uses inverse iteration to find specified right and/or left eigenvectors of a complex upper Hessenberg matrix H. The right eigenvector x and the left eigenvector y of the matrix H corresponding to an eigenvalue w are defined by: H * x = w * x, yh * H = w * yh where y**h denotes the conjugate transpose of the vector y.


Subroutines

public subroutine chsein(side, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: eigsrc
character(len=1), intent(in) :: initv
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(in) :: h(ldh,*)
integer(kind=ilp), intent(in) :: ldh
complex(kind=sp), intent(inout) :: w(*)
complex(kind=sp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=sp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
complex(kind=sp), intent(out) :: work(*)
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: ifaill(*)
integer(kind=ilp), intent(out) :: ifailr(*)
integer(kind=ilp), intent(out) :: info

public subroutine dhsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: eigsrc
character(len=1), intent(in) :: initv
logical(kind=lk), intent(inout) :: select(*)
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(in) :: h(ldh,*)
integer(kind=ilp), intent(in) :: ldh
real(kind=dp), intent(inout) :: wr(*)
real(kind=dp), intent(in) :: wi(*)
real(kind=dp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=dp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: ifaill(*)
integer(kind=ilp), intent(out) :: ifailr(*)
integer(kind=ilp), intent(out) :: info

public subroutine shsein(side, eigsrc, initv, select, n, h, ldh, wr, wi, vl, ldvl, vr, ldvr, mm, m, work, ifaill, ifailr, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: eigsrc
character(len=1), intent(in) :: initv
logical(kind=lk), intent(inout) :: select(*)
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(in) :: h(ldh,*)
integer(kind=ilp), intent(in) :: ldh
real(kind=sp), intent(inout) :: wr(*)
real(kind=sp), intent(in) :: wi(*)
real(kind=sp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
real(kind=sp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(out) :: ifaill(*)
integer(kind=ilp), intent(out) :: ifailr(*)
integer(kind=ilp), intent(out) :: info

public subroutine zhsein(side, eigsrc, initv, select, n, h, ldh, w, vl, ldvl, vr, ldvr, mm, m, work, rwork, ifaill, ifailr, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: side
character(len=1), intent(in) :: eigsrc
character(len=1), intent(in) :: initv
logical(kind=lk), intent(in) :: select(*)
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(in) :: h(ldh,*)
integer(kind=ilp), intent(in) :: ldh
complex(kind=dp), intent(inout) :: w(*)
complex(kind=dp), intent(inout) :: vl(ldvl,*)
integer(kind=ilp), intent(in) :: ldvl
complex(kind=dp), intent(inout) :: vr(ldvr,*)
integer(kind=ilp), intent(in) :: ldvr
integer(kind=ilp), intent(in) :: mm
integer(kind=ilp), intent(out) :: m
complex(kind=dp), intent(out) :: work(*)
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: ifaill(*)
integer(kind=ilp), intent(out) :: ifailr(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_chsein()

Arguments

None

public interface stdlib_dhsein()

Arguments

None

public interface stdlib_shsein()

Arguments

None

public interface stdlib_zhsein()

Arguments

None