![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DRZT01 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 DRZT01( 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 *> DRZT01 returns 00029 *> || A - R*Q || / ( M * eps * ||A|| ) 00030 *> for an upper trapezoidal A that was factored with DTZRZF. 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 DTZRZF 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 *> DTZRZF. 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*nb. 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 DRZT01( 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.0D+0, ONE = 1.0D+0 ) 00119 * .. 00120 * .. Local Scalars .. 00121 INTEGER I, INFO, 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, DORMRZ, XERBLA 00133 * .. 00134 * .. Intrinsic Functions .. 00135 INTRINSIC DBLE, MAX 00136 * .. 00137 * .. Executable Statements .. 00138 * 00139 DRZT01 = ZERO 00140 * 00141 IF( LWORK.LT.M*N+M ) THEN 00142 CALL XERBLA( 'DRZT01', 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 CALL DORMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU, 00165 $ WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO ) 00166 * 00167 * R = R - A 00168 * 00169 DO 30 I = 1, N 00170 CALL DAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 ) 00171 30 CONTINUE 00172 * 00173 DRZT01 = DLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00174 * 00175 DRZT01 = DRZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 00176 IF( NORMA.NE.ZERO ) 00177 $ DRZT01 = DRZT01 / NORMA 00178 * 00179 RETURN 00180 * 00181 * End of DRZT01 00182 * 00183 END