1*> \brief \b SSYT01_ROOK 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 SSYT01_ROOK( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, 12* RWORK, RESID ) 13* 14* .. Scalar Arguments .. 15* CHARACTER UPLO 16* INTEGER LDA, LDAFAC, LDC, N 17* REAL RESID 18* .. 19* .. Array Arguments .. 20* INTEGER IPIV( * ) 21* REAL A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ), 22* $ RWORK( * ) 23* .. 24* 25* 26*> \par Purpose: 27* ============= 28*> 29*> \verbatim 30*> 31*> SSYT01_ROOK reconstructs a symmetric indefinite matrix A from its 32*> block L*D*L' or U*D*U' factorization and computes the residual 33*> norm( C - A ) / ( N * norm(A) * EPS ), 34*> where C is the reconstructed matrix and EPS is the machine epsilon. 35*> \endverbatim 36* 37* Arguments: 38* ========== 39* 40*> \param[in] UPLO 41*> \verbatim 42*> UPLO is CHARACTER*1 43*> Specifies whether the upper or lower triangular part of the 44*> symmetric matrix A is stored: 45*> = 'U': Upper triangular 46*> = 'L': Lower triangular 47*> \endverbatim 48*> 49*> \param[in] N 50*> \verbatim 51*> N is INTEGER 52*> The number of rows and columns of the matrix A. N >= 0. 53*> \endverbatim 54*> 55*> \param[in] A 56*> \verbatim 57*> A is REAL array, dimension (LDA,N) 58*> The original symmetric matrix A. 59*> \endverbatim 60*> 61*> \param[in] LDA 62*> \verbatim 63*> LDA is INTEGER 64*> The leading dimension of the array A. LDA >= max(1,N) 65*> \endverbatim 66*> 67*> \param[in] AFAC 68*> \verbatim 69*> AFAC is REAL array, dimension (LDAFAC,N) 70*> The factored form of the matrix A. AFAC contains the block 71*> diagonal matrix D and the multipliers used to obtain the 72*> factor L or U from the block L*D*L' or U*D*U' factorization 73*> as computed by SSYTRF_ROOK. 74*> \endverbatim 75*> 76*> \param[in] LDAFAC 77*> \verbatim 78*> LDAFAC is INTEGER 79*> The leading dimension of the array AFAC. LDAFAC >= max(1,N). 80*> \endverbatim 81*> 82*> \param[in] IPIV 83*> \verbatim 84*> IPIV is INTEGER array, dimension (N) 85*> The pivot indices from SSYTRF_ROOK. 86*> \endverbatim 87*> 88*> \param[out] C 89*> \verbatim 90*> C is REAL array, dimension (LDC,N) 91*> \endverbatim 92*> 93*> \param[in] LDC 94*> \verbatim 95*> LDC is INTEGER 96*> The leading dimension of the array C. LDC >= max(1,N). 97*> \endverbatim 98*> 99*> \param[out] RWORK 100*> \verbatim 101*> RWORK is REAL array, dimension (N) 102*> \endverbatim 103*> 104*> \param[out] RESID 105*> \verbatim 106*> RESID is REAL 107*> If UPLO = 'L', norm(L*D*L' - A) / ( N * norm(A) * EPS ) 108*> If UPLO = 'U', norm(U*D*U' - A) / ( N * norm(A) * EPS ) 109*> \endverbatim 110* 111* Authors: 112* ======== 113* 114*> \author Univ. of Tennessee 115*> \author Univ. of California Berkeley 116*> \author Univ. of Colorado Denver 117*> \author NAG Ltd. 118* 119*> \date November 2013 120* 121*> \ingroup single_lin 122* 123* ===================================================================== 124 SUBROUTINE SSYT01_ROOK( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, 125 $ LDC, RWORK, RESID ) 126* 127* -- LAPACK test routine (version 3.5.0) -- 128* -- LAPACK is a software package provided by Univ. of Tennessee, -- 129* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 130* November 2013 131* 132* .. Scalar Arguments .. 133 CHARACTER UPLO 134 INTEGER LDA, LDAFAC, LDC, N 135 REAL RESID 136* .. 137* .. Array Arguments .. 138 INTEGER IPIV( * ) 139 REAL A( LDA, * ), AFAC( LDAFAC, * ), C( LDC, * ), 140 $ RWORK( * ) 141* .. 142* 143* ===================================================================== 144* 145* .. Parameters .. 146 REAL ZERO, ONE 147 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) 148* .. 149* .. Local Scalars .. 150 INTEGER I, INFO, J 151 REAL ANORM, EPS 152* .. 153* .. External Functions .. 154 LOGICAL LSAME 155 REAL SLAMCH, SLANSY 156 EXTERNAL LSAME, SLAMCH, SLANSY 157* .. 158* .. External Subroutines .. 159 EXTERNAL SLASET, SLAVSY_ROOK 160* .. 161* .. Intrinsic Functions .. 162 INTRINSIC REAL 163* .. 164* .. Executable Statements .. 165* 166* Quick exit if N = 0. 167* 168 IF( N.LE.0 ) THEN 169 RESID = ZERO 170 RETURN 171 END IF 172* 173* Determine EPS and the norm of A. 174* 175 EPS = SLAMCH( 'Epsilon' ) 176 ANORM = SLANSY( '1', UPLO, N, A, LDA, RWORK ) 177* 178* Initialize C to the identity matrix. 179* 180 CALL SLASET( 'Full', N, N, ZERO, ONE, C, LDC ) 181* 182* Call SLAVSY_ROOK to form the product D * U' (or D * L' ). 183* 184 CALL SLAVSY_ROOK( UPLO, 'Transpose', 'Non-unit', N, N, AFAC, 185 $ LDAFAC, IPIV, C, LDC, INFO ) 186* 187* Call SLAVSY_ROOK again to multiply by U (or L ). 188* 189 CALL SLAVSY_ROOK( UPLO, 'No transpose', 'Unit', N, N, AFAC, 190 $ LDAFAC, IPIV, C, LDC, INFO ) 191* 192* Compute the difference C - A . 193* 194 IF( LSAME( UPLO, 'U' ) ) THEN 195 DO 20 J = 1, N 196 DO 10 I = 1, J 197 C( I, J ) = C( I, J ) - A( I, J ) 198 10 CONTINUE 199 20 CONTINUE 200 ELSE 201 DO 40 J = 1, N 202 DO 30 I = J, N 203 C( I, J ) = C( I, J ) - A( I, J ) 204 30 CONTINUE 205 40 CONTINUE 206 END IF 207* 208* Compute norm( C - A ) / ( N * norm(A) * EPS ) 209* 210 RESID = SLANSY( '1', UPLO, N, C, LDC, RWORK ) 211* 212 IF( ANORM.LE.ZERO ) THEN 213 IF( RESID.NE.ZERO ) 214 $ RESID = ONE / EPS 215 ELSE 216 RESID = ( ( RESID / REAL( N ) ) / ANORM ) / EPS 217 END IF 218* 219 RETURN 220* 221* End of SSYT01_ROOK 222* 223 END 224