LAPACK 3.3.1
Linear Algebra PACKage
|
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