95 SUBROUTINE ddrvrf1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
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
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,
')')
double precision function dlarnd(IDIST, ISEED)
DLARND
subroutine ddrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
DDRVRF1
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 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.
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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.
Intel Corp All rights reserved Redistribution and use in source and binary forms