114 SUBROUTINE zdrvrf4( NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A,
115 + lda, d_work_zlange )
123 INTEGER lda, ldc, nn, nout
124 DOUBLE PRECISION thresh
128 DOUBLE PRECISION d_work_zlange( * )
129 COMPLEX*16 a( lda, * ), c1( ldc, * ), c2( ldc, *),
136 DOUBLE PRECISION zero, one
137 parameter( zero = 0.0d+0, one = 1.0d+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 DOUBLE PRECISION alpha, beta, eps, norma, normc
148 CHARACTER uplos( 2 ),
forms( 2 ), transs( 2 )
149 INTEGER iseed( 4 ), iseedy( 4 )
150 DOUBLE PRECISION 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 =
dlamch(
'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 =
dlarnd( 2, iseed )
230 IF ( itrans.EQ.1 )
THEN
240 norma =
zlange(
'I', n, k, a, lda,
253 norma =
zlange(
'I', k, n, a, lda,
274 normc =
zlange(
'I', n, n, c1, ldc,
278 CALL
ztrttf( cform, uplo, n, c1, ldc, crf,
284 CALL
zherk( uplo, trans, n, k, alpha, a, lda,
290 CALL
zhfrk( cform, uplo, trans, n, k, alpha, a,
296 CALL
ztfttr( cform, uplo, n, crf, c2, ldc,
303 c1(i,
j) = c1(i,
j)-c2(i,
j)
312 result(1) =
zlange(
'I', n, n, c1, ldc,
314 result(1) = result(1)
315 + / max( dabs( alpha ) * norma * norma
316 + + dabs( 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 )
'ZHFRK',
325 + cform, uplo, trans, n, k, result(1)
338 IF ( nfail.EQ.0 )
THEN
339 WRITE( nout, fmt = 9996 )
'ZHFRK', nrun
341 WRITE( nout, fmt = 9995 )
'ZHFRK', nfail, nrun
344 9999
FORMAT( 1
x,
' *** Error(s) or Failure(s) while testing ZHFRK
346 9997
FORMAT( 1
x,
' Failure in ',a5,
', CFORM=''',a1,
''',',
347 +
' UPLO=''',a1,
''',',
' TRANS=''',a1,
''',',
' N=',i3,
', K =', i3,
349 9996
FORMAT( 1
x,
'All tests for ',a5,
' auxiliary routine passed the ',
350 +
'threshold ( ',i6,
' tests run)')
351 9995
FORMAT( 1
x, a6,
' auxiliary routine: ',i6,
' out of ',i6,
352 +
' tests failed to pass the threshold')
subroutine zherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
ZHERK
COMPLEX *16 function zlarnd(IDIST, ISEED)
ZLARND
DOUBLE PRECISION function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
subroutine zdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_ZLANGE)
ZDRVRF4
DOUBLE PRECISION function dlarnd(IDIST, ISEED)
DLARND
subroutine zhfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
ZHFRK performs a Hermitian rank-k operation for matrix in RFP format.
subroutine ztrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
ZTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine ztfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Intel Corp All rights reserved Redistribution and use in source and binary forms