95 SUBROUTINE sdrvrf1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
103 INTEGER lda, nn, nout
108 REAL a( lda, * ), arf( * ), work( * )
115 parameter( one = 1.0e+0 )
117 parameter( ntests = 1 )
120 CHARACTER uplo, cform, norm
121 INTEGER i, iform, iin, iit, info, inorm, iuplo,
j, n,
123 REAL eps, large, norma, normarf, small
126 CHARACTER uplos( 2 ),
forms( 2 ), norms( 4 )
127 INTEGER iseed( 4 ), iseedy( 4 )
128 REAL result( ntests )
141 COMMON / srnamc / srnamt
144 DATA iseedy / 1988, 1989, 1990, 1991 /
145 DATA uplos /
'U',
'L' /
146 DATA forms /
'N',
'T' /
147 DATA norms /
'M',
'1',
'I',
'F' /
158 iseed( i ) = iseedy( i )
161 eps =
slamch(
'Precision' )
162 small =
slamch(
'Safe minimum' )
164 small = small * lda * lda
165 large = large / lda / lda
191 a( i,
j) = a( i,
j ) * large
199 a( i,
j) = a( i,
j) * small
208 uplo = uplos( iuplo )
214 cform =
forms( iform )
217 CALL
strttf( cform, uplo, n, a, lda, arf, info )
222 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
224 WRITE( nout, fmt = 9999 )
226 WRITE( nout, fmt = 9998 ) srnamt, uplo, cform, n
235 norm = norms( inorm )
236 normarf =
slansf( norm, cform, uplo, n, arf, work )
237 norma =
slansy( norm, uplo, n, a, lda, work )
239 result(1) = ( norma - normarf ) / norma / eps
242 IF( result(1).GE.thresh )
THEN
243 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
245 WRITE( nout, fmt = 9999 )
247 WRITE( nout, fmt = 9997 )
'SLANSF',
248 + n, iit, uplo, cform, norm, result(1)
259 IF ( nfail.EQ.0 )
THEN
260 WRITE( nout, fmt = 9996 )
'SLANSF', nrun
262 WRITE( nout, fmt = 9995 )
'SLANSF', nfail, nrun
264 IF ( nerrs.NE.0 )
THEN
265 WRITE( nout, fmt = 9994 ) nerrs,
'SLANSF'
268 9999
FORMAT( 1x,
' *** Error(s) or Failure(s) while testing SLANSF
270 9998
FORMAT( 1x,
' Error in ',a6,
' with UPLO=''',a1,
''', FORM=''',
272 9997
FORMAT( 1x,
' Failure in ',a6,
' N=',i5,
' TYPE=',i5,
' UPLO=''',
273 + a1,
''', FORM =''',a1,
''', NORM=''',a1,
''', test=',g12.5)
274 9996
FORMAT( 1x,
'All tests for ',a6,
' auxiliary routine passed the ',
275 +
'threshold ( ',i5,
' tests run)')
276 9995
FORMAT( 1x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
277 +
' tests failed to pass the threshold')
278 9994
FORMAT( 26x, i5,
' error message recorded (',a6,
')')
subroutine sdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
SDRVRF1
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH
real function slansf(NORM, TRANSR, UPLO, N, A, WORK)
SLANSF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
real function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine strttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
STRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Intel Corp All rights reserved Redistribution and use in source and binary forms