1*> \brief \b CRZT01 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* REAL FUNCTION CRZT01( M, N, A, AF, LDA, TAU, WORK, 12* LWORK ) 13* 14* .. Scalar Arguments .. 15* INTEGER LDA, LWORK, M, N 16* .. 17* .. Array Arguments .. 18* COMPLEX A( LDA, * ), AF( LDA, * ), TAU( * ), 19* $ WORK( LWORK ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> CRZT01 returns 29*> || A - R*Q || / ( M * eps * ||A|| ) 30*> for an upper trapezoidal A that was factored with CTZRZF. 31*> \endverbatim 32* 33* Arguments: 34* ========== 35* 36*> \param[in] M 37*> \verbatim 38*> M is INTEGER 39*> The number of rows of the matrices A and AF. 40*> \endverbatim 41*> 42*> \param[in] N 43*> \verbatim 44*> N is INTEGER 45*> The number of columns of the matrices A and AF. 46*> \endverbatim 47*> 48*> \param[in] A 49*> \verbatim 50*> A is COMPLEX array, dimension (LDA,N) 51*> The original upper trapezoidal M by N matrix A. 52*> \endverbatim 53*> 54*> \param[in] AF 55*> \verbatim 56*> AF is COMPLEX array, dimension (LDA,N) 57*> The output of CTZRZF for input matrix A. 58*> The lower triangle is not referenced. 59*> \endverbatim 60*> 61*> \param[in] LDA 62*> \verbatim 63*> LDA is INTEGER 64*> The leading dimension of the arrays A and AF. 65*> \endverbatim 66*> 67*> \param[in] TAU 68*> \verbatim 69*> TAU is COMPLEX array, dimension (M) 70*> Details of the Householder transformations as returned by 71*> CTZRZF. 72*> \endverbatim 73*> 74*> \param[out] WORK 75*> \verbatim 76*> WORK is COMPLEX array, dimension (LWORK) 77*> \endverbatim 78*> 79*> \param[in] LWORK 80*> \verbatim 81*> LWORK is INTEGER 82*> The length of the array WORK. LWORK >= m*n + m. 83*> \endverbatim 84* 85* Authors: 86* ======== 87* 88*> \author Univ. of Tennessee 89*> \author Univ. of California Berkeley 90*> \author Univ. of Colorado Denver 91*> \author NAG Ltd. 92* 93*> \date November 2011 94* 95*> \ingroup complex_lin 96* 97* ===================================================================== 98 REAL FUNCTION CRZT01( M, N, A, AF, LDA, TAU, WORK, 99 $ LWORK ) 100* 101* -- LAPACK test routine (version 3.4.0) -- 102* -- LAPACK is a software package provided by Univ. of Tennessee, -- 103* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 104* November 2011 105* 106* .. Scalar Arguments .. 107 INTEGER LDA, LWORK, M, N 108* .. 109* .. Array Arguments .. 110 COMPLEX A( LDA, * ), AF( LDA, * ), TAU( * ), 111 $ WORK( LWORK ) 112* .. 113* 114* ===================================================================== 115* 116* .. Parameters .. 117 REAL ZERO, ONE 118 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 119* .. 120* .. Local Scalars .. 121 INTEGER I, INFO, J 122 REAL NORMA 123* .. 124* .. Local Arrays .. 125 REAL RWORK( 1 ) 126* .. 127* .. External Functions .. 128 REAL CLANGE, SLAMCH 129 EXTERNAL CLANGE, SLAMCH 130* .. 131* .. External Subroutines .. 132 EXTERNAL CAXPY, CLASET, CUNMRZ, XERBLA 133* .. 134* .. Intrinsic Functions .. 135 INTRINSIC CMPLX, MAX, REAL 136* .. 137* .. Executable Statements .. 138* 139 CRZT01 = ZERO 140* 141 IF( LWORK.LT.M*N+M ) THEN 142 CALL XERBLA( 'CRZT01', 8 ) 143 RETURN 144 END IF 145* 146* Quick return if possible 147* 148 IF( M.LE.0 .OR. N.LE.0 ) 149 $ RETURN 150* 151 NORMA = CLANGE( 'One-norm', M, N, A, LDA, RWORK ) 152* 153* Copy upper triangle R 154* 155 CALL CLASET( 'Full', M, N, CMPLX( ZERO ), CMPLX( ZERO ), WORK, M ) 156 DO 20 J = 1, M 157 DO 10 I = 1, J 158 WORK( ( J-1 )*M+I ) = AF( I, J ) 159 10 CONTINUE 160 20 CONTINUE 161* 162* R = R * P(1) * ... *P(m) 163* 164 CALL CUNMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU, 165 $ WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO ) 166* 167* R = R - A 168* 169 DO 30 I = 1, N 170 CALL CAXPY( M, CMPLX( -ONE ), A( 1, I ), 1, 171 $ WORK( ( I-1 )*M+1 ), 1 ) 172 30 CONTINUE 173* 174 CRZT01 = CLANGE( 'One-norm', M, N, WORK, M, RWORK ) 175* 176 CRZT01 = CRZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) ) 177 IF( NORMA.NE.ZERO ) 178 $ CRZT01 = CRZT01 / NORMA 179* 180 RETURN 181* 182* End of CRZT01 183* 184 END 185