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*> \ingroup single_eig 123* 124* ===================================================================== 125 SUBROUTINE SSTT21( N, KBAND, AD, AE, SD, SE, U, LDU, WORK, 126 $ RESULT ) 127* 128* -- LAPACK test routine -- 129* -- LAPACK is a software package provided by Univ. of Tennessee, -- 130* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 131* 132* .. Scalar Arguments .. 133 INTEGER KBAND, LDU, N 134* .. 135* .. Array Arguments .. 136 REAL AD( * ), AE( * ), RESULT( 2 ), SD( * ), 137 $ SE( * ), U( LDU, * ), WORK( * ) 138* .. 139* 140* ===================================================================== 141* 142* .. Parameters .. 143 REAL ZERO, ONE 144 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 145* .. 146* .. Local Scalars .. 147 INTEGER J 148 REAL ANORM, TEMP1, TEMP2, ULP, UNFL, WNORM 149* .. 150* .. External Functions .. 151 REAL SLAMCH, SLANGE, SLANSY 152 EXTERNAL SLAMCH, SLANGE, SLANSY 153* .. 154* .. External Subroutines .. 155 EXTERNAL SGEMM, SLASET, SSYR, SSYR2 156* .. 157* .. Intrinsic Functions .. 158 INTRINSIC ABS, MAX, MIN, REAL 159* .. 160* .. Executable Statements .. 161* 162* 1) Constants 163* 164 RESULT( 1 ) = ZERO 165 RESULT( 2 ) = ZERO 166 IF( N.LE.0 ) 167 $ RETURN 168* 169 UNFL = SLAMCH( 'Safe minimum' ) 170 ULP = SLAMCH( 'Precision' ) 171* 172* Do Test 1 173* 174* Copy A & Compute its 1-Norm: 175* 176 CALL SLASET( 'Full', N, N, ZERO, ZERO, WORK, N ) 177* 178 ANORM = ZERO 179 TEMP1 = ZERO 180* 181 DO 10 J = 1, N - 1 182 WORK( ( N+1 )*( J-1 )+1 ) = AD( J ) 183 WORK( ( N+1 )*( J-1 )+2 ) = AE( J ) 184 TEMP2 = ABS( AE( J ) ) 185 ANORM = MAX( ANORM, ABS( AD( J ) )+TEMP1+TEMP2 ) 186 TEMP1 = TEMP2 187 10 CONTINUE 188* 189 WORK( N**2 ) = AD( N ) 190 ANORM = MAX( ANORM, ABS( AD( N ) )+TEMP1, UNFL ) 191* 192* Norm of A - USU' 193* 194 DO 20 J = 1, N 195 CALL SSYR( 'L', N, -SD( J ), U( 1, J ), 1, WORK, N ) 196 20 CONTINUE 197* 198 IF( N.GT.1 .AND. KBAND.EQ.1 ) THEN 199 DO 30 J = 1, N - 1 200 CALL SSYR2( 'L', N, -SE( J ), U( 1, J ), 1, U( 1, J+1 ), 1, 201 $ WORK, N ) 202 30 CONTINUE 203 END IF 204* 205 WNORM = SLANSY( '1', 'L', N, WORK, N, WORK( N**2+1 ) ) 206* 207 IF( ANORM.GT.WNORM ) THEN 208 RESULT( 1 ) = ( WNORM / ANORM ) / ( N*ULP ) 209 ELSE 210 IF( ANORM.LT.ONE ) THEN 211 RESULT( 1 ) = ( MIN( WNORM, N*ANORM ) / ANORM ) / ( N*ULP ) 212 ELSE 213 RESULT( 1 ) = MIN( WNORM / ANORM, REAL( N ) ) / ( N*ULP ) 214 END IF 215 END IF 216* 217* Do Test 2 218* 219* Compute UU' - I 220* 221 CALL SGEMM( 'N', 'C', N, N, N, ONE, U, LDU, U, LDU, ZERO, WORK, 222 $ N ) 223* 224 DO 40 J = 1, N 225 WORK( ( N+1 )*( J-1 )+1 ) = WORK( ( N+1 )*( J-1 )+1 ) - ONE 226 40 CONTINUE 227* 228 RESULT( 2 ) = MIN( REAL( N ), SLANGE( '1', N, N, WORK, N, 229 $ WORK( N**2+1 ) ) ) / ( N*ULP ) 230* 231 RETURN 232* 233* End of SSTT21 234* 235 END 236