LAPACK 3.3.0

zqrt11.f

Go to the documentation of this file.
00001       DOUBLE PRECISION FUNCTION ZQRT11( M, K, A, LDA, TAU, WORK, LWORK )
00002 *
00003 *  -- LAPACK routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            K, LDA, LWORK, M
00009 *     ..
00010 *     .. Array Arguments ..
00011       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
00012 *     ..
00013 *
00014 *  Purpose
00015 *  =======
00016 *
00017 *  ZQRT11 computes the test ratio
00018 *
00019 *        || Q'*Q - I || / (eps * m)
00020 *
00021 *  where the orthogonal matrix Q is represented as a product of
00022 *  elementary transformations.  Each transformation has the form
00023 *
00024 *     H(k) = I - tau(k) v(k) v(k)'
00025 *
00026 *  where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form
00027 *  [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored
00028 *  in A(k+1:m,k).
00029 *
00030 *  Arguments
00031 *  =========
00032 *
00033 *  M       (input) INTEGER
00034 *          The number of rows of the matrix A.
00035 *
00036 *  K       (input) INTEGER
00037 *          The number of columns of A whose subdiagonal entries
00038 *          contain information about orthogonal transformations.
00039 *
00040 *  A       (input) COMPLEX*16 array, dimension (LDA,K)
00041 *          The (possibly partial) output of a QR reduction routine.
00042 *
00043 *  LDA     (input) INTEGER
00044 *          The leading dimension of the array A.
00045 *
00046 *  TAU     (input) COMPLEX*16 array, dimension (K)
00047 *          The scaling factors tau for the elementary transformations as
00048 *          computed by the QR factorization routine.
00049 *
00050 *  WORK    (workspace) COMPLEX*16 array, dimension (LWORK)
00051 *
00052 *  LWORK   (input) INTEGER
00053 *          The length of the array WORK.  LWORK >= M*M + M.
00054 *
00055 *  =====================================================================
00056 *
00057 *     .. Parameters ..
00058       DOUBLE PRECISION   ZERO, ONE
00059       PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
00060 *     ..
00061 *     .. Local Scalars ..
00062       INTEGER            INFO, J
00063 *     ..
00064 *     .. External Functions ..
00065       DOUBLE PRECISION   DLAMCH, ZLANGE
00066       EXTERNAL           DLAMCH, ZLANGE
00067 *     ..
00068 *     .. External Subroutines ..
00069       EXTERNAL           XERBLA, ZLASET, ZUNM2R
00070 *     ..
00071 *     .. Intrinsic Functions ..
00072       INTRINSIC          DBLE, DCMPLX
00073 *     ..
00074 *     .. Local Arrays ..
00075       DOUBLE PRECISION   RDUMMY( 1 )
00076 *     ..
00077 *     .. Executable Statements ..
00078 *
00079       ZQRT11 = ZERO
00080 *
00081 *     Test for sufficient workspace
00082 *
00083       IF( LWORK.LT.M*M+M ) THEN
00084          CALL XERBLA( 'ZQRT11', 7 )
00085          RETURN
00086       END IF
00087 *
00088 *     Quick return if possible
00089 *
00090       IF( M.LE.0 )
00091      $   RETURN
00092 *
00093       CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ONE ), WORK,
00094      $             M )
00095 *
00096 *     Form Q
00097 *
00098       CALL ZUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
00099      $             M, WORK( M*M+1 ), INFO )
00100 *
00101 *     Form Q'*Q
00102 *
00103       CALL ZUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU,
00104      $             WORK, M, WORK( M*M+1 ), INFO )
00105 *
00106       DO 10 J = 1, M
00107          WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
00108    10 CONTINUE
00109 *
00110       ZQRT11 = ZLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
00111      $         ( DBLE( M )*DLAMCH( 'Epsilon' ) )
00112 *
00113       RETURN
00114 *
00115 *     End of ZQRT11
00116 *
00117       END
 All Files Functions