118 SUBROUTINE sdrvrf4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
119 + lda, s_work_slange )
127 INTEGER lda, ldc, nn, nout
132 REAL a( lda, * ), c1( ldc, * ), c2( ldc, *),
133 + crf( * ), s_work_slange( * )
140 parameter( zero = 0.0e+0, one = 1.0e+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 REAL alpha, beta, eps, norma, normc
151 CHARACTER uplos( 2 ),
forms( 2 ), transs( 2 )
152 INTEGER iseed( 4 ), iseedy( 4 )
153 REAL result( ntests )
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 =
slamch(
'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 =
slarnd( 2, iseed )
232 IF ( itrans.EQ.1 )
THEN
242 norma =
slange(
'I', n, k, a, lda,
256 norma =
slange(
'I', k, n, a, lda,
276 normc =
slange(
'I', n, n, c1, ldc,
280 CALL
strttf( cform, uplo, n, c1, ldc, crf,
286 CALL
ssyrk( uplo, trans, n, k, alpha, a, lda,
292 CALL
ssfrk( cform, uplo, trans, n, k, alpha, a,
298 CALL
stfttr( cform, uplo, n, crf, c2, ldc,
305 c1(i,
j) = c1(i,
j)-c2(i,
j)
314 result(1) =
slange(
'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 )
'SSFRK',
327 + cform, uplo, trans, n, k, result(1)
340 IF ( nfail.EQ.0 )
THEN
341 WRITE( nout, fmt = 9996 )
'SSFRK', nrun
343 WRITE( nout, fmt = 9995 )
'SSFRK', nfail, nrun
346 9999
FORMAT( 1
x,
' *** Error(s) or Failure(s) while testing SSFRK
348 9997
FORMAT( 1
x,
' Failure in ',a5,
', CFORM=''',a1,
''',',
349 +
' UPLO=''',a1,
''',',
' TRANS=''',a1,
''',',
' N=',i3,
', K =', i3,
351 9996
FORMAT( 1
x,
'All tests for ',a5,
' auxiliary routine passed the ',
352 +
'threshold ( ',i5,
' tests run)')
353 9995
FORMAT( 1
x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
354 +
' tests failed to pass the threshold')
subroutine stfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
STFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
REAL function slamch(CMACH)
SLAMCH
subroutine ssyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
SSYRK
REAL function slarnd(IDIST, ISEED)
SLARND
REAL function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_SLANGE)
SDRVRF4
subroutine ssfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
SSFRK performs a symmetric rank-k operation for matrix in RFP format.
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