104 INTEGER lda, nn, nout
110 COMPLEX a( lda, * ), arf( * )
117 parameter ( one = 1.0e+0 )
119 parameter ( ntests = 1 )
122 CHARACTER uplo, cform, norm
123 INTEGER i, iform, iin, iit, info, inorm, iuplo, j, n,
125 REAL eps, large, norma, normarf, small
128 CHARACTER uplos( 2 ), forms( 2 ), norms( 4 )
129 INTEGER iseed( 4 ), iseedy( 4 )
130 REAL result( ntests )
144 COMMON / srnamc / srnamt
147 DATA iseedy / 1988, 1989, 1990, 1991 /
148 DATA uplos /
'U',
'L' /
149 DATA forms /
'N',
'C' /
150 DATA norms /
'M',
'1',
'I',
'F' /
161 iseed( i ) = iseedy( i )
164 eps =
slamch(
'Precision' )
165 small =
slamch(
'Safe minimum' )
167 small = small * lda * lda
168 large = large / lda / lda
184 a( i, j) =
clarnd( 4, iseed )
191 a( i, j) = a( i, j ) * large
199 a( i, j) = a( i, j) * small
208 uplo = uplos( iuplo )
214 cform = forms( iform )
217 CALL ctrttf( cform, uplo, n, a, lda, arf, info )
222 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
224 WRITE( nout, fmt = 9999 )
226 WRITE( nout, fmt = 9998 ) srnamt, uplo, cform, n
235 norm = norms( inorm )
236 normarf =
clanhf( norm, cform, uplo, n, arf, work )
237 norma =
clanhe( norm, uplo, n, a, lda, work )
239 result(1) = ( norma - normarf ) / norma / eps
242 IF( result(1).GE.thresh )
THEN
243 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
245 WRITE( nout, fmt = 9999 )
247 WRITE( nout, fmt = 9997 )
'CLANHF',
248 + n, iit, uplo, cform, norm, result(1)
259 IF ( nfail.EQ.0 )
THEN
260 WRITE( nout, fmt = 9996 )
'CLANHF', nrun
262 WRITE( nout, fmt = 9995 )
'CLANHF', nfail, nrun
264 IF ( nerrs.NE.0 )
THEN
265 WRITE( nout, fmt = 9994 ) nerrs,
'CLANHF'
268 9999
FORMAT( 1x,
' *** Error(s) or Failure(s) while testing CLANHF
270 9998
FORMAT( 1x,
' Error in ',a6,
' with UPLO=''',a1,
''', FORM=''',
272 9997
FORMAT( 1x,
' Failure in ',a6,
' N=',i5,
' TYPE=',i5,
' UPLO=''',
273 + a1,
''', FORM =''',a1,
''', NORM=''',a1,
''', test=',g12.5)
274 9996
FORMAT( 1x,
'All tests for ',a6,
' auxiliary routine passed the ',
275 +
'threshold ( ',i5,
' tests run)')
276 9995
FORMAT( 1x, a6,
' auxiliary routine: ',i5,
' out of ',i5,
277 +
' tests failed to pass the threshold')
278 9994
FORMAT( 26x, i5,
' error message recorded (',a6,
')')
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...
complex function clarnd(IDIST, ISEED)
CLARND
real function clanhf(NORM, TRANSR, UPLO, N, A, WORK)
CLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a Hermitian matrix in RFP format.
real function slamch(CMACH)
SLAMCH
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex Hermitian matrix.