114 SUBROUTINE cdrvrf4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
115 + lda, s_work_clange )
123 INTEGER lda, ldc, nn, nout
128 REAL s_work_clange( * )
129 COMPLEX a( lda, * ), c1( ldc, * ), c2( ldc, *),
137 parameter( zero = 0.0e+0, one = 1.0e+0 )
139 parameter( ntests = 1 )
142 CHARACTER uplo, cform, trans
143 INTEGER i, iform, iik, iin, info, iuplo,
j, k, n,
144 + nfail, nrun, ialpha, itrans
145 REAL alpha, beta, eps, norma, normc
148 CHARACTER uplos( 2 ),
forms( 2 ), transs( 2 )
149 INTEGER iseed( 4 ), iseedy( 4 )
150 REAL result( ntests )
167 COMMON / srnamc / srnamt
170 DATA iseedy / 1988, 1989, 1990, 1991 /
171 DATA uplos /
'U',
'L' /
172 DATA forms /
'N',
'C' /
173 DATA transs /
'N',
'C' /
183 iseed( i ) = iseedy( i )
185 eps =
slamch(
'Precision' )
197 cform =
forms( iform )
201 uplo = uplos( iuplo )
205 trans = transs( itrans )
209 IF ( ialpha.EQ. 1)
THEN
212 ELSE IF ( ialpha.EQ. 1)
THEN
215 ELSE IF ( ialpha.EQ. 1)
THEN
219 alpha =
slarnd( 2, iseed )
230 IF ( itrans.EQ.1 )
THEN
240 norma =
clange(
'I', n, k, a, lda,
253 norma =
clange(
'I', k, n, a, lda,
274 normc =
clange(
'I', n, n, c1, ldc,
278 CALL
ctrttf( cform, uplo, n, c1, ldc, crf,
284 CALL
cherk( uplo, trans, n, k, alpha, a, lda,
290 CALL
chfrk( cform, uplo, trans, n, k, alpha, a,
296 CALL
ctfttr( cform, uplo, n, crf, c2, ldc,
303 c1(i,
j) = c1(i,
j)-c2(i,
j)
312 result(1) =
clange(
'I', n, n, c1, ldc,
314 result(1) = result(1)
315 + / max( abs( alpha ) * norma * norma
316 + + abs( beta ) * normc, one )
317 + / max( n , 1 ) / eps
319 IF( result(1).GE.thresh )
THEN
320 IF( nfail.EQ.0 )
THEN
322 WRITE( nout, fmt = 9999 )
324 WRITE( nout, fmt = 9997 )
'CHFRK',
325 + cform, uplo, trans, n, k, result(1)
338 IF ( nfail.EQ.0 )
THEN
339 WRITE( nout, fmt = 9996 )
'CHFRK', nrun
341 WRITE( nout, fmt = 9995 )
'CHFRK', nfail, nrun
344 9999
FORMAT( 1x,
' *** Error(s) or Failure(s) while testing CHFRK
346 9997
FORMAT( 1x,
' Failure in ',a5,
', CFORM=''',a1,
''',',
347 +
' UPLO=''',a1,
''',',
' TRANS=''',a1,
''',',
' N=',i3,
', K =', i3,
349 9996
FORMAT( 1x,
'All tests for ',a5,
' auxiliary routine passed the ',
350 +
'threshold ( ',i5,
' tests run)')
351 9995
FORMAT( 1x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
352 +
' tests failed to pass the threshold')
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine ctrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
subroutine cdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_CLANGE)
CDRVRF4
complex function clarnd(IDIST, ISEED)
CLARND
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH
subroutine ctfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine chfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
CHFRK performs a Hermitian rank-k operation for matrix in RFP format.
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
Intel Corp All rights reserved Redistribution and use in source and binary forms