1*> \brief \b SRZT01 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 SRZT01( M, N, A, AF, LDA, TAU, WORK, 12* LWORK ) 13* 14* .. Scalar Arguments .. 15* INTEGER LDA, LWORK, M, N 16* .. 17* .. Array Arguments .. 18* REAL A( LDA, * ), AF( LDA, * ), TAU( * ), 19* $ WORK( LWORK ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> SRZT01 returns 29*> || A - R*Q || / ( M * eps * ||A|| ) 30*> for an upper trapezoidal A that was factored with STZRZF. 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 REAL 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 REAL array, dimension (LDA,N) 57*> The output of STZRZF 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 REAL array, dimension (M) 70*> Details of the Householder transformations as returned by 71*> STZRZF. 72*> \endverbatim 73*> 74*> \param[out] WORK 75*> \verbatim 76*> WORK is REAL 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*nb. 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 single_lin 96* 97* ===================================================================== 98 REAL FUNCTION SRZT01( 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 REAL A( LDA, * ), AF( LDA, * ), TAU( * ), 111 $ WORK( LWORK ) 112* .. 113* 114* ===================================================================== 115* 116* .. Parameters .. 117 REAL ZERO, ONE 118 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 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 SLAMCH, SLANGE 129 EXTERNAL SLAMCH, SLANGE 130* .. 131* .. External Subroutines .. 132 EXTERNAL SAXPY, SLASET, SORMRZ, XERBLA 133* .. 134* .. Intrinsic Functions .. 135 INTRINSIC MAX, REAL 136* .. 137* .. Executable Statements .. 138* 139 SRZT01 = ZERO 140* 141 IF( LWORK.LT.M*N+M ) THEN 142 CALL XERBLA( 'SRZT01', 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 = SLANGE( 'One-norm', M, N, A, LDA, RWORK ) 152* 153* Copy upper triangle R 154* 155 CALL SLASET( 'Full', M, N, ZERO, 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 SORMRZ( '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 SAXPY( M, -ONE, A( 1, I ), 1, WORK( ( I-1 )*M+1 ), 1 ) 171 30 CONTINUE 172* 173 SRZT01 = SLANGE( 'One-norm', M, N, WORK, M, RWORK ) 174* 175 SRZT01 = SRZT01 / ( SLAMCH( 'Epsilon' )*REAL( MAX( M, N ) ) ) 176 IF( NORMA.NE.ZERO ) 177 $ SRZT01 = SRZT01 / NORMA 178* 179 RETURN 180* 181* End of SRZT01 182* 183 END 184