![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DTZT01 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 DTZT01( M, N, A, AF, LDA, TAU, WORK, 00012 * LWORK ) 00013 * 00014 * .. Scalar Arguments .. 00015 * INTEGER LDA, LWORK, M, N 00016 * .. 00017 * .. Array Arguments .. 00018 * DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), TAU( * ), 00019 * $ WORK( LWORK ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> DTZT01 returns 00029 *> || A - R*Q || / ( M * eps * ||A|| ) 00030 *> for an upper trapezoidal A that was factored with 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 matrices A and AF. 00040 *> \endverbatim 00041 *> 00042 *> \param[in] N 00043 *> \verbatim 00044 *> N is INTEGER 00045 *> The number of columns of the matrices A and AF. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] A 00049 *> \verbatim 00050 *> A is DOUBLE PRECISION array, dimension (LDA,N) 00051 *> The original upper trapezoidal M by N matrix A. 00052 *> \endverbatim 00053 *> 00054 *> \param[in] AF 00055 *> \verbatim 00056 *> AF is DOUBLE PRECISION array, dimension (LDA,N) 00057 *> The output of DTZRQF for input matrix A. 00058 *> The lower triangle is not referenced. 00059 *> \endverbatim 00060 *> 00061 *> \param[in] LDA 00062 *> \verbatim 00063 *> LDA is INTEGER 00064 *> The leading dimension of the arrays A and AF. 00065 *> \endverbatim 00066 *> 00067 *> \param[in] TAU 00068 *> \verbatim 00069 *> TAU is DOUBLE PRECISION array, dimension (M) 00070 *> Details of the Householder transformations as returned by 00071 *> DTZRQF. 00072 *> \endverbatim 00073 *> 00074 *> \param[out] WORK 00075 *> \verbatim 00076 *> WORK is DOUBLE PRECISION array, dimension (LWORK) 00077 *> \endverbatim 00078 *> 00079 *> \param[in] LWORK 00080 *> \verbatim 00081 *> LWORK is INTEGER 00082 *> The length of the array WORK. LWORK >= m*n + m. 00083 *> \endverbatim 00084 * 00085 * Authors: 00086 * ======== 00087 * 00088 *> \author Univ. of Tennessee 00089 *> \author Univ. of California Berkeley 00090 *> \author Univ. of Colorado Denver 00091 *> \author NAG Ltd. 00092 * 00093 *> \date November 2011 00094 * 00095 *> \ingroup double_lin 00096 * 00097 * ===================================================================== 00098 DOUBLE PRECISION FUNCTION DTZT01( M, N, A, AF, LDA, TAU, WORK, 00099 $ LWORK ) 00100 * 00101 * -- LAPACK test routine (version 3.4.0) -- 00102 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00103 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00104 * November 2011 00105 * 00106 * .. Scalar Arguments .. 00107 INTEGER LDA, LWORK, M, N 00108 * .. 00109 * .. Array Arguments .. 00110 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), TAU( * ), 00111 $ WORK( LWORK ) 00112 * .. 00113 * 00114 * ===================================================================== 00115 * 00116 * .. Parameters .. 00117 DOUBLE PRECISION ZERO, ONE 00118 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 00119 * .. 00120 * .. Local Scalars .. 00121 INTEGER I, J 00122 DOUBLE PRECISION NORMA 00123 * .. 00124 * .. Local Arrays .. 00125 DOUBLE PRECISION RWORK( 1 ) 00126 * .. 00127 * .. External Functions .. 00128 DOUBLE PRECISION DLAMCH, DLANGE 00129 EXTERNAL DLAMCH, DLANGE 00130 * .. 00131 * .. External Subroutines .. 00132 EXTERNAL DAXPY, DLASET, DLATZM, XERBLA 00133 * .. 00134 * .. Intrinsic Functions .. 00135 INTRINSIC DBLE, MAX 00136 * .. 00137 * .. Executable Statements .. 00138 * 00139 DTZT01 = ZERO 00140 * 00141 IF( LWORK.LT.M*N+M ) THEN 00142 CALL XERBLA( 'DTZT01', 8 ) 00143 RETURN 00144 END IF 00145 * 00146 * Quick return if possible 00147 * 00148 IF( M.LE.0 .OR. N.LE.0 ) 00149 $ RETURN 00150 * 00151 NORMA = DLANGE( 'One-norm', M, N, A, LDA, RWORK ) 00152 * 00153 * Copy upper triangle R 00154 * 00155 CALL DLASET( 'Full', M, N, ZERO, ZERO, WORK, M ) 00156 DO 20 J = 1, M 00157 DO 10 I = 1, J 00158 WORK( ( J-1 )*M+I ) = AF( I, J ) 00159 10 CONTINUE 00160 20 CONTINUE 00161 * 00162 * R = R * P(1) * ... *P(m) 00163 * 00164 DO 30 I = 1, M 00165 CALL DLATZM( 'Right', I, N-M+1, AF( I, M+1 ), LDA, TAU( I ), 00166 $ WORK( ( I-1 )*M+1 ), WORK( M*M+1 ), M, 00167 $ WORK( M*N+1 ) ) 00168 30 CONTINUE 00169 * 00170 * R = R - A 00171 * 00172 DO 40 I = 1, N 00173 CALL DAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 ) 00174 40 CONTINUE 00175 * 00176 DTZT01 = DLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00177 * 00178 DTZT01 = DTZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 00179 IF( NORMA.NE.ZERO ) 00180 $ DTZT01 = DTZT01 / NORMA 00181 * 00182 RETURN 00183 * 00184 * End of DTZT01 00185 * 00186 END