gesdd Interface

public interface gesdd

GESDD computes the singular value decomposition (SVD) of a complex M-by-N matrix A, optionally computing the left and/or right singular vectors, by using divide-and-conquer method. The SVD is written A = U * SIGMA * conjugate-transpose(V) where SIGMA is an M-by-N matrix which is zero except for its min(m,n) diagonal elements, U is an 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; they are real and non-negative, and are returned in descending order. The first min(m,n) columns of U and V are the left and right singular vectors of A. Note that the routine returns VT = V**H, not V. The divide and conquer algorithm makes very mild assumptions about floating point arithmetic. It will work on machines with a guard digit in add/subtract, or on those binary machines without guard digits which subtract like the Cray X-MP, Cray Y-MP, Cray C-90, or Cray-2. It could conceivably fail on hexadecimal or decimal machines without guard digits, but we know of none.


Subroutines

public subroutine cgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobz
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) :: s(*)
complex(kind=sp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
complex(kind=sp), intent(out) :: vt(ldvt,*)
integer(kind=ilp), intent(in) :: ldvt
complex(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=sp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine dgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobz
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) :: s(*)
real(kind=dp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
real(kind=dp), intent(out) :: vt(ldvt,*)
integer(kind=ilp), intent(in) :: ldvt
real(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine sgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobz
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) :: s(*)
real(kind=sp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
real(kind=sp), intent(out) :: vt(ldvt,*)
integer(kind=ilp), intent(in) :: ldvt
real(kind=sp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

public subroutine zgesdd(jobz, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, iwork, info)

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: jobz
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) :: s(*)
complex(kind=dp), intent(out) :: u(ldu,*)
integer(kind=ilp), intent(in) :: ldu
complex(kind=dp), intent(out) :: vt(ldvt,*)
integer(kind=ilp), intent(in) :: ldvt
complex(kind=dp), intent(out) :: work(*)
integer(kind=ilp), intent(in) :: lwork
real(kind=dp), intent(out) :: rwork(*)
integer(kind=ilp), intent(out) :: iwork(*)
integer(kind=ilp), intent(out) :: info

Module Procedures

public interface stdlib_cgesdd()

Arguments

None

public interface stdlib_dgesdd()

Arguments

None

public interface stdlib_sgesdd()

Arguments

None

public interface stdlib_zgesdd()

Arguments

None