|
version 1.6, 2016/08/27 15:34:41
|
version 1.7, 2017/06/17 10:54:06
|
|
Line 2
|
Line 2
|
| * |
* |
| * =========== 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 September 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.2) -- |
* -- 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..-- |
| * September 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 |
| * |
* |
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dtpqrt2.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack