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


Computational Routines for Orthogonal Factorizations

LA_GEQP3
Real version.


SUBROUTINE LA_GEQP3( M, N, A, LDA, & 

JPVT, TAU, WORK, LWORK, INFO )
INTEGER, INTENT(IN) :: LDA, LWORK, M, N
INTEGER, INTENT(OUT) :: INFO
INTEGER, INTENT(INOUT) :: JPVT( * )
REAL(wp), INTENT(INOUT) :: A( LDA, * )
REAL(wp), INTENT(OUT) :: TAU( * ), &
WORK(LWORK)
where
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


Complex version.


 SUBROUTINE LA_GEQP3( M, N, A, LDA, & 

JPVT, TAU, WORK, LWORK, RWORK, INFO )
INTEGER, INTENT(IN) :: LDA, LWORK, M, N
INTEGER, INTENT(OUT) :: INFO
INTEGER, INTENT(INOUT) :: JPVT( * )
COMPLEX(wp), INTENT(INOUT) :: A( LDA, * )
COMPLEX(wp), INTENT(OUT) :: TAU( * ), &
WORK(LWORK)
REAL(wp), INTENT(OUT) :: RWORK( * )
where
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_GEQP3 computes a $QR$ factorization with column pivoting of a matrix $A$: $A P = Q R$ using Level 3 BLAS.
References: See  [1] and [9,20,36].
-----------------------------------

LA_GEQRF
Real and complex versions.


