summaryrefslogtreecommitdiff
path: root/SRC/ztpqrt.f
diff options
context:
space:
mode:
authorjulie <julielangou@users.noreply.github.com>2011-10-06 06:53:11 +0000
committerjulie <julielangou@users.noreply.github.com>2011-10-06 06:53:11 +0000
commite1d39294aee16fa6db9ba079b14442358217db71 (patch)
tree30e5aa04c1f6596991fda5334f63dfb9b8027849 /SRC/ztpqrt.f
parent5fe0466a14e395641f4f8a300ecc9dcb8058081b (diff)
downloadlapack-e1d39294aee16fa6db9ba079b14442358217db71.tar.gz
lapack-e1d39294aee16fa6db9ba079b14442358217db71.tar.bz2
lapack-e1d39294aee16fa6db9ba079b14442358217db71.zip
Integrating Doxygen in comments
Diffstat (limited to 'SRC/ztpqrt.f')
-rw-r--r--SRC/ztpqrt.f243
1 files changed, 145 insertions, 98 deletions
diff --git a/SRC/ztpqrt.f b/SRC/ztpqrt.f
index d0570407..25d987b3 100644
--- a/SRC/ztpqrt.f
+++ b/SRC/ztpqrt.f
@@ -1,120 +1,167 @@
- SUBROUTINE ZTPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
- $ INFO )
- IMPLICIT NONE
+*> \brief \b ZTPQRT
*
-* -- LAPACK routine (version 3.?) --
-* -- LAPACK is a software package provided by Univ. of Tennessee, --
-* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* -- July 2011 --
+* =========== DOCUMENTATION ===========
*
-* .. Scalar Arguments ..
- INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
-* ..
-* .. Array Arguments ..
- COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
-* ..
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+* Definition
+* ==========
*
+* SUBROUTINE ZTPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
+* INFO )
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
+* ..
+* .. Array Arguments ..
+* COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+* ..
+*
* Purpose
* =======
*
-* ZTPQRT computes a blocked QR factorization of a complex
-* "triangular-pentagonal" matrix C, which is composed of a
-* triangular block A and pentagonal block B, using the compact
-* WY representation for Q.
+*>\details \b Purpose:
+*>\verbatim
+*>
+*> ZTPQRT computes a blocked QR factorization of a complex
+*> "triangular-pentagonal" matrix C, which is composed of a
+*> triangular block A and pentagonal block B, using the compact
+*> WY representation for Q.
+*>
+*>\endverbatim
*
* Arguments
* =========
*
-* M (input) INTEGER
-* The number of rows of the matrix B.
-* M >= 0.
-*
-* N (input) INTEGER
-* The number of columns of the matrix B, and the order of the
-* triangular matrix A.
-* N >= 0.
-*
-* L (input) INTEGER
-* The number of rows of the upper trapezoidal part of B.
-* MIN(M,N) >= L >= 0. See Further Details.
-*
-* NB (input) INTEGER
-* The block size to be used in the blocked QR. N >= NB >= 1.
-*
-* A (input/output) COMPLEX*16 array, dimension (LDA,N)
-* On entry, the upper triangular N-by-N matrix A.
-* On exit, the elements on and above the diagonal of the array
-* contain the upper triangular matrix R.
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max(1,N).
-*
-* B (input/output) COMPLEX*16 array, dimension (LDB,N)
-* On entry, the pentagonal M-by-N matrix B. The first M-L rows
-* are rectangular, and the last L rows are upper trapezoidal.
-* On exit, B contains the pentagonal matrix V. See Further Details.
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix B.
+*> M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix B, and the order of the
+*> triangular matrix A.
+*> N >= 0.
+*> \endverbatim
+*>
+*
+* Authors
+* =======
*
-* LDB (input) INTEGER
-* The leading dimension of the array B. LDB >= max(1,M).
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
-* T (output) COMPLEX*16 array, dimension (LDT,N)
-* The upper triangular block reflectors stored in compact form
-* as a sequence of upper triangular blocks. See Further Details.
-*
-* LDT (input) INTEGER
-* The leading dimension of the array T. LDT >= NB.
+*> \date November 2011
*
-* WORK (workspace) COMPLEX*16 array, dimension (NB*N)
+*> \ingroup complex16OTHERcomputational
*
-* INFO (output) INTEGER
-* = 0: successful exit
-* < 0: if INFO = -i, the i-th argument had an illegal value
*
* Further Details
* ===============
-*
-* The input matrix C is a (N+M)-by-N matrix
-*
-* C = [ A ]
-* [ B ]
-*
-* 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
-* upper trapezoidal matrix B2:
-*
-* B = [ B1 ] <- (M-L)-by-N rectangular
-* [ B2 ] <- L-by-N upper trapezoidal.
-*
-* 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,
-* 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
-* below the diagonal (of A) in the (N+M)-by-N input matrix C
-*
-* C = [ A ] <- upper triangular N-by-N
-* [ B ] <- M-by-N pentagonal
-*
-* so that W can be represented as
-*
-* W = [ I ] <- identity, N-by-N
-* [ V ] <- M-by-N, same form as B.
-*
-* 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,
-*
-* V = [ V1 ] <- (M-L)-by-N rectangular
-* [ V2 ] <- L-by-N upper trapezoidal.
-*
-* The columns of V represent the vectors which define the H(i)'s.
+*>\details \b Further \b Details
+*> \verbatim
+* MIN(M,N) >= L >= 0. See Further Details.
+*>
+*> NB (input) INTEGER
+*> The block size to be used in the blocked QR. N >= NB >= 1.
+*>
+*> A (input/output) COMPLEX*16 array, dimension (LDA,N)
+*> On entry, the upper triangular N-by-N matrix A.
+*> On exit, the elements on and above the diagonal of the array
+*> contain the upper triangular matrix R.
+*>
+*> LDA (input) INTEGER
+*> The leading dimension of the array A. LDA >= max(1,N).
+*>
+*> B (input/output) COMPLEX*16 array, dimension (LDB,N)
+*> On entry, the pentagonal M-by-N matrix B. The first M-L rows
+*> are rectangular, and the last L rows are upper trapezoidal.
+*> On exit, B contains the pentagonal matrix V. See Further Details.
+*>
+*> LDB (input) INTEGER
+*> The leading dimension of the array B. LDB >= max(1,M).
+*>
+*> T (output) COMPLEX*16 array, dimension (LDT,N)
+*> The upper triangular block reflectors stored in compact form
+*> as a sequence of upper triangular blocks. See Further Details.
+*>
+*> LDT (input) INTEGER
+*> The leading dimension of the array T. LDT >= NB.
+*>
+*> WORK (workspace) COMPLEX*16 array, dimension (NB*N)
+*>
+*> INFO (output) INTEGER
+*> = 0: successful exit
+*> < 0: if INFO = -i, the i-th argument had an illegal value
+*>
+*>
+*> The input matrix C is a (N+M)-by-N matrix
+*>
+*> C = [ A ]
+*> [ B ]
+*>
+*> 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
+*> upper trapezoidal matrix B2:
+*>
+*> B = [ B1 ] <- (M-L)-by-N rectangular
+*> [ B2 ] <- L-by-N upper trapezoidal.
+*>
+*> 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,
+*> 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
+*> below the diagonal (of A) in the (N+M)-by-N input matrix C
+*>
+*> C = [ A ] <- upper triangular N-by-N
+*> [ B ] <- M-by-N pentagonal
+*>
+*> so that W can be represented as
+*>
+*> W = [ I ] <- identity, N-by-N
+*> [ V ] <- M-by-N, same form as B.
+*>
+*> 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,
+*>
+*> V = [ V1 ] <- (M-L)-by-N rectangular
+*> [ V2 ] <- L-by-N upper trapezoidal.
+*>
+*> The columns of V represent the vectors which define the H(i)'s.
+*>
+*> The number of blocks is B = ceiling(N/NB), where each
+*> block is of order NB except for the last block, which is of order
+*> IB = N - (B-1)*NB. For each of the B blocks, a upper triangular block
+*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
+*> for the last block) T's are stored in the NB-by-N matrix T as
+*>
+*> T = [T1 T2 ... TB].
+*>
+*> \endverbatim
+*>
+* =====================================================================
+ SUBROUTINE ZTPQRT( M, N, L, NB, A, LDA, B, LDB, T, LDT, WORK,
+ $ INFO )
*
-* The number of blocks is B = ceiling(N/NB), where each
-* block is of order NB except for the last block, which is of order
-* IB = N - (B-1)*NB. For each of the B blocks, a upper triangular block
-* reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB
-* for the last block) T's are stored in the NB-by-N matrix T as
+* -- LAPACK computational routine (version 3.?) --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+* November 2011
*
-* T = [T1 T2 ... TB].
+* .. Scalar Arguments ..
+ INTEGER INFO, LDA, LDB, LDT, N, M, L, NB
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+* ..
*
* =====================================================================
*