![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZRZT01 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 ZRZT01( M, N, A, AF, LDA, TAU, WORK, 00012 * LWORK ) 00013 * 00014 * .. Scalar Arguments .. 00015 * INTEGER LDA, LWORK, M, N 00016 * .. 00017 * .. Array Arguments .. 00018 * COMPLEX*16 A( LDA, * ), AF( LDA, * ), TAU( * ), 00019 * $ WORK( LWORK ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> ZRZT01 returns 00029 *> || A - R*Q || / ( M * eps * ||A|| ) 00030 *> for an upper trapezoidal A that was factored with ZTZRZF. 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 COMPLEX*16 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 COMPLEX*16 array, dimension (LDA,N) 00057 *> The output of ZTZRZF 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 COMPLEX*16 array, dimension (M) 00070 *> Details of the Householder transformations as returned by 00071 *> ZTZRZF. 00072 *> \endverbatim 00073 *> 00074 *> \param[out] WORK 00075 *> \verbatim 00076 *> WORK is COMPLEX*16 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 complex16_lin 00096 * 00097 * ===================================================================== 00098 DOUBLE PRECISION FUNCTION ZRZT01( 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 COMPLEX*16 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, INFO, J 00122 DOUBLE PRECISION NORMA 00123 * .. 00124 * .. Local Arrays .. 00125 DOUBLE PRECISION RWORK( 1 ) 00126 * .. 00127 * .. External Functions .. 00128 DOUBLE PRECISION DLAMCH, ZLANGE 00129 EXTERNAL DLAMCH, ZLANGE 00130 * .. 00131 * .. External Subroutines .. 00132 EXTERNAL XERBLA, ZAXPY, ZLASET, ZUNMRZ 00133 * .. 00134 * .. Intrinsic Functions .. 00135 INTRINSIC DBLE, DCMPLX, MAX 00136 * .. 00137 * .. Executable Statements .. 00138 * 00139 ZRZT01 = ZERO 00140 * 00141 IF( LWORK.LT.M*N+M ) THEN 00142 CALL XERBLA( 'ZRZT01', 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 = ZLANGE( 'One-norm', M, N, A, LDA, RWORK ) 00152 * 00153 * Copy upper triangle R 00154 * 00155 CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ZERO ), WORK, 00156 $ M ) 00157 DO 20 J = 1, M 00158 DO 10 I = 1, J 00159 WORK( ( J-1 )*M+I ) = AF( I, J ) 00160 10 CONTINUE 00161 20 CONTINUE 00162 * 00163 * R = R * P(1) * ... *P(m) 00164 * 00165 CALL ZUNMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU, 00166 $ WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO ) 00167 * 00168 * R = R - A 00169 * 00170 DO 30 I = 1, N 00171 CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, I ), 1, 00172 $ WORK( ( I-1 )*M+1 ), 1 ) 00173 30 CONTINUE 00174 * 00175 ZRZT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00176 * 00177 ZRZT01 = ZRZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 00178 IF( NORMA.NE.ZERO ) 00179 $ ZRZT01 = ZRZT01 / NORMA 00180 * 00181 RETURN 00182 * 00183 * End of ZRZT01 00184 * 00185 END