LAPACK 3.3.0

zqpt01.f

Go to the documentation of this file.
00001       DOUBLE PRECISION FUNCTION ZQPT01( M, N, K, A, AF, LDA, TAU, JPVT,
00002      $                 WORK, LWORK )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            K, LDA, LWORK, M, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            JPVT( * )
00013       COMPLEX*16         A( LDA, * ), AF( LDA, * ), TAU( * ),
00014      $                   WORK( LWORK )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  ZQPT01 tests the QR-factorization with pivoting of a matrix A.  The
00021 *  array AF contains the (possibly partial) QR-factorization of A, where
00022 *  the upper triangle of AF(1:k,1:k) is a partial triangular factor,
00023 *  the entries below the diagonal in the first k columns are the
00024 *  Householder vectors, and the rest of AF contains a partially updated
00025 *  matrix.
00026 *
00027 *  This function returns ||A*P - Q*R||/(||norm(A)||*eps*M)
00028 *
00029 *  Arguments
00030 *  =========
00031 *
00032 *  M       (input) INTEGER
00033 *          The number of rows of the matrices A and AF.
00034 *
00035 *  N       (input) INTEGER
00036 *          The number of columns of the matrices A and AF.
00037 *
00038 *  K       (input) INTEGER
00039 *          The number of columns of AF that have been reduced
00040 *          to upper triangular form.
00041 *
00042 *  A       (input) COMPLEX*16 array, dimension (LDA, N)
00043 *          The original matrix A.
00044 *
00045 *  AF      (input) COMPLEX*16 array, dimension (LDA,N)
00046 *          The (possibly partial) output of ZGEQPF.  The upper triangle
00047 *          of AF(1:k,1:k) is a partial triangular factor, the entries
00048 *          below the diagonal in the first k columns are the Householder
00049 *          vectors, and the rest of AF contains a partially updated
00050 *          matrix.
00051 *
00052 *  LDA     (input) INTEGER
00053 *          The leading dimension of the arrays A and AF.
00054 *
00055 *  TAU     (input) COMPLEX*16 array, dimension (K)
00056 *          Details of the Householder transformations as returned by
00057 *          ZGEQPF.
00058 *
00059 *  JPVT    (input) INTEGER array, dimension (N)
00060 *          Pivot information as returned by ZGEQPF.
00061 *
00062 *  WORK    (workspace) COMPLEX*16 array, dimension (LWORK)
00063 *
00064 *  LWORK   (input) INTEGER
00065 *          The length of the array WORK.  LWORK >= M*N+N.
00066 *
00067 *  =====================================================================
00068 *
00069 *     .. Parameters ..
00070       DOUBLE PRECISION   ZERO, ONE
00071       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00072 *     ..
00073 *     .. Local Scalars ..
00074       INTEGER            I, INFO, J
00075       DOUBLE PRECISION   NORMA
00076 *     ..
00077 *     .. Local Arrays ..
00078       DOUBLE PRECISION   RWORK( 1 )
00079 *     ..
00080 *     .. External Functions ..
00081       DOUBLE PRECISION   DLAMCH, ZLANGE
00082       EXTERNAL           DLAMCH, ZLANGE
00083 *     ..
00084 *     .. External Subroutines ..
00085       EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZUNMQR
00086 *     ..
00087 *     .. Intrinsic Functions ..
00088       INTRINSIC          DBLE, DCMPLX, MAX, MIN
00089 *     ..
00090 *     .. Executable Statements ..
00091 *
00092       ZQPT01 = ZERO
00093 *
00094 *     Test if there is enough workspace
00095 *
00096       IF( LWORK.LT.M*N+N ) THEN
00097          CALL XERBLA( 'ZQPT01', 10 )
00098          RETURN
00099       END IF
00100 *
00101 *     Quick return if possible
00102 *
00103       IF( M.LE.0 .OR. N.LE.0 )
00104      $   RETURN
00105 *
00106       NORMA = ZLANGE( 'One-norm', M, N, A, LDA, RWORK )
00107 *
00108       DO 30 J = 1, K
00109          DO 10 I = 1, MIN( J, M )
00110             WORK( ( J-1 )*M+I ) = AF( I, J )
00111    10    CONTINUE
00112          DO 20 I = J + 1, M
00113             WORK( ( J-1 )*M+I ) = ZERO
00114    20    CONTINUE
00115    30 CONTINUE
00116       DO 40 J = K + 1, N
00117          CALL ZCOPY( M, AF( 1, J ), 1, WORK( ( J-1 )*M+1 ), 1 )
00118    40 CONTINUE
00119 *
00120       CALL ZUNMQR( 'Left', 'No transpose', M, N, K, AF, LDA, TAU, WORK,
00121      $             M, WORK( M*N+1 ), LWORK-M*N, INFO )
00122 *
00123       DO 50 J = 1, N
00124 *
00125 *        Compare i-th column of QR and jpvt(i)-th column of A
00126 *
00127          CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, JPVT( J ) ), 1,
00128      $               WORK( ( J-1 )*M+1 ), 1 )
00129    50 CONTINUE
00130 *
00131       ZQPT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) /
00132      $         ( DBLE( MAX( M, N ) )*DLAMCH( 'Epsilon' ) )
00133       IF( NORMA.NE.ZERO )
00134      $   ZQPT01 = ZQPT01 / NORMA
00135 *
00136       RETURN
00137 *
00138 *     End of ZQPT01
00139 *
00140       END
 All Files Functions