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
184 a( i, j) =
slarnd( 2, iseed )
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,
')')
real function slarnd(IDIST, ISEED)
SLARND
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...
real function slansf(NORM, TRANSR, UPLO, N, A, WORK)
SLANSF
real function slamch(CMACH)
SLAMCH
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.