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
236 a( i, j) =
clarnd( 4, iseed )
240 norma =
clange(
'I', n, k, a, lda,
249 a( i, j) =
clarnd( 4, iseed )
253 norma =
clange(
'I', k, n, a, lda,
266 c1( i, j) =
clarnd( 4, iseed )
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')
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 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...
complex function clarnd(IDIST, ISEED)
CLARND
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
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 ...
real function slarnd(IDIST, ISEED)
SLARND
real function slamch(CMACH)
SLAMCH
subroutine chfrk(TRANSR, UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C)
CHFRK performs a Hermitian rank-k operation for matrix in RFP format.