![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CRZT01 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * REAL FUNCTION CRZT01( 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 A( LDA, * ), AF( LDA, * ), TAU( * ), 00019 * $ WORK( LWORK ) 00020 * .. 00021 * 00022 * 00023 *> \par Purpose: 00024 * ============= 00025 *> 00026 *> \verbatim 00027 *> 00028 *> CRZT01 returns 00029 *> || A - R*Q || / ( M * eps * ||A|| ) 00030 *> for an upper trapezoidal A that was factored with CTZRZF. 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 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 array, dimension (LDA,N) 00057 *> The output of CTZRZF 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 array, dimension (M) 00070 *> Details of the Householder transformations as returned by 00071 *> CTZRZF. 00072 *> \endverbatim 00073 *> 00074 *> \param[out] WORK 00075 *> \verbatim 00076 *> WORK is COMPLEX 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 complex_lin 00096 * 00097 * ===================================================================== 00098 REAL FUNCTION CRZT01( 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 A( LDA, * ), AF( LDA, * ), TAU( * ), 00111 $ WORK( LWORK ) 00112 * .. 00113 * 00114 * ===================================================================== 00115 * 00116 * .. Parameters .. 00117 REAL ZERO, ONE 00118 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 00119 * .. 00120 * .. Local Scalars .. 00121 INTEGER I, INFO, J 00122 REAL NORMA 00123 * .. 00124 * .. Local Arrays .. 00125 REAL RWORK( 1 ) 00126 * .. 00127 * .. External Functions .. 00128 REAL CLANGE, SLAMCH 00129 EXTERNAL CLANGE, SLAMCH 00130 * .. 00131 * .. External Subroutines .. 00132 EXTERNAL CAXPY, CLASET, CUNMRZ, XERBLA 00133 * .. 00134 * .. Intrinsic Functions .. 00135 INTRINSIC CMPLX, MAX, REAL 00136 * .. 00137 * .. Executable Statements .. 00138 * 00139 CRZT01 = ZERO 00140 * 00141 IF( LWORK.LT.M*N+M ) THEN 00142 CALL XERBLA( 'CRZT01', 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 = CLANGE( 'One-norm', M, N, A, LDA, RWORK ) 00152 * 00153 * Copy upper triangle R 00154 * 00155 CALL CLASET( 'Full', M, N, CMPLX( ZERO ), CMPLX( 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 CUNMRZ( '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 CAXPY( M, CMPLX( -ONE ), A( 1, I ), 1, 00171 $ WORK( ( I-1 )*M+1 ), 1 ) 00172 30 CONTINUE 00173 * 00174 CRZT01 = CLANGE( 'One-norm', M, N, WORK, M, RWORK ) 00175 * 00176 CRZT01 = CRZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) ) 00177 IF( NORMA.NE.ZERO ) 00178 $ CRZT01 = CRZT01 / NORMA 00179 * 00180 RETURN 00181 * 00182 * End of CRZT01 00183 * 00184 END