version 1.2, 2012/08/22 09:48:27
|
version 1.9, 2018/05/29 07:18:11
|
Line 1
|
Line 1
|
*> \brief \b DTPQRT2 |
*> \brief \b DTPQRT2 computes a QR factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q. |
* |
* |
* =========== DOCUMENTATION =========== |
* =========== DOCUMENTATION =========== |
* |
* |
* Online html documentation available at |
* Online html documentation available at |
* http://www.netlib.org/lapack/explore-html/ |
* http://www.netlib.org/lapack/explore-html/ |
* |
* |
*> \htmlonly |
*> \htmlonly |
*> Download DTPQRT2 + dependencies |
*> Download DTPQRT2 + dependencies |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> [TGZ]</a> |
*> [TGZ]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> [ZIP]</a> |
*> [ZIP]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpqrt2.f"> |
*> [TXT]</a> |
*> [TXT]</a> |
*> \endhtmlonly |
*> \endhtmlonly |
* |
* |
* Definition: |
* Definition: |
* =========== |
* =========== |
* |
* |
* SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) |
* SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
* INTEGER INFO, LDA, LDB, LDT, N, M, L |
* INTEGER INFO, LDA, LDB, LDT, N, M, L |
* .. |
* .. |
* .. Array Arguments .. |
* .. Array Arguments .. |
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ) |
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ) |
* .. |
* .. |
* |
* |
* |
* |
*> \par Purpose: |
*> \par Purpose: |
* ============= |
* ============= |
Line 34
|
Line 34
|
*> \verbatim |
*> \verbatim |
*> |
*> |
*> DTPQRT2 computes a QR factorization of a real "triangular-pentagonal" |
*> DTPQRT2 computes a QR factorization of a real "triangular-pentagonal" |
*> matrix C, which is composed of a triangular block A and pentagonal block B, |
*> matrix C, which is composed of a triangular block A and pentagonal block B, |
*> using the compact WY representation for Q. |
*> using the compact WY representation for Q. |
*> \endverbatim |
*> \endverbatim |
* |
* |
Line 44
|
Line 44
|
*> \param[in] M |
*> \param[in] M |
*> \verbatim |
*> \verbatim |
*> M is INTEGER |
*> M is INTEGER |
*> The total number of rows of the matrix B. |
*> The total number of rows of the matrix B. |
*> M >= 0. |
*> M >= 0. |
*> \endverbatim |
*> \endverbatim |
*> |
*> |
Line 59
|
Line 59
|
*> \param[in] L |
*> \param[in] L |
*> \verbatim |
*> \verbatim |
*> L is INTEGER |
*> L is INTEGER |
*> The number of rows of the upper trapezoidal part of B. |
*> The number of rows of the upper trapezoidal part of B. |
*> MIN(M,N) >= L >= 0. See Further Details. |
*> MIN(M,N) >= L >= 0. See Further Details. |
*> \endverbatim |
*> \endverbatim |
*> |
*> |
Line 80
|
Line 80
|
*> \param[in,out] B |
*> \param[in,out] B |
*> \verbatim |
*> \verbatim |
*> B is DOUBLE PRECISION array, dimension (LDB,N) |
*> B is DOUBLE PRECISION array, dimension (LDB,N) |
*> On entry, the pentagonal M-by-N matrix B. The first M-L rows |
*> On entry, the pentagonal M-by-N matrix B. The first M-L rows |
*> are rectangular, and the last L rows are upper trapezoidal. |
*> are rectangular, and the last L rows are upper trapezoidal. |
*> On exit, B contains the pentagonal matrix V. See Further Details. |
*> On exit, B contains the pentagonal matrix V. See Further Details. |
*> \endverbatim |
*> \endverbatim |
Line 114
|
Line 114
|
* Authors: |
* Authors: |
* ======== |
* ======== |
* |
* |
*> \author Univ. of Tennessee |
*> \author Univ. of Tennessee |
*> \author Univ. of California Berkeley |
*> \author Univ. of California Berkeley |
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date April 2012 |
*> \date December 2016 |
* |
* |
*> \ingroup doubleOTHERcomputational |
*> \ingroup doubleOTHERcomputational |
* |
* |
Line 128
|
Line 128
|
*> |
*> |
*> \verbatim |
*> \verbatim |
*> |
*> |
*> The input matrix C is a (N+M)-by-N matrix |
*> The input matrix C is a (N+M)-by-N matrix |
*> |
*> |
*> C = [ A ] |
*> C = [ A ] |
*> [ B ] |
*> [ B ] |
*> |
*> |
*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal |
*> where A is an upper triangular N-by-N matrix, and B is M-by-N pentagonal |
*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N |
*> matrix consisting of a (M-L)-by-N rectangular matrix B1 on top of a L-by-N |
Line 141
|
Line 141
|
*> [ B2 ] <- L-by-N upper trapezoidal. |
*> [ B2 ] <- L-by-N upper trapezoidal. |
*> |
*> |
*> The upper trapezoidal matrix B2 consists of the first L rows of a |
*> The upper trapezoidal matrix B2 consists of the first L rows of a |
*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0, |
*> N-by-N upper triangular matrix, where 0 <= L <= MIN(M,N). If L=0, |
*> B is rectangular M-by-N; if M=L=N, B is upper triangular. |
*> B is rectangular M-by-N; if M=L=N, B is upper triangular. |
*> |
*> |
*> The matrix W stores the elementary reflectors H(i) in the i-th column |
*> The matrix W stores the elementary reflectors H(i) in the i-th column |
*> below the diagonal (of A) in the (N+M)-by-N input matrix C |
*> below the diagonal (of A) in the (N+M)-by-N input matrix C |
Line 156
|
Line 156
|
*> [ V ] <- M-by-N, same form as B. |
*> [ V ] <- M-by-N, same form as B. |
*> |
*> |
*> Thus, all of information needed for W is contained on exit in B, which |
*> Thus, all of information needed for W is contained on exit in B, which |
*> we call V above. Note that V has the same form as B; that is, |
*> we call V above. Note that V has the same form as B; that is, |
*> |
*> |
*> V = [ V1 ] <- (M-L)-by-N rectangular |
*> V = [ V1 ] <- (M-L)-by-N rectangular |
*> [ V2 ] <- L-by-N upper trapezoidal. |
*> [ V2 ] <- L-by-N upper trapezoidal. |
*> |
*> |
*> The columns of V represent the vectors which define the H(i)'s. |
*> The columns of V represent the vectors which define the H(i)'s. |
*> The (M+N)-by-(M+N) block reflector H is then given by |
*> The (M+N)-by-(M+N) block reflector H is then given by |
*> |
*> |
*> H = I - W * T * W**T |
*> H = I - W * T * W**T |
Line 173
|
Line 173
|
* ===================================================================== |
* ===================================================================== |
SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) |
SUBROUTINE DTPQRT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) |
* |
* |
* -- LAPACK computational routine (version 3.4.1) -- |
* -- LAPACK computational routine (version 3.7.0) -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* April 2012 |
* December 2016 |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
INTEGER INFO, LDA, LDB, LDT, N, M, L |
INTEGER INFO, LDA, LDB, LDT, N, M, L |
Line 227
|
Line 227
|
* Quick return if possible |
* Quick return if possible |
* |
* |
IF( N.EQ.0 .OR. M.EQ.0 ) RETURN |
IF( N.EQ.0 .OR. M.EQ.0 ) RETURN |
* |
* |
DO I = 1, N |
DO I = 1, N |
* |
* |
* Generate elementary reflector H(I) to annihilate B(:,I) |
* Generate elementary reflector H(I) to annihilate B(:,I) |
Line 241
|
Line 241
|
DO J = 1, N-I |
DO J = 1, N-I |
T( J, N ) = (A( I, I+J )) |
T( J, N ) = (A( I, I+J )) |
END DO |
END DO |
CALL DGEMV( 'T', P, N-I, ONE, B( 1, I+1 ), LDB, |
CALL DGEMV( 'T', P, N-I, ONE, B( 1, I+1 ), LDB, |
$ B( 1, I ), 1, ONE, T( 1, N ), 1 ) |
$ B( 1, I ), 1, ONE, T( 1, N ), 1 ) |
* |
* |
* C(I:M,I+1:N) = C(I:m,I+1:N) + alpha*C(I:M,I)*W(1:N-1)^H |
* C(I:M,I+1:N) = C(I:m,I+1:N) + alpha*C(I:M,I)*W(1:N-1)^H |
* |
* |
ALPHA = -(T( I, 1 )) |
ALPHA = -(T( I, 1 )) |
DO J = 1, N-I |
DO J = 1, N-I |
A( I, I+J ) = A( I, I+J ) + ALPHA*(T( J, N )) |
A( I, I+J ) = A( I, I+J ) + ALPHA*(T( J, N )) |
END DO |
END DO |
CALL DGER( P, N-I, ALPHA, B( 1, I ), 1, |
CALL DGER( P, N-I, ALPHA, B( 1, I ), 1, |
$ T( 1, N ), 1, B( 1, I+1 ), LDB ) |
$ T( 1, N ), 1, B( 1, I+1 ), LDB ) |
END IF |
END IF |
END DO |
END DO |
Line 278
|
Line 278
|
* |
* |
* Rectangular part of B2 |
* Rectangular part of B2 |
* |
* |
CALL DGEMV( 'T', L, I-1-P, ALPHA, B( MP, NP ), LDB, |
CALL DGEMV( 'T', L, I-1-P, ALPHA, B( MP, NP ), LDB, |
$ B( MP, I ), 1, ZERO, T( NP, I ), 1 ) |
$ B( MP, I ), 1, ZERO, T( NP, I ), 1 ) |
* |
* |
* B1 |
* B1 |
* |
* |
CALL DGEMV( 'T', M-L, I-1, ALPHA, B, LDB, B( 1, I ), 1, |
CALL DGEMV( 'T', M-L, I-1, ALPHA, B, LDB, B( 1, I ), 1, |
$ ONE, T( 1, I ), 1 ) |
$ ONE, T( 1, I ), 1 ) |
* |
* |
* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I) |
* T(1:I-1,I) := T(1:I-1,1:I-1) * T(1:I-1,I) |
* |
* |
Line 295
|
Line 295
|
T( I, I ) = T( I, 1 ) |
T( I, I ) = T( I, 1 ) |
T( I, 1 ) = ZERO |
T( I, 1 ) = ZERO |
END DO |
END DO |
|
|
* |
* |
* End of DTPQRT2 |
* End of DTPQRT2 |
* |
* |