![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DTZT02 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * DOUBLE PRECISION FUNCTION DTZT02( M, N, AF, LDA, TAU, WORK, 00012 * LWORK ) 00013 * 00014 * .. Scalar Arguments .. 00015 * INTEGER LDA, LWORK, M, N 00016 * .. 00017 * .. Array Arguments .. 00018 * DOUBLE PRECISION AF( LDA, * ), TAU( * ), WORK( LWORK ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> DTZT02 returns 00028 *> || I - Q'*Q || / ( M * eps) 00029 *> where the matrix Q is defined by the Householder transformations 00030 *> generated by DTZRQF. 00031 *> \endverbatim 00032 * 00033 * Arguments: 00034 * ========== 00035 * 00036 *> \param[in] M 00037 *> \verbatim 00038 *> M is INTEGER 00039 *> The number of rows of the matrix AF. 00040 *> \endverbatim 00041 *> 00042 *> \param[in] N 00043 *> \verbatim 00044 *> N is INTEGER 00045 *> The number of columns of the matrix AF. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] AF 00049 *> \verbatim 00050 *> AF is DOUBLE PRECISION array, dimension (LDA,N) 00051 *> The output of DTZRQF. 00052 *> \endverbatim 00053 *> 00054 *> \param[in] LDA 00055 *> \verbatim 00056 *> LDA is INTEGER 00057 *> The leading dimension of the array AF. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] TAU 00061 *> \verbatim 00062 *> TAU is DOUBLE PRECISION array, dimension (M) 00063 *> Details of the Householder transformations as returned by 00064 *> DTZRQF. 00065 *> \endverbatim 00066 *> 00067 *> \param[out] WORK 00068 *> \verbatim 00069 *> WORK is DOUBLE PRECISION array, dimension (LWORK) 00070 *> \endverbatim 00071 *> 00072 *> \param[in] LWORK 00073 *> \verbatim 00074 *> LWORK is INTEGER 00075 *> length of WORK array. Must be >= N*N+N 00076 *> \endverbatim 00077 * 00078 * Authors: 00079 * ======== 00080 * 00081 *> \author Univ. of Tennessee 00082 *> \author Univ. of California Berkeley 00083 *> \author Univ. of Colorado Denver 00084 *> \author NAG Ltd. 00085 * 00086 *> \date November 2011 00087 * 00088 *> \ingroup double_lin 00089 * 00090 * ===================================================================== 00091 DOUBLE PRECISION FUNCTION DTZT02( M, N, AF, LDA, TAU, WORK, 00092 $ LWORK ) 00093 * 00094 * -- LAPACK test routine (version 3.4.0) -- 00095 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00096 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00097 * November 2011 00098 * 00099 * .. Scalar Arguments .. 00100 INTEGER LDA, LWORK, M, N 00101 * .. 00102 * .. Array Arguments .. 00103 DOUBLE PRECISION AF( LDA, * ), TAU( * ), WORK( LWORK ) 00104 * .. 00105 * 00106 * ===================================================================== 00107 * 00108 * .. Parameters .. 00109 DOUBLE PRECISION ZERO, ONE 00110 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00111 * .. 00112 * .. Local Scalars .. 00113 INTEGER I 00114 * .. 00115 * .. Local Arrays .. 00116 DOUBLE PRECISION RWORK( 1 ) 00117 * .. 00118 * .. External Functions .. 00119 DOUBLE PRECISION DLAMCH, DLANGE 00120 EXTERNAL DLAMCH, DLANGE 00121 * .. 00122 * .. External Subroutines .. 00123 EXTERNAL DLASET, DLATZM, XERBLA 00124 * .. 00125 * .. Intrinsic Functions .. 00126 INTRINSIC DBLE, MAX 00127 * .. 00128 * .. Executable Statements .. 00129 * 00130 DTZT02 = ZERO 00131 * 00132 IF( LWORK.LT.N*N+N ) THEN 00133 CALL XERBLA( 'DTZT02', 7 ) 00134 RETURN 00135 END IF 00136 * 00137 * Quick return if possible 00138 * 00139 IF( M.LE.0 .OR. N.LE.0 ) 00140 $ RETURN 00141 * 00142 * Q := I 00143 * 00144 CALL DLASET( 'Full', N, N, ZERO, ONE, WORK, N ) 00145 * 00146 * Q := P(1) * ... * P(m) * Q 00147 * 00148 DO 10 I = M, 1, -1 00149 CALL DLATZM( 'Left', N-M+1, N, AF( I, M+1 ), LDA, TAU( I ), 00150 $ WORK( I ), WORK( M+1 ), N, WORK( N*N+1 ) ) 00151 10 CONTINUE 00152 * 00153 * Q := P(m) * ... * P(1) * Q 00154 * 00155 DO 20 I = 1, M 00156 CALL DLATZM( 'Left', N-M+1, N, AF( I, M+1 ), LDA, TAU( I ), 00157 $ WORK( I ), WORK( M+1 ), N, WORK( N*N+1 ) ) 00158 20 CONTINUE 00159 * 00160 * Q := Q - I 00161 * 00162 DO 30 I = 1, N 00163 WORK( ( I-1 )*N+I ) = WORK( ( I-1 )*N+I ) - ONE 00164 30 CONTINUE 00165 * 00166 DTZT02 = DLANGE( 'One-norm', N, N, WORK, N, RWORK ) / 00167 $ ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 00168 RETURN 00169 * 00170 * End of DTZT02 00171 * 00172 END