gejsv Interface

public interface gejsv

GEJSV computes the singular value decomposition (SVD) of a complex M-by-N matrix [A], where M >= N. The SVD of [A] is written as [A] = [U] * [SIGMA] * [V]^*, where [SIGMA] is an N-by-N (M-by-N) matrix which is zero except for its N diagonal elements, [U] is an M-by-N (or M-by-M) unitary matrix, and [V] is an N-by-N unitary matrix. The diagonal elements of [SIGMA] are the singular values of [A]. The columns of [U] and [V] are the left and the right singular vectors of [A], respectively. The matrices [U] and [V] are computed and stored in the arrays U and V, respectively. The diagonal of [SIGMA] is computed and stored in the array SVA.


Subroutines

public pure subroutine cgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: joba
character(len=1), intent(in) :: jobu
character(len=1), intent(in) :: jobv
character(len=1), intent(in) :: jobr
character(len=1), intent(in) :: jobt
character(len=1), intent(in) :: jobp
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
complex(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(out) :: sva(n)
complex(kind=sp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
complex(kind=sp), intent(out) :: v(ldv,*)
integer(kind=ilp), intent(in) :: ldv
complex(kind=sp), intent(out) :: cwork(lwork)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(lrwork)
integer(kind=ilp), intent(in) :: lrwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine dgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: joba
character(len=1), intent(in) :: jobu
character(len=1), intent(in) :: jobv
character(len=1), intent(in) :: jobr
character(len=1), intent(in) :: jobt
character(len=1), intent(in) :: jobp
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
real(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(out) :: sva(n)
real(kind=dp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
real(kind=dp), intent(out) :: v(ldv,*)
integer(kind=ilp), intent(in) :: ldv
real(kind=dp), intent(out) :: work(lwork)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine sgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: joba
character(len=1), intent(in) :: jobu
character(len=1), intent(in) :: jobv
character(len=1), intent(in) :: jobr
character(len=1), intent(in) :: jobt
character(len=1), intent(in) :: jobp
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
real(kind=sp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=sp), intent(out) :: sva(n)
real(kind=sp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
real(kind=sp), intent(out) :: v(ldv,*)
integer(kind=ilp), intent(in) :: ldv
real(kind=sp), intent(out) :: work(lwork)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public pure subroutine zgejsv(joba, jobu, jobv, jobr, jobt, jobp, m, n, a, lda, sva, u, ldu, v, ldv, cwork, lwork, rwork, lrwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: joba
character(len=1), intent(in) :: jobu
character(len=1), intent(in) :: jobv
character(len=1), intent(in) :: jobr
character(len=1), intent(in) :: jobt
character(len=1), intent(in) :: jobp
integer(kind=ilp), intent(in) :: m
integer(kind=ilp), intent(in) :: n
complex(kind=dp), intent(inout) :: a(lda,*)
integer(kind=ilp), intent(in) :: lda
real(kind=dp), intent(out) :: sva(n)
complex(kind=dp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
complex(kind=dp), intent(out) :: v(ldv,*)
integer(kind=ilp), intent(in) :: ldv
complex(kind=dp), intent(out) :: cwork(lwork)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(lrwork)
integer(kind=ilp), intent(in) :: lrwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cgejsv()

Arguments

None

public interface stdlib_dgejsv()

Arguments

None

public interface stdlib_sgejsv()

Arguments

None

public interface stdlib_zgejsv()

Arguments

None