SUBROUTINE LA_GEQRF( M, N, A, LDA, TAU, & 

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


LA_GEQRF computes a $QR$ factorization of a real / complex $m \times n$ matrix $A$.
References: See  [1, pages 31, 33, 35, 45, 63, 147, 158, 160, 161, 188, 234] and [9,20].
-----------------------------------

LA_ORGQR / LA_UNGQR
Real and complex versions.


SUBROUTINE LA_ORGQR / LA_UNGQR( M, N, & 

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


LA_ORGQR / LA_UNGQR generate an $m \times n$ real / complex matrix $Q$ with orthonormal columns, which is defined as the first $n$ columns of a product of $k$ elementary reflectors of order $m$ as returned by LA_GEQRF.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMQR / LA_UNMQR
Real and complex versions.


SUBROUTINE LA_ORMQR / LA_UNMQR(  & 

SIDE, TRANS, M, N, K, A, LDA, TAU, C, &
LDC, WORK, LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: SIDE, &
TRANS
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(LDC,*)
type(wp), INTENT(OUT) :: WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORMQR / LA_UNMQR overwrite the general real / complex $m \times n$ matrix C with $Q C$, $C Q$, $Q^H C$ or $C Q^H$ (respectively) where $Q$ is real orthogonal / complex unitary matrix defined as the product of $k$ elementary reflectors as returned by LA_GEQRF.
References: See  [1] and [9,20].
-----------------------------------

LA_GELQF
Real and complex versions.


SUBROUTINE LA_GELQF( M, N, A, LDA, TAU, & 

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


LA_GELQF computes an $LQ$ factorization of a real / complex $m \times n$ $A$: $A = L Q$.
References: See  [1] and [9,20].
-----------------------------------

LA_ORGLQ / LA_UNGLQ
Real and complex versions.


SUBROUTINE LA_ORGLQ / LA_UNGLQ( M, & 

N, K, A, LDA, TAU, WORK, LWORK, INFO )
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_ORGLQ / LA_UNGLQ generates an $m \times n$ a real / complex matrix $Q$ with orthonormal rows, which is defined as the first $m$ rows of a product of $k$ elementary reflectors of order $n$ as returned by LA_GELQF.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMLQ / LA_UNMLQ
Real and complex versions.


SUBROUTINE LA_ORMLQ / LA_UNMLQ( SIDE, & 

TRANS, M, N, K, A, LDA, TAU, C, LDC, &
WORK, LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: SIDE, &
TRANS
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(LDC,*)
type(wp), INTENT(OUT) :: WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORMLQ / LA_UNMLQ overwrite the general real / complex $m \times n$ matrix $C$ with $Q C$, $C Q$, $Q^H C$ or $C Q^H$ (respectively) where $Q$ is a real orthogonal / complex unitary matrix defined as the product of $k$ elementary reflectors as returned by LA_GELQF.
References: See  [1] and [9,20].
-----------------------------------

LA_GEQLF
Real and complex versions.


SUBROUTINE LA_GEQLF( M, N, A, LDA, TAU, & 

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


LA_GEQLF computes a $QL$ factorization of a real / complex $m \times n$ matrix $A$: $A = Q L$.
References: See  [1] and [9,20].
-----------------------------------

LA_ORGQL / LA_UNGQL
Real and complex versions.


SUBROUTINE LA_ORGQL / LA_UNGQL( M, N, & 

K, A, LDA, TAU, WORK, LWORK, INFO )
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_ORGQL / LA_UNGQL generate an $m \times n$ real / complex matrix Q with orthonormal columns, which is defined as the last $n$ columns of a product of $k$ elementary reflectors of order $m$ as returned by LA_GEQLF.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMQL / LA_UNMQL
Real and complex versions.


SUBROUTINE LA_ORMQL / LA_UNMQL( SIDE, & 

TRANS, M, N, K, A, LDA, TAU, C, LDC, &
WORK, LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: SIDE, &
TRANS
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(LDC,*)
type(wp), INTENT(OUT) :: &
WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORMQL / LA_UNMQL overwrites the general real / complex $\times n$ matrix $C$ with $Q C$, $C Q$, $Q^T C$ and $C Q^T$ (respectively) where $Q$ is a real orthogonal / complex unitary matrix defined as the product of $k$ as returned by LA_GEQLF.
References: See  [1] and [9,20].
-----------------------------------

LA_GERQF
Real and complex versions.


SUBROUTINE LA_GERQF( M, N, A, LDA, TAU, & 

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


LA_GERQF computes an $RQ$ factorization of a real / complex $m \times n$ matrix $A$: $A = R Q$.
References: See  [1] and [9,20].
-----------------------------------

LA_ORGRQ / LA_UNGRQ
Real and complex versions.


SUBROUTINE LA_ORGRQ / LA_UNGRQ( M, & 

N, K, A, LDA, TAU, WORK, LWORK, INFO )
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_ORGRQ / LA_UNGRQ generates an $m \times n$ real / complex matrix $Q$ with orthonormal rows, which is defined as the last $m$ rows of a product of $k$ elementary reflectors of order $n$ as returned by LA_GERQF.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMRQ / LA_UNMRQ
Real and complex versions.


SUBROUTINE LA_ORMRQ / LA_UNMRQ( SIDE, & 

TRANS, M, N, K, A, LDA, TAU, C, LDC, &
WORK, LWORK, INFO )
CHARACTER(LEN=1), INTENT(IN) :: SIDE, &
TRANS
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(LDC,*)
type(wp), INTENT(OUT) :: &
WORK(LWORK)
where
type ::= REAL $\mid$ COMPLEX
wp ::= KIND(1.0) $\mid$ KIND(1.0D0)


LA_ORMRQ / LA_UNMRQ overwrites the general real / complex $m \times n$ matrix $C$ with $Q C$, $C Q$, $Q^H C$ and $C Q^H$ (respectively), where $Q$ is a real orthogonal / complex unitary matrix defined as the product of $k$ elementary reflectors as returned by LA_GERQF.
References: See  [1] and [9,20].
-----------------------------------

LA_TZRZF
Real and complex versions.


SUBROUTINE LA_TZRZF( M, N, A, LDA, & 

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


LA_TZRZF reduces the $m \times n$ ( $m \leq n$ ) real / complex upper trapezoidal matrix $A$ to upper triangular form by means of real orthogonal / unitary transformations.
References: See  [1] and [9,20].
-----------------------------------

LA_ORMRZ / LA_UNMRZ
Real and complex versions.


SUBROUTINE LA_ORMRZ / LA_UNMRZ( SIDE, & 

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


LA_ORMRZ / LA_UNMRZ overwrites the general real / complex $m \times n$ $C$ with $Q C$, $C Q$, $Q^H C$ or $C Q^H$ (respectively) where $Q$ is a real orthogonal / complex unitary matrix defined as the product of $k$ elementary reflectors as returned by LA_TZRZF.
References: See  [1] and [9,20].
-----------------------------------


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