118 SUBROUTINE ddrvrf4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
119 + lda, d_work_dlange )
127 INTEGER LDA, LDC, NN, NOUT
128 DOUBLE PRECISION THRESH
132 DOUBLE PRECISION A( lda, * ), C1( ldc, * ), C2( ldc, *),
133 + crf( * ), d_work_dlange( * )
139 DOUBLE PRECISION ZERO, ONE
140 parameter ( zero = 0.0d+0, one = 1.0d+0 )
142 parameter ( ntests = 1 )
145 CHARACTER UPLO, CFORM, TRANS
146 INTEGER I, IFORM, IIK, IIN, INFO, IUPLO, J, K, N,
147 + nfail, nrun, ialpha, itrans
148 DOUBLE PRECISION ALPHA, BETA, EPS, NORMA, NORMC
151 CHARACTER UPLOS( 2 ), FORMS( 2 ), TRANSS( 2 )
152 INTEGER ISEED( 4 ), ISEEDY( 4 )
153 DOUBLE PRECISION RESULT( ntests )
156 DOUBLE PRECISION DLAMCH, DLARND, DLANGE
157 EXTERNAL dlamch, dlarnd, dlange
169 COMMON / srnamc / srnamt
172 DATA iseedy / 1988, 1989, 1990, 1991 /
173 DATA uplos /
'U',
'L' /
174 DATA forms /
'N',
'T' /
175 DATA transs /
'N',
'T' /
185 iseed( i ) = iseedy( i )
187 eps = dlamch(
'Precision' )
199 cform = forms( iform )
203 uplo = uplos( iuplo )
207 trans = transs( itrans )
211 IF ( ialpha.EQ. 1)
THEN
214 ELSE IF ( ialpha.EQ. 2)
THEN
217 ELSE IF ( ialpha.EQ. 3)
THEN
221 alpha = dlarnd( 2, iseed )
222 beta = dlarnd( 2, iseed )
232 IF ( itrans.EQ.1 )
THEN
238 a( i, j) = dlarnd( 2, iseed )
242 norma = dlange(
'I', n, k, a, lda,
252 a( i, j) = dlarnd( 2, iseed )
256 norma = dlange(
'I', k, n, a, lda,
268 c1( i, j) = dlarnd( 2, iseed )
276 normc = dlange(
'I', n, n, c1, ldc,
280 CALL dtrttf( cform, uplo, n, c1, ldc, crf,
286 CALL dsyrk( uplo, trans, n, k, alpha, a, lda,
292 CALL dsfrk( cform, uplo, trans, n, k, alpha, a,
298 CALL dtfttr( cform, uplo, n, crf, c2, ldc,
305 c1(i,j) = c1(i,j)-c2(i,j)
314 result(1) = dlange(
'I', n, n, c1, ldc,
316 result(1) = result(1)
317 + / max( abs( alpha ) * norma
318 + + abs( beta ) , one )
319 + / max( n , 1 ) / eps
321 IF( result(1).GE.thresh )
THEN
322 IF( nfail.EQ.0 )
THEN
324 WRITE( nout, fmt = 9999 )
326 WRITE( nout, fmt = 9997 )
'DSFRK',
327 + cform, uplo, trans, n, k, result(1)
340 IF ( nfail.EQ.0 )
THEN
341 WRITE( nout, fmt = 9996 )
'DSFRK', nrun
343 WRITE( nout, fmt = 9995 )
'DSFRK', nfail, nrun
346 9999
FORMAT( 1x,
' *** Error(s) or Failure(s) while testing DSFRK
348 9997
FORMAT( 1x,
' Failure in ',a5,
', CFORM=''',a1,
''',',
349 +
' UPLO=''',a1,
''',',
' TRANS=''',a1,
''',',
' N=',i3,
', K =', i3,
351 9996
FORMAT( 1x,
'All tests for ',a5,
' auxiliary routine passed the ',
352 +
'threshold ( ',i5,
' tests run)')
353 9995
FORMAT( 1x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
354 +
' tests failed to pass the threshold')
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...
subroutine dsfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
DSFRK performs a symmetric rank-k operation for matrix in RFP format.
subroutine ddrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
DDRVRF4
subroutine dsyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
DSYRK
subroutine dtfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...