1*> \brief \b SSTT21 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE SSTT21( N, KBAND, AD, AE, SD, SE, U, LDU, WORK, 12* RESULT ) 13* 14* .. Scalar Arguments .. 15* INTEGER KBAND, LDU, N 16* .. 17* .. Array Arguments .. 18* REAL AD( * ), AE( * ), RESULT( 2 ), SD( * ), 19* $ SE( * ), U( LDU, * ), WORK( * ) 20* .. 21* 22* 23*> \par Purpose: 24* ============= 25*> 26*> \verbatim 27*> 28*> SSTT21 checks a decomposition of the form 29*> 30*> A = U S U' 31*> 32*> where ' means transpose, A is symmetric tridiagonal, U is orthogonal, 33*> and S is diagonal (if KBAND=0) or symmetric tridiagonal (if KBAND=1). 34*> Two tests are performed: 35*> 36*> RESULT(1) = | A - U S U' | / ( |A| n ulp ) 37*> 38*> RESULT(2) = | I - UU' | / ( n ulp ) 39*> \endverbatim 40* 41* Arguments: 42* ========== 43* 44*> \param[in] N 45*> \verbatim 46*> N is INTEGER 47*> The size of the matrix. If it is zero, SSTT21 does nothing. 48*> It must be at least zero. 49*> \endverbatim 50*> 51*> \param[in] KBAND 52*> \verbatim 53*> KBAND is INTEGER 54*> The bandwidth of the matrix S. It may only be zero or one. 55*> If zero, then S is diagonal, and SE is not referenced. If 56*> one, then S is symmetric tri-diagonal. 57*> \endverbatim 58*> 59*> \param[in] AD 60*> \verbatim 61*> AD is REAL array, dimension (N) 62*> The diagonal of the original (unfactored) matrix A. A is 63*> assumed to be symmetric tridiagonal. 64*> \endverbatim 65*> 66*> \param[in] AE 67*> \verbatim 68*> AE is REAL array, dimension (N-1) 69*> The off-diagonal of the original (unfactored) matrix A. A 70*> is assumed to be symmetric tridiagonal. AE(1) is the (1,2) 71*> and (2,1) element, AE(2) is the (2,3) and (3,2) element, etc. 72*> \endverbatim 73*> 74*> \param[in] SD 75*> \verbatim 76*> SD is REAL array, dimension (N) 77*> The diagonal of the (symmetric tri-) diagonal matrix S. 78*> \endverbatim 79*> 80*> \param[in] SE 81*> \verbatim 82*> SE is REAL array, dimension (N-1) 83*> The off-diagonal of the (symmetric tri-) diagonal matrix S. 84*> Not referenced if KBSND=0. If KBAND=1, then AE(1) is the 85*> (1,2) and (2,1) element, SE(2) is the (2,3) and (3,2) 86*> element, etc. 87*> \endverbatim 88*> 89*> \param[in] U 90*> \verbatim 91*> U is REAL array, dimension (LDU, N) 92*> The orthogonal matrix in the decomposition. 93*> \endverbatim 94*> 95*> \param[in] LDU 96*> \verbatim 97*> LDU is INTEGER 98*> The leading dimension of U. LDU must be at least N. 99*> \endverbatim 100*> 101*> \param[out] WORK 102*> \verbatim 103*> WORK is REAL array, dimension (N*(N+1)) 104*> \endverbatim 105*> 106*> \param[out] RESULT 107*> \verbatim 108*> RESULT is REAL array, dimension (2) 109*> The values computed by the two tests described above. The 110*> values are currently limited to 1/ulp, to avoid overflow. 111*> RESULT(1) is always modified. 112*> \endverbatim 113* 114* Authors: 115* ======== 116* 117*> \author Univ. of Tennessee 118*> \author Univ. of California Berkeley 119*> \author Univ. of Colorado Denver 120*> \author NAG Ltd. 121* 122*> \date November 2011 123* 124*> \ingroup single_eig 125* 126* ===================================================================== 127 SUBROUTINE SSTT21( N, KBAND, AD, AE, SD, SE, U, LDU, WORK, 128 $ RESULT ) 129* 130* -- LAPACK test routine (version 3.4.0) -- 131* -- LAPACK is a software package provided by Univ. of Tennessee, -- 132* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 133* November 2011 134* 135* .. Scalar Arguments .. 136 INTEGER KBAND, LDU, N 137* .. 138* .. Array Arguments .. 139 REAL AD( * ), AE( * ), RESULT( 2 ), SD( * ), 140 $ SE( * ), U( LDU, * ), WORK( * ) 141* .. 142* 143* ===================================================================== 144* 145* .. Parameters .. 146 REAL ZERO, ONE 147 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 148* .. 149* .. Local Scalars .. 150 INTEGER J 151 REAL ANORM, TEMP1, TEMP2, ULP, UNFL, WNORM 152* .. 153* .. External Functions .. 154 REAL SLAMCH, SLANGE, SLANSY 155 EXTERNAL SLAMCH, SLANGE, SLANSY 156* .. 157* .. External Subroutines .. 158 EXTERNAL SGEMM, SLASET, SSYR, SSYR2 159* .. 160* .. Intrinsic Functions .. 161 INTRINSIC ABS, MAX, MIN, REAL 162* .. 163* .. Executable Statements .. 164* 165* 1) Constants 166* 167 RESULT( 1 ) = ZERO 168 RESULT( 2 ) = ZERO 169 IF( N.LE.0 ) 170 $ RETURN 171* 172 UNFL = SLAMCH( 'Safe minimum' ) 173 ULP = SLAMCH( 'Precision' ) 174* 175* Do Test 1 176* 177* Copy A & Compute its 1-Norm: 178* 179 CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) 180* 181 ANORM = ZERO 182 TEMP1 = ZERO 183* 184 DO 10 J = 1, N - 1 185 WORK( ( N+1 )*( J-1 )+1 ) = AD( J ) 186 WORK( ( N+1 )*( J-1 )+2 ) = AE( J ) 187 TEMP2 = ABS( AE( J ) ) 188 ANORM = MAX( ANORM, ABS( AD( J ) )+TEMP1+TEMP2 ) 189 TEMP1 = TEMP2 190 10 CONTINUE 191* 192 WORK( N**2 ) = AD( N ) 193 ANORM = MAX( ANORM, ABS( AD( N ) )+TEMP1, UNFL ) 194* 195* Norm of A - USU' 196* 197 DO 20 J = 1, N 198 CALL SSYR( 'L', N, -SD( J ), U( 1, J ), 1, WORK, N ) 199 20 CONTINUE 200* 201 IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN 202 DO 30 J = 1, N - 1 203 CALL SSYR2( 'L', N, -SE( J ), U( 1, J ), 1, U( 1, J+1 ), 1, 204 $ WORK, N ) 205 30 CONTINUE 206 END IF 207* 208 WNORM = SLANSY( '1', 'L', N, WORK, N, WORK( N**2+1 ) ) 209* 210 IF( ANORM.GT.WNORM ) THEN 211 RESULT( 1 ) = ( WNORM / ANORM ) / ( N*ULP ) 212 ELSE 213 IF( ANORM.LT.ONE ) THEN 214 RESULT( 1 ) = ( MIN( WNORM, N*ANORM ) / ANORM ) / ( N*ULP ) 215 ELSE 216 RESULT( 1 ) = MIN( WNORM / ANORM, REAL( N ) ) / ( N*ULP ) 217 END IF 218 END IF 219* 220* Do Test 2 221* 222* Compute UU' - I 223* 224 CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, 225 $ N ) 226* 227 DO 40 J = 1, N 228 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - ONE 229 40 CONTINUE 230* 231 RESULT( 2 ) = MIN( REAL( N ), SLANGE( '1', N, N, WORK, N, 232 $ WORK( N**2+1 ) ) ) / ( N*ULP ) 233* 234 RETURN 235* 236* End of SSTT21 237* 238 END 239