1*> \brief \b ZRZT01 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* DOUBLE PRECISION FUNCTION ZRZT01( 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*16 A( LDA, * ), AF( LDA, * ), TAU( * ), 19* $ WORK( LWORK ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> ZRZT01 returns 29*> || A - R*Q || / ( M * eps * ||A|| ) 30*> for an upper trapezoidal A that was factored with ZTZRZF. 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*16 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*16 array, dimension (LDA,N) 57*> The output of ZTZRZF 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*16 array, dimension (M) 70*> Details of the Householder transformations as returned by 71*> ZTZRZF. 72*> \endverbatim 73*> 74*> \param[out] WORK 75*> \verbatim 76*> WORK is COMPLEX*16 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 complex16_lin 96* 97* ===================================================================== 98 DOUBLE PRECISION FUNCTION ZRZT01( 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*16 A( LDA, * ), AF( LDA, * ), TAU( * ), 111 $ WORK( LWORK ) 112* .. 113* 114* ===================================================================== 115* 116* .. Parameters .. 117 DOUBLE PRECISION ZERO, ONE 118 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 119* .. 120* .. Local Scalars .. 121 INTEGER I, INFO, J 122 DOUBLE PRECISION NORMA 123* .. 124* .. Local Arrays .. 125 DOUBLE PRECISION RWORK( 1 ) 126* .. 127* .. External Functions .. 128 DOUBLE PRECISION DLAMCH, ZLANGE 129 EXTERNAL DLAMCH, ZLANGE 130* .. 131* .. External Subroutines .. 132 EXTERNAL XERBLA, ZAXPY, ZLASET, ZUNMRZ 133* .. 134* .. Intrinsic Functions .. 135 INTRINSIC DBLE, DCMPLX, MAX 136* .. 137* .. Executable Statements .. 138* 139 ZRZT01 = ZERO 140* 141 IF( LWORK.LT.M*N+M ) THEN 142 CALL XERBLA( 'ZRZT01', 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 = ZLANGE( 'One-norm', M, N, A, LDA, RWORK ) 152* 153* Copy upper triangle R 154* 155 CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), DCMPLX( ZERO ), WORK, 156 $ M ) 157 DO 20 J = 1, M 158 DO 10 I = 1, J 159 WORK( ( J-1 )*M+I ) = AF( I, J ) 160 10 CONTINUE 161 20 CONTINUE 162* 163* R = R * P(1) * ... *P(m) 164* 165 CALL ZUNMRZ( 'Right', 'No tranpose', M, N, M, N-M, AF, LDA, TAU, 166 $ WORK, M, WORK( M*N+1 ), LWORK-M*N, INFO ) 167* 168* R = R - A 169* 170 DO 30 I = 1, N 171 CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, I ), 1, 172 $ WORK( ( I-1 )*M+1 ), 1 ) 173 30 CONTINUE 174* 175 ZRZT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) 176* 177 ZRZT01 = ZRZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 178 IF( NORMA.NE.ZERO ) 179 $ ZRZT01 = ZRZT01 / NORMA 180* 181 RETURN 182* 183* End of ZRZT01 184* 185 END 186