next up previous contents index
Next: Computational Routines for the Up: Computational Routines Previous: Computational Routines for the   Contents   Index


Computational Routines for the Singular Value Decomposition

LA_GEBRD
Real and complex versions.


SUBROUTINE LA_GEBRD( M, N, A, LDA, D, E, & 

TAUQ, TAUP, WORK, LWORK, INFO )
INTEGER, INTENT(IN) :: LDA, LWORK, M, N
INTEGER, INTENT(OUT) :: INFO
REAL(wp), INTENT(OUT) :: D(*), E(*)
type(wp), INTENT(INOUT) :: A(LDA,*)
type(wp), INTENT(OUT) :: TAUP(*), TAUQ(*), &
WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_GEBRD reduces a general real / complex $m \times n$ matrix $A$ to upper or lower bidiagonal form $B$ by an orthogonal / unitary transformation: $Q^H A P = B$.
References: See  [1] and [9,20].
-----------------------------------

LA_GBBRD
Real version.


SUBROUTINE LA_GBBRD( VECT, M, N, NCC, & 

KL, KU, AB, LDAB, D, E, Q, LDQ, PT, &
LDPT, C, LDC, WORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: VECT
INTEGER, INTENT(IN) :: KL, KU, LDAB, &
LDC, LDPT, LDQ, M, N, NCC
INTEGER, INTENT(OUT) :: INFO
REAL(wp), INTENT(OUT) :: D(*), E(*)
REAL(wp), INTENT(INOUT) :: AB(LDAB,*), &
C(LDC,*)
REAL(wp), INTENT(OUT) :: PT(LDPT,*), &
Q(LDQ,*), WORK(*)
where
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


Complex version.


 SUBROUTINE LA_GBBRD( VECT, M, N, NCC, & 

KL, KU, AB, LDAB, D, E, Q, LDQ, PT, &
LDPT, C, LDC, WORK, RWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: VECT
INTEGER, INTENT(IN) :: KL, KU, LDAB, &
LDC, LDPT, LDQ, M, N, NCC
INTEGER, INTENT(OUT) :: INFO
REAL(wp), INTENT(OUT) :: D(*), E(*),&
RWORK(*)
COMPLEX(wp), INTENT(INOUT) :: &
AB(LDAB,*), C(LDC,*)
COMPLEX(wp), INTENT(OUT) :: PT(LDPT,*), &
Q(LDQ,*), WORK(*)
where
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_GBBRD reduces a real / complex general $m \times n$ band matrix $A$ to real upper bidiagonal form $B$ by an orthogonal / unitary transformation: $Q^H A P = B$.
References: See  [1] and [9,20].
-----------------------------------

LA_ORGBR / LA_UNGBR
Real and complex versions.


SUBROUTINE LA_ORGBR / LA_UNGBR( & 

VECT, M, N, K, A, LDA, TAU, WORK, &
LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: VECT
INTEGER, INTENT(IN) :: K, LDA, LWORK, M, &
N
INTEGER, INTENT(OUT) :: INFO
type(wp), INTENT(IN) :: TAU(*)
type(wp), INTENT(INOUT) :: A(LDA,*)
type(wp), INTENT(OUT) :: WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORGBR / LA_UNGBR generates one of the real / complex orthogonal / unitary matrices $Q$ or $P^H$ determined by LA_GEBRD when reducing a complex matrix $A$ to bidiagonal form: $A = Q B P^H$. $Q$ and $P^H$ are defined as products of elementary reflectors $H_i$ or $G_i$ respectively.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMBR / LA_UNMBR
Real and complex versions.


SUBROUTINE LA_ORMBR / LA_UNMBR( & 

VECT, SIDE, TRANS, M, N, K, A, LDA, &
TAU, C, LDC, WORK, LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: SIDE, &
TRANS, VECT
INTEGER, INTENT(IN) :: K, LDA, LDC, &
LWORK, M, N
INTEGER, INTENT(OUT) :: INFO
type(wp), INTENT(IN) :: A(LDA,*), TAU(*)
type(wp), INTENT(INOUT) :: C(LDA,*)
type(wp), INTENT(OUT) :: WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORMBR / LA_UNMBR overwrites the general real / complex $m \times n$ matrix $C$ with the products $Q C$, $C Q$, $Q^H C$, $C Q^H$, $P C$, $C P$, $Q^H C$ or $C Q^H$, respectively, where $Q$ and $P^H$ are the orthogonal / unitary matrices determined by LA_GEBRD when reducing a real / complex matrix $A$ to bidiagonal form: $A = Q B P^H$.
References: See  [1] and [9,20].
-----------------------------------

LA_BDSQR
Real and complex versions.


SUBROUTINE LA_BDSQR( UPLO, N, NCVT, & 

NRU, NCC, D, E, VT, LDVT, U, LDU, C, &
LDC, RWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: UPLO
INTEGER, INTENT(IN) :: LDC, LDU, LDVT, &
N, NCC, NCVT, NRU
INTEGER, INTENT(OUT) :: INFO
REAL(wp), INTENT(INOUT) :: D(*), E(*)
REAL(wp), INTENT(OUT) :: RWORK(*)
type(wp), INTENT(INOUT) :: C(LDC,*), &
U(LDU,*), VT(LDVT,*)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_BDSQR computes the singular value decomposition (SVD) of a real $n\times n$ (upper or lower) bidiagonal matrix $B$: $B = Q S P^H$ where $S$ is a diagonal matrix with non-negative diagonal elements (the singular values of $B$), and $Q$ and $P$ are orthogonal matrices.
References: See  [1] and [9,20,8,34].
-----------------------------------

LA_BDSDC
Real version.


SUBROUTINE LA_BDSDC( UPLO, COMPQ, N, & 

D, E, U, LDU, VT, LDVT, Q, IQ, WORK, &
IWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: &
COMPQ, UPLO
INTEGER, INTENT(IN) :: LDU, LDVT, N
INTEGER, INTENT(OUT) :: INFO, IQ( * ), &
IWORK( * )
REAL(wp), INTENT(INOUT) :: D( * ), E( * )
REAL(wp), INTENT(OUT) :: Q(*), U(LDU,*), &
VT(LDVT,*), WORK(*)
where
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_BDSDC computes the singular value decomposition (SVD) of a real $n\times n$ (upper or lower) bidiagonal matrix $B$: $B = U S VT$, using a divide and conquer method, where $S$ is a diagonal matrix with non-negative diagonal elements (the singular values of $B$), and $U$ and $VT$ are orthogonal matrices of left and right singular vectors, respectively. LA_BDSDC can be used to compute all singular values, and optionally, singular vectors or singular vectors in compact form.
References: See  [1] and [9,20].
-----------------------------------


next up previous contents index
Next: Computational Routines for the Up: Computational Routines Previous: Computational Routines for the   Contents   Index
Susan Blackford 2001-08-19