1*> \brief \b ZTZT01 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 ZTZT01( 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*> ZTZT01 returns 29*> || A - R*Q || / ( M * eps * ||A|| ) 30*> for an upper trapezoidal A that was factored with ZTZRQF. 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 ZTZRQF 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*> ZTZRQF. 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 ZTZT01( 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, 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, ZLATZM 133* .. 134* .. Intrinsic Functions .. 135 INTRINSIC DBLE, DCMPLX, MAX 136* .. 137* .. Executable Statements .. 138* 139 ZTZT01 = ZERO 140* 141 IF( LWORK.LT.M*N+M ) THEN 142 CALL XERBLA( 'ZTZT01', 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 DO 30 I = 1, M 166 CALL ZLATZM( 'Right', I, N-M+1, AF( I, M+1 ), LDA, TAU( I ), 167 $ WORK( ( I-1 )*M+1 ), WORK( M*M+1 ), M, 168 $ WORK( M*N+1 ) ) 169 30 CONTINUE 170* 171* R = R - A 172* 173 DO 40 I = 1, N 174 CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, I ), 1, 175 $ WORK( ( I-1 )*M+1 ), 1 ) 176 40 CONTINUE 177* 178 ZTZT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) 179* 180 ZTZT01 = ZTZT01 / ( DLAMCH( 'Epsilon' )*DBLE( MAX( M, N ) ) ) 181 IF( NORMA.NE.ZERO ) 182 $ ZTZT01 = ZTZT01 / NORMA 183* 184 RETURN 185* 186* End of ZTZT01 187* 188 END 189