LAPACK 3.3.0

cqrt11.f

Go to the documentation of this file.
00001       REAL             FUNCTION CQRT11( 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            A( LDA, * ), TAU( * ), WORK( LWORK )
00012 *     ..
00013 *
00014 *  Purpose
00015 *  =======
00016 *
00017 *  CQRT11 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 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 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 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       REAL               ZERO, ONE
00059       PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
00060 *     ..
00061 *     .. Local Scalars ..
00062       INTEGER            INFO, J
00063 *     ..
00064 *     .. External Functions ..
00065       REAL               CLANGE, SLAMCH
00066       EXTERNAL           CLANGE, SLAMCH
00067 *     ..
00068 *     .. External Subroutines ..
00069       EXTERNAL           CLASET, CUNM2R, XERBLA
00070 *     ..
00071 *     .. Intrinsic Functions ..
00072       INTRINSIC          CMPLX, REAL
00073 *     ..
00074 *     .. Local Arrays ..
00075       REAL               RDUMMY( 1 )
00076 *     ..
00077 *     .. Executable Statements ..
00078 *
00079       CQRT11 = ZERO
00080 *
00081 *     Test for sufficient workspace
00082 *
00083       IF( LWORK.LT.M*M+M ) THEN
00084          CALL XERBLA( 'CQRT11', 7 )
00085          RETURN
00086       END IF
00087 *
00088 *     Quick return if possible
00089 *
00090       IF( M.LE.0 )
00091      $   RETURN
00092 *
00093       CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), WORK, M )
00094 *
00095 *     Form Q
00096 *
00097       CALL CUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
00098      $             M, WORK( M*M+1 ), INFO )
00099 *
00100 *     Form Q'*Q
00101 *
00102       CALL CUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU,
00103      $             WORK, M, WORK( M*M+1 ), INFO )
00104 *
00105       DO 10 J = 1, M
00106          WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
00107    10 CONTINUE
00108 *
00109       CQRT11 = CLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
00110      $         ( REAL( M )*SLAMCH( 'Epsilon' ) )
00111 *
00112       RETURN
00113 *
00114 *     End of CQRT11
00115 *
00116       END
 All Files Functions