103 INTEGER lda, nn, nout
104 DOUBLE PRECISION thresh
108 DOUBLE PRECISION a( lda, * ), arf( * ), work( * )
115 parameter ( one = 1.0d+0 )
117 parameter ( ntests = 1 )
120 CHARACTER uplo, cform, norm
121 INTEGER i, iform, iin, iit, info, inorm, iuplo, j, n,
123 DOUBLE PRECISION eps, large, norma, normarf, small
126 CHARACTER uplos( 2 ), forms( 2 ), norms( 4 )
127 INTEGER iseed( 4 ), iseedy( 4 )
128 DOUBLE PRECISION 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 =
dlamch(
'Precision' )
162 small =
dlamch(
'Safe minimum' )
164 small = small * lda * lda
165 large = large / lda / lda
181 a( i, j) =
dlarnd( 2, iseed )
188 a( i, j) = a( i, j ) * large
196 a( i, j) = a( i, j) * small
205 uplo = uplos( iuplo )
211 cform = forms( iform )
214 CALL dtrttf( cform, uplo, n, a, lda, arf, info )
219 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
221 WRITE( nout, fmt = 9999 )
223 WRITE( nout, fmt = 9998 ) srnamt, uplo, cform, n
232 norm = norms( inorm )
233 normarf =
dlansf( norm, cform, uplo, n, arf, work )
234 norma =
dlansy( norm, uplo, n, a, lda, work )
236 result(1) = ( norma - normarf ) / norma / eps
239 IF( result(1).GE.thresh )
THEN
240 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
242 WRITE( nout, fmt = 9999 )
244 WRITE( nout, fmt = 9997 )
'DLANSF',
245 + n, iit, uplo, cform, norm, result(1)
256 IF ( nfail.EQ.0 )
THEN
257 WRITE( nout, fmt = 9996 )
'DLANSF', nrun
259 WRITE( nout, fmt = 9995 )
'DLANSF', nfail, nrun
261 IF ( nerrs.NE.0 )
THEN
262 WRITE( nout, fmt = 9994 ) nerrs,
'DLANSF'
265 9999
FORMAT( 1x,
' *** Error(s) or Failure(s) while testing DLANSF
267 9998
FORMAT( 1x,
' Error in ',a6,
' with UPLO=''',a1,
''', FORM=''',
269 9997
FORMAT( 1x,
' Failure in ',a6,
' N=',i5,
' TYPE=',i5,
' UPLO=''',
270 + a1,
''', FORM =''',a1,
''', NORM=''',a1,
''', test=',g12.5)
271 9996
FORMAT( 1x,
'All tests for ',a6,
' auxiliary routine passed the ',
272 +
'threshold ( ',i5,
' tests run)')
273 9995
FORMAT( 1x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
274 +
' tests failed to pass the threshold')
275 9994
FORMAT( 26x, i5,
' error message recorded (',a6,
')')
subroutine dtrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
double precision function dlamch(CMACH)
DLAMCH
double precision function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY 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.
double precision function dlarnd(IDIST, ISEED)
DLARND
double precision function dlansf(NORM, TRANSR, UPLO, N, A, WORK)
DLANSF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix in RFP format.